Sowas. Ist aber noch nicht fertig und etwas sinnfrei, aber egal
hat man dafür eine kleine und simple Methode gefunden, kann man es immer wieder gebrauchen.
Code: Alles auswählen
#propname_Symbol = "symbolgadgetcb"
Procedure.i SymbolGadget_CB(hwnd, msg, wParam, lParam)
Protected oldproc = GetProp_(hwnd, #propname_Symbol)
Protected pbnr = GetDlgCtrlID_(hwnd)
Protected tm.TRACKMOUSEEVENT
Static tracking, oldcolor
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 so ist es
tm\dwFlags = #TME_LEAVE|#TME_HOVER ;übersichtlicher und man könnte mehr Action einbauen.
tm\hwndTrack = hwnd ;für welches Fenster/Gadget
tm\dwHoverTime = 10 ;Zeit bis #WM_MOUSEHOVER/#WM_MOUSELEAVE ausgelöst wird
TrackMouseEvent_(@tm)
EndIf
Case #WM_MOUSEHOVER:
oldcolor = GetGadgetColor(pbnr, #PB_Gadget_FrontColor)
SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Red)
Case #WM_MOUSELEAVE: tracking = #False: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, oldcolor)
Case #WM_LBUTTONUP: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Red)
Case #WM_LBUTTONDOWN: SetGadgetColor(pbnr, #PB_Gadget_FrontColor, #Green)
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wParam, lParam)
EndProcedure
Procedure.i SymbolGadget1(gadget, x, y, br, hh, z$, text$="", fontid=1)
;br sollte min 32 sein
Protected color, nr, pbid, pbnr, oldproc
Static f1id, f2id, f3id, size = 18
Select fontid ;Wingdings ist Standard
Case 1: If f1id = 0: f1id = FontID(LoadFont(#PB_Any, "Wingdings", size)): EndIf: fontid = f1id: color = #Black
Case 2: If f2id = 0: f2id = FontID(LoadFont(#PB_Any, "Webdings", size)): EndIf: fontid = f2id: color = $092D69
Case 3: If f3id = 0: f3id = FontID(LoadFont(#PB_Any, "Segoe UI Emoji", size)): EndIf: fontid = f3id: color = $4C371A
Default
EndSelect
If text$: z$ + " " + text$: EndIf
nr = TextGadget(gadget, x, y, br, hh, z$, #SS_NOTIFY|#SS_CENTER|#SS_CENTERIMAGE);|#PB_Text_Border)
If gadget = #PB_Any
pbid = GadgetID(nr): pbnr = nr
Else
pbid = nr: pbnr = gadget
EndIf
If fontid: SetGadgetFont(pbnr, fontid): EndIf
SetGadgetColor(pbnr, #PB_Gadget_FrontColor, color)
oldproc = SetWindowLongPtr_(pbid, #GWL_WNDPROC, @SymbolGadget_CB())
SetProp_(pbid, #propname_Symbol, oldproc)
ProcedureReturn nr
EndProcedure
Procedure.s makechar2(test$)
test$ = ReplaceString(test$, #DOUBLEQUOTE$, "")
panz = CountString(test$, "+")
If panz
For j = 1 To panz + 1
new$ + Chr(Val(StringField(test$, j, "+")))
Next
Else
new$ = Chr(Val(test$)): Debug " ist Zahl"
EndIf
ProcedureReturn new$
EndProcedure
Macro SymbolGadget(gadget, x, y, br, hh, char, text="", fontid=1)
SymbolGadget1(gadget, x, y, br, hh, makechar2(#DOUBLEQUOTE$ + char + #DOUBLEQUOTE$), text, fontid)
EndMacro
OpenWindow(0, 0, 0, 470, 200, "TextGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
SymbolGadget(0, 10, 10, 170, 33, 9742, "Telefon",3)
SymbolGadget(1, 10, 50, 170, 33, "$26df+$a0+$26df+$a0+$26df", "Autos", 3)
SymbolGadget(2, 10, 90, 170, 33, "$2639+$2639+$2639", "Mist", 3)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow