PureBoard
http://forums.purebasic.com/german/

Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos
http://forums.purebasic.com/german/viewtopic.php?f=8&t=30656
Seite 1 von 1

Autor:  hjbremer [ 02.03.2018 15:38 ]
Betreff des Beitrags:  Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos

Drop an Cursorpos meint nicht die Caretposi sondern die Mausposi

autocomplete ist nur eine kleine simple Funktion ohne Vorschau

Fehlermeldungen willkommen

Code:
; 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


Autor:  RSBasic [ 02.03.2018 15:53 ]
Betreff des Beitrags:  Re: Comboboxgadget mit autosave, autocomplete, Drop an Curso

:allright:

Seite 1 von 1 Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/