Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
hjbremer
Beiträge: 822
Registriert: 27.02.2006 22:30
Computerausstattung: von gestern
Wohnort: Neumünster

Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos

Beitrag von hjbremer »

Drop an Cursorpos meint nicht die Caretposi sondern die Mausposi

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

Purebasic 5.70 x86 5.72 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Comboboxgadget mit autosave, autocomplete, Drop an Curso

Beitrag von RSBasic »

:allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Re: Comboboxgadget mit autosave, autocomplete, Drop an Curso

Beitrag von Michael Vogel »

Das schaut richtig gut aus :D

Mir wäre aber lieber, wenn per Tabulator der begonnene Text vervollständigt würde und nur dann zum nächsten Gadget gesprungen wird, wenn keine Buchstaben selektiert sind.

Der Tab wird schnell angefangen, einfach per Shortcut...

Code: Alles auswählen

AddKeyboardShortcut(#mainwindow,#PB_Shortcut_Tab,99)
...aber dann wird's eng - ich bin mir nicht sicher, ob das Editfeld in der ComboBox immer das Child der ComboBox ist:
Vielleicht kann das wer bestätigen (oder eine andere Methode vorschlagen)...

Code: Alles auswählen

	Case #PB_Event_Menu
			Select EventGadget()
			Case 99
				Debug #combo1
				Define hendl,posa,pose
				hendl=GetWindow_(GadgetID(#combo1),#GW_Child)
				Debug hendl
				SendMessage_(hendl,#EM_GETSEL,@posa,@pose)				
				Debug "TAB "+ Str(posa)+", "+Str(pose)
			EndSelect
Michael Vogel
Beiträge: 71
Registriert: 16.03.2006 11:20

Re: Comboboxgadget mit autosave, autocomplete, Drop an Curso

Beitrag von Michael Vogel »

Ein Problemchen habe ich noch - manchmal werden Eingaben überschrieben :|

Beispielsweise möchte ich Kabelsalat schreiben, vergesse aber das "K" am Anfang - also steht "abelsalat" in dem Eingabefeld. Nun mit dem Cursor ganz nach links und das fehlende "K" eingeben...
...dann wird der Text jedoch zu "Kugel" geändert.

Die entsprechende Abfrage für das automatische Vervollständigen ist gleich nach folgender Zeile:

Code: Alles auswählen

text$ = Left(GetGadgetText(*mc\pbnr), startpos) + Chr(wParam)  ; bisheriger Text + Eingabe
Folgender Ansatz hat für mich ganz gut ausgesehen, funktioniert aber auch nicht richtig, sobald Delete oder Backspace verwendet werden......

Code: Alles auswählen

			SendMessage_(hwnd, #EM_GETSEL, @startpos, 0)
			Protected t.s
			t=GetGadgetText(*mc\pbnr)
			text$ = Left(GetGadgetText(*mc\pbnr), startpos) + Chr(wParam)  ; bisheriger Text + Eingabe
			found = SendMessage_(*mc\pbid, #CB_FINDSTRING, -1, @text$)	   ; -1 = nicht gefunden
			Debug Left(t,startpos)+"|"+Chr(wParam)+"|"+Mid(t,startpos+1)+" = "+Left(GetGadgetItemText(*mc\pbnr,found),Len(t)+1)+" ?"
			If found > -1 And Left(t,startpos)+Chr(wParam)+Mid(t,startpos+1)=Left(GetGadgetItemText(*mc\pbnr,found),Len(t)+1)
				Debug GetGadgetItemText(*mc\pbnr,found)
				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
Antworten