Aktuelle Zeit: 13.12.2019 00:44

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Comboboxgadget mit autosave, autocomplete, Drop an Cursorpos
BeitragVerfasst: 02.03.2018 15:38 
Offline
Benutzeravatar

Registriert: 27.02.2006 22:30
Wohnort: Neumünster
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


_________________
Purebasic 5.60 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Comboboxgadget mit autosave, autocomplete, Drop an Curso
BeitragVerfasst: 02.03.2018 15:53 
Offline
Admin
Benutzeravatar

Registriert: 05.10.2006 18:55
Wohnort: Berlin
:allright:

_________________
BildBildBildBild BildBild


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 2 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 3 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye