Nur wir Pbler haben ihn nicht zumindest meiner Meinung nach
Bis jetzt
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