Und hier mal eine kleine Demo fürs CanvasGadget (fehlen noch kleinere wichtige Prozeduren, wenn man sie denn braucht)
das gibt natürlich freie Auswahl was Design und Möglichkeiten angeht, ist aber umfangreicher.
Code: Alles auswählen
; Demo für eigene Buttons
;Erweiterungen: z.B. SetColor, SetFont, Freegadget, Resize, SetData, abgerundete Ecken etc
DeclareModule EventButton
Declare.i EventButton(pbnr, x, y, width, height, text$="", flag=0)
Declare.i EventButton_SetText(pbnr, text$, textsize.d=0)
Declare.i EventButton_GetState(pbnr)
EndDeclareModule
Module EventButton
EnableExplicit
Structure eventbutton
pbnr.i
width.i
height.i
colortext.i
colorback.i
colorpress.i
toggle.i
press.i
state.i
text.s
textsize.d
textfont.i
mydata.i
EndStructure
Global default_textfont = LoadFont(#PB_Any, "Consolas", 10)
Global default_textsize = 18
Global default_colortext = #Black
Global default_colorback = $3F4CDC ;#Red
Global default_colorpress = $5FA11A ;#Green
Procedure.i EventButton_Draw(*mb.eventbutton)
Protected a = $FF000000 ;Alphawert von color wird mit Farbwert kombiniert via a|color
Protected x, y, h, color
Protected ab = 3, ab2 = ab+ab, width = *mb\width-ab2, height = *mb\height-ab2
With *mb
StartVectorDrawing(CanvasVectorOutput(\pbnr))
;Canvas Rahmen
AddPathBox(0, 0, \width, \height): VectorSourceColor(a|#Gray): StrokePath(3)
;Canvas Background
color = \colorback
If \press Or \state : color = \colorpress : EndIf
AddPathBox(ab, ab, width, height): VectorSourceColor(a|color): FillPath()
;draw Text
If Len(\text)
VectorFont(FontID(\textfont), \textsize)
h = VectorParagraphHeight(\text, width, height)
x = ab
y = \height/2 - h/2
MovePathCursor(x, y): VectorSourceColor(a | \colortext)
DrawVectorParagraph(\text, width, h, #PB_VectorParagraph_Center)
EndIf
StopVectorDrawing()
EndWith
EndProcedure
Procedure.i EventButton_Event()
Protected pbnr = EventGadget()
Protected event = EventType()
Protected *mb.eventbutton = GetGadgetData(pbnr)
Select event
Case #PB_EventType_LeftButtonUp
*mb\press = 0
If *mb\toggle = 0
*mb\state = 0
EndIf
EventButton_Draw(*mb)
Case #PB_EventType_LeftButtonDown
*mb\press = 1
If *mb\toggle = 0
*mb\state = 1
Else
*mb\state ! 1 ;mit XOR state ändern
EndIf
EventButton_Draw(*mb)
EndSelect
EndProcedure
Procedure.i EventButton_GetState(pbnr)
Protected *mb.eventbutton = GetGadgetData(pbnr)
ProcedureReturn *mb\state
EndProcedure
Procedure.i EventButton_SetText(pbnr, text$, textsize.d=0)
Protected *mb.eventbutton = GetGadgetData(pbnr)
*mb\text = text$
If textsize : *mb\textsize = textsize : EndIf
EventButton_Draw(*mb)
EndProcedure
Procedure.i EventButton(pbnr, x, y, width, height, text$="", flag=0)
;flag hier nur #PB_Button_Toggle
Protected id, *mb.eventbutton = AllocateStructure(eventbutton)
id = CanvasGadget(pbnr, x, y, width, height)
If pbnr = #PB_Any : pbnr = id : EndIf
SetGadgetAttribute(pbnr, #PB_Canvas_Cursor, #PB_Cursor_Hand)
BindGadgetEvent(pbnr, @EventButton_Event(), #PB_EventType_LeftButtonUp)
BindGadgetEvent(pbnr, @EventButton_Event(), #PB_EventType_LeftButtonDown)
With *mb
\pbnr = pbnr
\width = width
\height = height
\text = text$
\toggle = flag
\textsize = default_textsize
\textfont = default_textfont
\colortext = default_colortext
\colorback = default_colorback
\colorpress = default_colorpress
EndWith
SetGadgetData(pbnr, *mb)
EventButton_Draw(*mb)
ProcedureReturn id
EndProcedure
EndModule
UseModule EventButton
Enumeration
#button1
#button2
#button3
EndEnumeration
Define event, eventtyp
OpenWindow(0, 0, 0, 820, 420, "Canvas example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
EventButton(#button1, 11, 10, 110, 60, "Toggle Button", #PB_Button_Toggle)
EventButton(#button2, 11, 100, 110, 40, "Hallo")
EventButton(#button3, 11, 150, 110, 30, "")
EventButton_SetText(#button3, "Button 3", 9)
Repeat
event = WaitWindowEvent()
eventtyp = EventType()
If event = #PB_Event_Gadget
Select EventGadget()
Case #button1
Select eventtyp ;diese EventType() Abfrage muß beim CanvasGadget immer sein !!!!
Case #PB_EventType_LeftButtonDown
Debug "#button1 Down"
Case #PB_EventType_LeftButtonUp
Debug "#button1 up"
EndSelect
Case #button2
If eventtyp = #PB_EventType_LeftButtonDown
Debug "#button2 down"
EndIf
If eventtyp = #PB_EventType_LeftButtonUp
nr + 1
EventButton_SetText(#button1, "ok " + nr, 25)
Debug "#button2 up"
EndIf
Case #button3
If eventtyp = #PB_EventType_LeftButtonDown
Debug "state #button1 ist " + EventButton_GetState(#button1)
EndIf
EndSelect
EndIf
Until Event = #PB_Event_CloseWindow
