Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos
Verfasst: 02.03.2018 15:38
Drop an Cursorpos meint nicht die Caretposi sondern die Mausposi
autocomplete ist nur eine kleine simple Funktion ohne Vorschau
Fehlermeldungen willkommen
autocomplete ist nur eine kleine simple Funktion ohne Vorschau
Fehlermeldungen willkommen
Code: Alles auswählen
; Windows 10 x64 - PB 5.60 - HJBremer
DeclareModule Combobox
Declare.i ComboboxAddItem(gadget, text$)
Declare.i ComboboxGadgetX(gadget, sp, ze, br, hh, flag = 0)
EnumerationBinary
#Combobox_Time
;weitere Flags
EndEnumeration
EndDeclareModule
Module Combobox
EnableExplicit
Structure COMBOBOXINFO
cbSize.l
rcItem.RECT
rcButton.RECT
stateButton.l
hwndCombo.i
hwndItem.i
hwndList.i
EndStructure
Structure mycombo
pbnr.i
pbid.i
menu.i
flag.i
oldproc_gadget.i
oldproc_listbox.i
oldproc_editfield.i
info.COMBOBOXINFO
EndStructure
Enumeration 10001 ;Menuitems für PopUpMenu ( Rightclick im Editfeld )
#menuitem_delete
#menuitem_copy
#menuitem_paste
#menuitem_notepad
#menuitem_loaditems
EndEnumeration
#propname_cbmem = "combobox2_cbmem" ;für Callbacks
#propname_lfdnr = "combobox2_lfdnr" ;nur für ComboboxFilename
Macro ComboboxFilename(pbnr)
GetFilePart(#PB_Compiler_Filename, 1) + "_cb_" + GetProp_(GadgetID(pbnr), #propname_lfdnr) + ".txt"
EndMacro
Procedure.i GetGadgetWindow(pbnr)
;ermittelt in welchem Fenster sich ein Gadget befindet, wichtig für BindEvent()
;Repeat muß sein, falls Gadget in einem Container steckt, sonst reicht nur GetProp_()
;von jassing - http://forums.purebasic.com/english/viewtopic.php?f=13&t=61255
Protected window, pbid = GadgetID(pbnr)
Repeat
window = GetProp_(GetParent_(pbid), "PB_WindowID")
If window = 0
pbid = GetParent_(pbid)
Else
ProcedureReturn window - 1
EndIf
Until IsWindow(window)
EndProcedure
Procedure.i ComboboxLoadItems(pbnr)
;schreibt die Daten einer Datei in die Comboboxliste
Protected text$
Protected datnr = OpenFile(#PB_Any, ComboboxFilename(pbnr))
If datnr
While Eof(datnr) = 0
text$ = ReadString(datnr)
SendMessage_(GadgetID(pbnr), #CB_ADDSTRING, 0, @text$)
Wend
CloseFile(datnr)
EndIf
EndProcedure
Procedure.i ComboboxSaveItems(pbnr)
;schreibt die Daten einer Comboboxliste in eine Datei
Protected text$, i
Protected count = CountGadgetItems(pbnr) - 1 ; -1 weil ab null gezählt wird
Protected datnr = CreateFile(#PB_Any, ComboboxFilename(pbnr))
If datnr
For i = 0 To count
text$ = GetGadgetItemText(pbnr, i)
WriteStringN(datnr, text$)
Next
CloseFile(datnr)
EndIf
EndProcedure
Procedure.i ComboboxAddItem(pbnr, text$)
;speichert einen neuen Eintrag am Ende der Datei und fügt diesen in die Liste ein
;Hinweis: #CB_FINDSTRINGEXACT liefert nur 0 oder -1 wenn Combobox #CBS_SORT hat.
If SendMessage_(GadgetID(pbnr), #CB_FINDSTRINGEXACT, -1, @text$) = #CB_ERR ; wenn -1 = nicht gefunden
SendMessage_(GadgetID(pbnr), #CB_ADDSTRING, 0, @text$)
Protected datnr = OpenFile(#PB_Any, ComboboxFilename(pbnr))
If datnr
FileSeek(datnr, Lof(datnr))
WriteStringN(datnr, text$)
CloseFile(datnr)
EndIf
EndIf
EndProcedure
Procedure.i ComboBoxEventEditfield(hwnd, msg, wParam, lParam)
;Callback nur für Editfield eines Comboboxgadgets
Protected *mc.mycombo = GetProp_(hwnd, #propname_cbmem)
Protected oldproc = *mc\oldproc_editfield
Protected text$, lg, found
Protected startpos, endpos ;für #EM_GETSEL
Static starttime, endtime, tripleflag ;für Tripleclick Abfrage, muß Static sein
Select msg
Case #WM_NCDESTROY: RemoveProp_(hwnd, #propname_cbmem)
Case #WM_HELP
text$ = "Return = speichern / TAB oder Mausclick = NICHT speichern" + #LF$
text$ + "Rightclick in Editfeld = PopUpMenu" + #LF$
text$ + "Rightclick in Liste = löschen / Item wird ins Clipboard kopiert" + #LF$ + #LF$
text$ + "bei Textdrop wird an der Cursorspitze eingefügt" + #LF$ + #LF$
MessageRequester("Info", text$)
ProcedureReturn 0
Case #WM_RBUTTONDOWN ;Right click on ComboBox
DisplayPopupMenu(*mc\menu, hwnd)
Case #WM_COMMAND ;Menuitems vom PopUpMenu
SendMessage_(hwnd, #EM_GETSEL, @startpos, @endpos) ;markierten Text ermitteln
Select wParam
Case #menuitem_delete
If startpos = endpos ;nix markiert also alles löschen
SetGadgetText(*mc\pbnr, "")
Else ;sonst markierten Text mit Leertext ersetzen
text$ = ""
SendMessage_(hwnd, #EM_REPLACESEL, 0, @text$)
EndIf
Case #menuitem_copy
text$ = GetGadgetText(*mc\pbnr)
If startpos <> endpos ;nur markiertes kopieren, sonst alles
text$ = Mid(text$, startpos + 1, endpos - startpos)
EndIf
SetClipboardText(text$)
Case #menuitem_paste
text$ = GetClipboardText()
SendMessage_(hwnd, #EM_REPLACESEL, 0, @text$)
Case #menuitem_notepad: RunProgram("notepad", ComboboxFilename(*mc\pbnr), "")
Case #menuitem_loaditems: ClearGadgetItems(*mc\pbnr): ComboboxLoadItems(*mc\pbnr)
EndSelect
Case #WM_KILLFOCUS ;hier weitere Auswertungen der Eingabe z.B. für Time
text$ = GetGadgetText(*mc\pbnr): lg = Len(text$)
;für Flag Abfrage immer Bool benutzen
If Bool(*mc\flag & #Combobox_Time) ;Uhrzeit
If text$
If ParseDate("%hh:%ii", text$) = -1
;ändere falsche Zeit
Select lg
Case 1: text$ = "0" + text$ + ":00"
Case 2: text$ + ":00"
Case 3: text$ = Left(text$,2) + ":" + Right(text$,1) + "0"
Case 4: text$ = Left(text$,2) + ":" + Right(text$,2)
EndSelect
ReplaceString(text$, " ", "0", #PB_String_InPlace)
If ParseDate("%hh:%ii", text$) = -1
text$ = FormatDate("%hh:00", Date())
EndIf
EndIf
;setze und speicher geänderte Zeit
SetGadgetText(*mc\pbnr, text$)
ComboboxAddItem(*mc\pbnr, text$)
EndIf
EndIf
Case #WM_CHAR ;Eingabecheck für ein Zeichen + Combobox Autocomplete
;für Flag Abfrage immer Bool benutzen
If Bool(*mc\flag & #Combobox_Time) ;nur Zeichen für Uhrzeit erlaubt
Select wParam
Case 48 To 58 ;0-9 und :
Case 8, 13, 32 ;Backspace + Return + Space zulassen
Default: wparam = 0
EndSelect
EndIf
;Autocomplete nach einem Vorbild aus dem englischem Forum, nur etwas kleiner !
SendMessage_(hwnd, #EM_GETSEL, @startpos, 0)
text$ = Left(GetGadgetText(*mc\pbnr), startpos) + Chr(wParam) ; bisheriger Text + Eingabe
found = SendMessage_(*mc\pbid, #CB_FINDSTRING, -1, @text$) ; -1 = nicht gefunden
If found > -1
SetGadgetState(*mc\pbnr, found) ;PB markiert Text in der Liste + setzt Text ein
SendMessage_(hwnd, #EM_SETSEL, startpos + 1, -1) ;nun Rest markieren, -1 ist endposi
ProcedureReturn 0 ;ProcedureReturn 0 muß sein
EndIf
; hier beginnt Tripleclick Abfrage, kann so auch in einem StringGadget benutzt werden
Case #WM_LBUTTONDBLCLK
starttime = GetTickCount_() ;PB markiert jetzt ein Wort bei #WM_LBUTTONDBLCLK
Case #WM_LBUTTONDOWN ;beim 3.Click entfernt PB Markierung wieder, das ist so !
If starttime
endtime = GetTickCount_() - starttime ;Zeit zwischen DBLClk und 3.Click
starttime = 0
If endtime < GetDoubleClickTime_() ;dann trippelclick flag setzen
tripleflag = 1 ;auch vierfach wenn man schnell ist
EndIf ;aber das ist egal
EndIf
Case #WM_LBUTTONUP
If tripleflag ;Pb ist fertig mit entfernen der Markierung,
tripleflag = 0 ;nun können wir die ganze Zeile markieren
SendMessage_(hwnd, #EM_SETSEL, 0, -1) ; -1 ist endposi kann auch 1000 oder so sein
EndIf
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.i ComboBoxEventListbox(hwnd, msg, wParam, lParam)
;Callback nur für Listbox eines Comboboxgadgets für Item löschen
Protected *mc.mycombo = GetProp_(hwnd, #propname_cbmem)
Protected item, oldproc = *mc\oldproc_listbox
Select msg
Case #WM_NCDESTROY: RemoveProp_(hwnd, #propname_cbmem)
Case #WM_RBUTTONDOWN ;Right click on ComboBox-Listitem löscht Item
item = SendMessage_(hwnd, #LB_GETCURSEL, 0, 0)
SetClipboardText(GetGadgetItemText(*mc\pbnr, item)) ;vorm Löschen ins Clipboard
SendMessage_(hwnd, #LB_DELETESTRING, item, 0) ;Löschen
ComboboxSaveItems(*mc\pbnr) ;alle Items speichern
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.i ComboboxEvent(hwnd, msg, wParam, lParam)
;Callback nur für Comboboxgadget für speichern
Protected *mc.mycombo = GetProp_(hwnd, #propname_cbmem)
Protected oldproc = *mc\oldproc_gadget
Protected text$, ok
Select msg
Case #WM_NCDESTROY:
RemoveProp_(hwnd, #propname_cbmem)
RemoveProp_(hwnd, #propname_lfdnr)
Case 343
;wahrscheinlich #CB_GETDROPPEDSTATE
;wird ausgelöst durch Cursor up + down + ! Taste Return !
If GetKeyState_(#VK_RETURN) > 1
PostMessage_(hwnd, #WM_KEYDOWN, #VK_TAB, 0)
;Eingabe speichern mit Return
text$ = GetGadgetText(*mc\pbnr)
If Len(text$)
ok = 1
If Bool(*mc\flag & #Combobox_Time)
If ParseDate("%hh:%ii", text$) = -1: ok = 0: EndIf
EndIf
If ok: ComboboxAddItem(*mc\pbnr, text$): EndIf
EndIf
EndIf
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.i ComboboxDropPosi(pbnr, x)
;ermittelt die Anzahl Zeichen vor der X Position
Protected size.size, dc = GetDC_(GadgetID(pbnr))
Protected fontid = GetGadgetFont(pbnr)
Protected text$ = GetGadgetText(pbnr), lg = Len(text$), j
SelectObject_(dc, fontid)
For j = 1 To lg
GetTextExtentPoint32_(dc, Left(text$, j), j, size): ;Debug size\cx
If size\cx > x: Break: EndIf
Next
ProcedureReturn j - 1
EndProcedure
Procedure.i ComboboxDropEvent()
;fügt Text an Cursorposi im Editfeld ein
Protected pbnr = EventGadget()
Protected startpos, text$
Protected *mc.mycombo = GetProp_(GadgetID(pbnr), #propname_cbmem)
text$ = EventDropText()
startpos = ComboboxDropPosi(pbnr, EventDropX() - 2) ; Rand abziehen 2 oder 3
SendMessage_(*mc\info\hwndItem, #EM_SETSEL, startpos, startpos)
SendMessage_(*mc\info\hwndItem, #EM_REPLACESEL, 0, @text$)
EndProcedure
Procedure.i ComboboxGadgetX(gadget, sp, ze, br, hh, flag = 0)
;erstellt ComboBoxGadget, subclassing und hinterlegt lfdnr für Filename
Static lfdnr
Protected nr, pbid, pbnr, window, *mc.mycombo = AllocateMemory(SizeOf(mycombo)) ;Mem erstellen
Protected pbflag = #PB_ComboBox_Editable|#CBS_SORT
If Bool(flag & #PB_ComboBox_LowerCase): pbflag | #PB_ComboBox_LowerCase: EndIf
If Bool(flag & #PB_ComboBox_UpperCase): pbflag | #PB_ComboBox_UpperCase: EndIf
nr = ComboBoxGadget(gadget, sp, ze, br, hh, pbflag)
If gadget = #PB_Any
pbid = GadgetID(nr)
pbnr = nr
Else
pbid = nr
pbnr = gadget
EndIf
SendMessage_(pbid, #CB_SETMINVISIBLE, 15, 0) ;ab 15 Einträge Scrollbalken
EnableGadgetDrop(pbnr, #PB_Drop_Text, #PB_Drag_Copy)
window = GetGadgetWindow(pbnr) ;Combobox gehört zu welchem Fenster ?
;wird window weggelassen, gibt es für jedes Drop ein Aufruf der jeweiligen Procs
BindEvent(#PB_Event_GadgetDrop, @ComboboxDropEvent(), window, pbnr)
lfdnr + 1
*mc\info\cbSize = SizeOf(COMBOBOXINFO): GetComboBoxInfo_(pbid, *mc\info)
*mc\pbid = pbid
*mc\pbnr = pbnr
*mc\flag = flag
*mc\oldproc_gadget = SetWindowLongPtr_(pbid, #GWL_WNDPROC, @ComboboxEvent())
*mc\oldproc_listbox = SetWindowLongPtr_(*mc\info\hwndList, #GWL_WNDPROC, @ComboBoxEventListbox())
*mc\oldproc_editfield = SetWindowLongPtr_(*mc\info\hwndItem, #GWL_WNDPROC, @ComboBoxEventEditfield())
*mc\menu = CreatePopupMenu(#PB_Any) ;verhindert nerviges Windowsmenu
MenuItem(#menuitem_delete, "Löschen")
MenuItem(#menuitem_copy, "Kopieren")
MenuItem(#menuitem_paste, "Einfügen")
MenuBar()
MenuItem(#menuitem_notepad, "Liste in Editor laden")
MenuItem(#menuitem_loaditems, "Liste neu laden")
SetProp_(pbid, #propname_cbmem, *mc)
SetProp_(pbid, #propname_lfdnr, lfdnr)
SetProp_(*mc\info\hwndList, #propname_cbmem, *mc)
SetProp_(*mc\info\hwndItem, #propname_cbmem, *mc)
;Debug *mc\info\hwndCombo : Debug pbid ;Kontrolle ob Structur korrect ist, Werte müssen gleich sein
ComboboxLoadItems(pbnr)
ProcedureReturn nr
EndProcedure
EndModule
UseModule Combobox
CompilerIf #PB_Compiler_IsMainFile
Enumeration 10
#mainwindow
#combo1
#combo2
#combo3
EndEnumeration
LoadFont(1, "Consolas", 11)
SetGadgetFont(#PB_Default, FontID(1))
OpenWindow(#mainwindow, 0, 0, 640, 300, "Demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Define sp = 20, ze = 20, br = 300, hh = 24
ComboboxGadgetX(#combo1, sp, ze, br, hh) : ze + 30
ComboboxGadgetX(#combo2, sp, ze, br, hh, #PB_ComboBox_UpperCase) : ze + 30
ComboboxGadgetX(#combo3, sp, ze, br, hh, #Combobox_Time) : ze + 30
ComboboxAddItem(#combo1, "Kugel")
ComboboxAddItem(#combo1, "Computer")
SendMessage_(GadgetID(#combo1), #CB_SETCUEBANNER, 0, @"F1 = Info")
SendMessage_(GadgetID(#combo2), #CB_SETCUEBANNER, 0, @"Uppercase")
SendMessage_(GadgetID(#combo3), #CB_SETCUEBANNER, 0, @"Time")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
Select EventWindow()
Case #mainwindow: Break
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #combo1
EndSelect
EndSelect
ForEver
CompilerEndIf
