Code: Select all
'Coded by UEZ build 2019-06-07 beta
#Include "windows.bi"
#Include "win\commctrl.bi"
Declare Function WndProc(hWnd As HWND,uMsg As UINT,wParam As WPARAM,lParam As LPARAM) As Integer
Declare Function LV_InsertColumn(Byval hWndControl As HWND, Byval iPosition As Integer, Byref TheText As String, Byval nAlignment As Integer = LVCFMT_LEFT, Byval nWidth As Integer = 100) As Integer
Declare Function LV_InsertItem(Byval hWndControl As HWND, Byval iRow As Integer, Byval iColumn As Integer, Byref TheText As String, Byval lParam As Integer = 0, Byval iImage As Integer = 0) As Integer
Dim tOSVERSIONINFO As OSVERSIONINFO
ZeroMemory(@tOSVERSIONINFO, Sizeof(OSVERSIONINFO))
tOSVERSIONINFO.dwOSVersionInfoSize = Sizeof(OSVERSIONINFO)
GetVersionEx(@tOSVERSIONINFO)
If tOSVERSIONINFO.dwBuildNumber < 6000 Then
MessageBox(NULL, "This operating system is not supported!", "ERROR", MB_ICONERROR)
End
End If
Dim wc As WNDCLASSEX
Dim msg As MSG
Dim Shared As POINT caretpos
Dim Shared As HWND hGUI, hInput, hLabel, hGUI_Child, hGUI_Lv
Dim Shared As Short iPosLV
iPosLV = -1
Dim As Integer sW, sH
ScreenInfo(sW, sH)
Dim szAppName As ZString * 30 => "FB GUI"
Dim As String sTitle = "Auto-Complete Input Text Demo"
Dim Shared As UShort iW, iH
Dim Shared As String currInput
Dim Shared As Ubyte s1 = 0
iW = 500
iH = 110
Dim Shared As String aKeywords(0 To 13)
aKeywords(0) = "war"
aKeywords(1) = "watch"
aKeywords(2) = "win"
aKeywords(3) = "windows"
aKeywords(4) = "wizard"
aKeywords(5) = "witch"
aKeywords(6) = "warn"
aKeywords(7) = "water"
aKeywords(8) = "why"
aKeywords(9) = "wild"
aKeywords(10) = "wear"
aKeywords(11) = "way"
aKeywords(12) = "whiskey"
aKeywords(13) = "UEZ"
With wc
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = NULL
.cbWndExtra = NULL
.hInstance = GetModuleHandle(NULL)
.hIcon = LoadIcon(NULL, IDI_APPLICATION)
.hCursor = LoadCursor(NULL, IDC_ARROW)
.hbrBackground = GetStockObject(WHITE_BRUSH)
.lpszMenuName = NULL
.lpszClassName = @szAppName
.cbSize = SizeOf(WNDCLASSEX)
End With
RegisterClassEx(@wc)
hGUI = CreateWindowEx(0, wc.lpszClassName, sTitle, _
WS_OVERLAPPEDWINDOW Or WS_VISIBLE, _
(sW - iW) / 2, (sH - iH) / 2, _
iW, iH, _
NULL, NULL, wc.hInstance, NULL)
hLabel = CreateWindowEx(0, "Static", "Start to type words like window", WS_VISIBLE Or WS_CHILD, 40, 2, iW - 100, 20, hGUI, NULL, NULL, NULL)
hInput = CreateWindowEx(0, "Edit", NULL, WS_VISIBLE Or WS_CHILD Or WS_BORDER, 40, 30, iW - 100, 20, hGUI, NULL, NULL, NULL)
hGUI_Child = CreateWindowEx(WS_EX_TOOLWINDOW, wc.lpszClassName, "", WS_POPUP Or WS_CLIPCHILDREN, 0, 0, 280, 160, hGUI, NULL, wc.hInstance, NULL)
hGUI_Lv = CreateWindowEx(0, "SysListView32", "", WS_BORDER Or WS_CHILD Or WS_VISIBLE Or WS_CLIPSIBLINGS Or _
LVS_REPORT Or LVS_SINGLESEL Or LVS_SHOWSELALWAYS Or LVS_NOCOLUMNHEADER,0, 0, 280, 160, hGUI_Child, 0, 0, 0)
ShowWindow(hGUI_Child, SW_HIDE)
Const LV_WM_SETREDRAW = 11
SendMessage(hGUI_Lv, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_FULLROWSELECT) ' Or LVS_EX_GRIDLINES)
LV_InsertColumn(hGUI_Lv, 0, "", LVCFMT_LEFT, 260)
While GetMessage(@msg, 0, 0, 0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case hInput, hGUI_Lv
Select Case msg.message
Case WM_KEYDOWN
Select Case msg.wParam
Case VK_DOWN
If s1 = 1 Then
iPosLV += 1
iPosLV = Iif(iPosLV > ListView_GetItemCount(hGUI_Lv) - 1, ListView_GetItemCount(hGUI_Lv) - 1, iPosLV)
ListView_SetItemState(hGUI_Lv, iPosLV, LVIS_SELECTED, LVIS_SELECTED)
End If
Case VK_UP
If s1 = 1 Then
iPosLV -= 1
iPosLV = Iif(iPosLV < 0, 0, iPosLV)
ListView_SetItemState(hGUI_Lv, iPosLV, LVIS_SELECTED, LVIS_SELECTED)
End If
Case VK_RETURN
Dim As Zstring * 255 sLVItem
ListView_GetItemText(hGUI_Lv, iPosLV, 0, @sLVItem, SizeOf(sLVItem))
If iPosLV <> -1 Then
SetWindowText(hInput, sLVItem)
iPosLV = -1
End If
SendMessage(hInput, EM_SETSEL, Len(sLVItem), Len(sLVItem))
Case VK_ESCAPE
ShowWindow(hGUI_Child, SW_HIDE)
s1 = 0
End Select
Case WM_LBUTTONDBLCLK
If msg.wParam = 1 Then
Dim As Zstring * 255 sLVItem
ListView_GetItemText(hGUI_Lv, iPosLV, 0, @sLVItem, SizeOf(sLVItem))
If iPosLV <> -1 Then
SetWindowText(hInput, sLVItem)
iPosLV = -1
End If
SendMessage(hInput, EM_SETSEL, Len(sLVItem), Len(sLVItem))
End If
End Select
End Select
If ListView_GetSelectionMark(hGUI_Lv) > -1 Then 'https://docs.microsoft.com/en-us/windows/desktop/api/commctrl/nf-commctrl-listview_setselectionmark
If iPosLV <> ListView_GetSelectionMark(hGUI_Lv) Then iPosLV = ListView_GetSelectionMark(hGUI_Lv)
End If
Wend
Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As Integer
Select Case hWnd
Case hGUI
Select Case uMsg
Case WM_CLOSE
PostQuitMessage(0)
Return 0
Case WM_COMMAND
Select Case lParam
Case hInput
Dim As Ushort iLen = GetWindowTextLength(hInput)
Dim As ZString * 255 sInput
GetWindowText(hInput, sInput, iLen + 1)
If iLen Then
Dim As RECT gui_pos
GetWindowRect(hGUI, @gui_pos)
MoveWindow(hGUI_Child, gui_pos.left + 48, gui_pos.top + 90, 280, 160, True)
SendMessage(hGUI_Lv, LV_WM_SETREDRAW, False, 0)
SendMessage(hGUI_Lv, LVM_DELETEALLITEMS, 0, 0)
For i As Ushort = 0 To Ubound(aKeywords)
If Left(aKeywords(i), iLen) = sInput And Len(aKeywords(i)) <> iLen Then
If s1 = 0 Then
ShowWindow(hGUI_Child, SW_SHOWNOACTIVATE)
s1 = 1
End If
SendMessage(hGUI_Lv, LB_ADDSTRING, 0, Cast(LPARAM, @aKeywords(i)))
LV_InsertItem(hGUI_Lv, i, 0, aKeywords(i))
End If
Next
If ListView_GetItemCount(hGUI_Lv) < 1 Then
ShowWindow(hGUI_Child, SW_HIDE)
s1 = 0
End If
SendMessage(hGUI_Lv, LV_WM_SETREDRAW, True, 0)
Else
ShowWindow(hGUI_Child, SW_HIDE)
s1 = 0
End If
Return 0
End Select
Case WM_MOVE
Dim As RECT gui_pos
GetWindowRect(hGUI, @gui_pos)
MoveWindow(hGUI_Child, gui_pos.left + 48, gui_pos.top + 90, 280, 160, True)
Return 0
Case WM_CTLCOLORSTATIC
If lParam = hLabel Then
Dim As HDC hdcStatic = Cast(HDC, wParam)
SetTextColor(hdcStatic, &hFF0000) 'BGR
SetBkColor(hdcStatic, GetSysColor(COLOR_WINDOW))
Return Cast(INT_PTR, (GetSysColorBrush(COLOR_WINDOW)))
End If
End Select
Case hGUI_Child
End Select
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
'LV Function taken from https://www.freebasic.net/forum/viewtopic.php?f=6&t=17060
Function LV_InsertColumn( Byval hWndControl As HWND, _
Byval iPosition As Integer, _
Byref TheText As String, _
Byval nAlignment As Integer = LVCFMT_LEFT, _
Byval nWidth As Integer = 100 _
) As Integer
Dim tlvc As LV_COLUMN
' Do a check To ensure that this is actually a Window handle
If IsWindow(hWndControl) Then
tlvc.mask = LVCF_FMT Or LVCF_WIDTH Or LVCF_TEXT Or LVCF_SUBITEM
tlvc.fmt = nAlignment
tlvc.cx = nWidth
tlvc.pszText = Strptr(TheText)
tlvc.iSubItem = 0
Return SendMessage( hWndControl, LVM_INSERTCOLUMN, iPosition, Cint(@tlvc))
End If
Return 0
End Function
Function LV_InsertItem( Byval hWndControl As HWND, _
Byval iRow As Integer, _
Byval iColumn As Integer, _
Byref TheText As String, _
Byval lParam As Integer = 0, _
Byval iImage As Integer = 0 _
) As Integer
Dim tlv_item As LV_ITEM
' Do a check To ensure that this is actually a Window handle
If IsWindow(hWndControl) Then
tlv_item.iItem = iRow
tlv_item.iSubItem = iColumn
tlv_item.pszText = Strptr(TheText)
tlv_item.iImage = iImage
tlv_item.lParam = lParam
If iColumn = 0 Then
tlv_item.mask = LVIF_TEXT Or LVIF_PARAM Or LVIF_IMAGE
Function = SendMessage( hWndControl, LVM_INSERTITEM, 0, Cint(@tlv_item))
Else
tlv_item.mask = LVIF_TEXT Or LVIF_IMAGE
Function = SendMessage( hWndControl, LVM_SETITEM, 0, Cint(@tlv_item))
End If
End If
End Function
Animated GIF:
Tested on Win10 only.