PureBoard

Code: Alles auswählen

;30.07.2017 V2.0 PB 5.60 x64 Windows 10 - mit Tripleclick in StringGadgetX

DeclareModule MyStringGadget
   Declare.i StringGadgetX(gadget, x, y, br, hh, text$, flags = 0)   
EndDeclareModule

Module MyStringGadget   
   EnableExplicit 
   
   Global windownr, windowid
   
   Global symbolfont = FontID(LoadFont(#PB_Any, "OpenSymbol", 12))
   Global textfrontcolor = #Blue    ;Normalfarbe im TextGadget 
   Global kreuz$ = Chr($2717)       ;für TextGadget im StringGadgetX
   
   Procedure.i TextGadget_CB(hwnd, msg, wParam, lParam)   
      
      Protected oldproc = GetWindowLongPtr_(hwnd, #GWL_USERDATA)   
      Protected pbnr = GetDlgCtrlID_(hwnd)   
      Protected tm.TRACKMOUSEEVENT      
      Static tracking      
      
      Select msg    
         Case #WM_MOUSEMOVE
            If tracking = #False
               tracking = #True                    ;TRACKING wird gestartet
               tm\cbSize = SizeOf(TRACKMOUSEEVENT) ;auf #TME_HOVER könnte man verzichten, aber
               tm\dwFlags = #TME_LEAVE|#TME_HOVER  ;so ist es übersichtlicher und man könnte
               tm\hwndTrack = hwnd                 ;zusätzliche Action einbauen. 
               tm\dwHoverTime = 10     ;Zeit bis #WM_MOUSEHOVER/#WM_MOUSELEAVE ausgelöst wird              
               TrackMouseEvent_(@tm)
            EndIf 
            
         Case #WM_MOUSEHOVER
            textfrontcolor = #Red                     ;andere Farbe, dann #WM_CTLCOLORSTATIC
            SetGadgetText(pbnr, GetGadgetText(pbnr))  ; auslösen, Farbe wird dort zurück gesetzt
            
         Case #WM_KILLFOCUS, #WM_MOUSELEAVE   
            tracking = #False                         ;da #WM_MOUSEHOVER vorher passiert,
            SetGadgetText(pbnr, GetGadgetText(pbnr))  ; ist Farbe bereits zurück gesetzt
            
         Default : ;TranslateMsgWM(msg)  
      EndSelect
      
      ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)     
   EndProcedure
   
   Procedure.i StringGadgetX_CB(hwnd, msg, wParam, lParam)   
      
      Protected pbnr, oldproc = GetWindowLongPtr_(hwnd, #GWL_USERDATA)   
      Protected wp, lp, vkct, txt$
      
      Static starttime, endtime, tripleflag
      
      Select msg 
         Case #WM_CTLCOLORSTATIC:                 ; vom und für Textgadget
            SetTextColor_(wParam, textfrontcolor) : textfrontcolor = #Blue
            SetBkMode_(wparam, #TRANSPARENT)            
            ProcedureReturn GetStockObject_(#HOLLOW_BRUSH)

         Case #WM_PARENTNOTIFY            ;kommt vom Textgadget, da X gedrückt
            pbnr = GetDlgCtrlID_(hwnd)    ;Purebasicnr. abfragen            
            vkct = GetAsyncKeyState_(#VK_CONTROL) & #VK_CONTROL   ; 1 wenn Control
            txt$ = GetGadgetText(pbnr)
            SendMessage_(hwnd, #EM_GETSEL, @wp, @lp)           ;Text markiert ?
            If wp <> lp                                        ;ja wenn ungleich
               If vkct                                         ;Control Taste gedrückt
                  SetClipboardText(Mid(txt$, wp+1, lp - wp))   ;erst ins Clipboard
               EndIf
               SendMessage_(hwnd, #EM_REPLACESEL, #False, @"") ;markierten Text löschen               
            Else
               If vkct: SetClipboardText(txt$): EndIf          ;ins Clipboard
               SetGadgetText(pbnr, "")                         ;Text löschen
               SetActiveGadget(pbnr) 
            EndIf
                        
         ; hier beginnt Tripleclick Abfrage im Stringgadget           
         Case #WM_LBUTTONDBLCLK
            starttime = GetTickCount_()      ;PB markiert ein Wort bei #WM_LBUTTONDBLCLK
            
            ;bei Bedarf Eventtype auslösen
            ;pbnr = GetDlgCtrlID_(hwnd) 
            ;PostEvent(#PB_Event_Gadget, EventWindow(), pbnr, #PB_EventType_LeftDoubleClick) 
            
         Case #WM_LBUTTONDOWN                ;PB entfernt Markierung wieder, das ist so !
            If starttime
               endtime = GetTickCount_() - starttime  ;Zeit zwischen DBLClk und 3.Click
               starttime = 0
               If endtime < GetDoubleClickTime_()     ;dann trippelclick
                  tripleflag = 1                      ;auch vierfach wenn man schnell ist
               EndIf                                  ;aber das ist egal
            EndIf
            
         Case #WM_LBUTTONUP                           ;Pb ist fertig mit entfernen der
            If tripleflag                             ;Markierung, nun können wir 
               tripleflag = 0                         ;die ganze Zeile markieren
               SendMessage_(hwnd,#EM_SETSEL,0,-1)     ;oder ein eigenes Eventtype senden
            EndIf                                     ; siehe Postevent
           
      EndSelect
      
      ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)     
   EndProcedure
   
   Procedure.i StringGadgetX(gadget, x, y, br, hh, text$, flags = 0) 
      
      Protected gadgetnr, gadgetid, returnnr, oldproc, rect.rect   
      Protected textnr, textid, tbr = 16
      
      If gadget = #PB_Any      
         gadgetnr = StringGadget(#PB_Any, x, y, br, hh, text$, flags|#ES_MULTILINE)
         gadgetid = GadgetID(gadgetnr)    ;es muß #ES_MULTILINE sein, sonst Probleme
         returnnr = gadgetnr              ;außerdem gibt es dann #PB_EventType_ReturnKey
      Else      
         gadgetnr = gadget
         gadgetid = StringGadget(gadget, x, y, br, hh, text$, flags|#ES_MULTILINE)  
         returnnr = gadgetid
      EndIf   
      
      oldproc = SetWindowLongPtr_(gadgetid, #GWL_WNDPROC, @StringGadgetX_CB())
      SetWindowLongPtr_(gadgetid, #GWL_USERDATA, oldproc)  
      
      SendMessage_(gadgetid, #EM_GETRECT, 0, rect)   
      rect\right - tbr + 5
      SendMessage_(gadgetid, #EM_SETRECT, 0, rect)
      
      ;Textgadget
      textnr = TextGadget(#PB_Any, br - tbr -2, 0, tbr, hh-3, kreuz$, #SS_NOTIFY|#SS_CENTER|#SS_CENTERIMAGE)
      textid = GadgetID(textnr)   
      SetParent_(textid, gadgetid)   
      SetGadgetFont(textnr, symbolfont)
      
      oldproc = SetWindowLongPtr_(textid, #GWL_WNDPROC, @TextGadget_CB())
      SetWindowLongPtr_(textid, #GWL_USERDATA, oldproc)
      
      ProcedureReturn returnnr
   EndProcedure
         
EndModule

UseModule MyStringGadget

OpenWindow(0, 0, 0, 680, 390, "Beispiel...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

StringGadgetX(1, 20, 20, 300, 22, "Wen das grau stört, muß Backcolor white zuweisen") 

StringGadgetX(2, 20, 50, 300, 22, "hier ist Backcolor white") 
SetGadgetColor(2, #PB_Gadget_BackColor, #White)

StringGadgetX(3, 20, 80, 200, 22, "Triple Click im Text = alles Markiert")
SetGadgetColor(3, #PB_Gadget_BackColor, #Yellow)

nr = StringGadgetX(#PB_Any, 20, 120, 200, 22, "Kreuz anclicken, Text weg")
SetGadgetColor(nr, #PB_Gadget_BackColor, $DFDFFF)

nr = StringGadgetX(#PB_Any, 20, 150, 300, 22, "Doppelclick auf Wort dann Kreuz anclicken, Wort weg")
SetGadgetColor(nr, #PB_Gadget_BackColor, #Yellow)

Repeat
   Event = WaitWindowEvent()   
   Select Event         
      Case #PB_Event_Gadget
         Select EventGadget()
            Case 1 :      
         EndSelect         
   EndSelect
Until Event = #PB_Event_CloseWindow