Code: Alles auswählen
;-TOP
; Comment : Module ButtonColorGadget Number 42 ;)
; Author : mk-soft
; Version : v1.03
; Create : 30.04.2019
; OS : All
EnableExplicit
; *****************************************************************************
DeclareModule ButtonColorGadget
Declare Create(Gadget, x, y, Width, Height, Text.s, FrontColor, BackColor, Flags = 0)
Declare Free(Gadget)
Declare Resize(Gadget, x, y, Width, Height)
Declare SetText(Gadget, Text.s)
Declare SetFont(Gadget, FontID)
Declare SetColor(Gadget, ColorType, Color)
EndDeclareModule
Module ButtonColorGadget
Structure udtButtonColorGadget
Gadget.i
Image.i
Text.s
FontID.i
FrontColor.i
BackColor.i
LineColor.i
EndStructure
; ----
Procedure DrawButton(*data.udtButtonColorGadget)
Protected Width, Height
With *data
Width = GadgetWidth(\Gadget)
Height = GadgetHeight(\Gadget)
If ImageWidth(\Image) <> Width Or ImageHeight(\Image) <> Height
FreeImage(\Image)
\Image = CreateImage(#PB_Any, Width, Height, 32)
EndIf
If StartDrawing(ImageOutput(\Image))
Box(0, 0, Width, Height, \LineColor)
Box(1, 1, Width - 2 , Height - 2, \BackColor)
DrawingFont(\FontID)
DrawText(Width / 2 - TextWidth(\Text) /2, Height / 2 - TextHeight(\Text) / 2, \Text, \FrontColor, \BackColor)
StopDrawing()
SetGadgetAttribute(\Gadget, #PB_Button_Image, ImageID(\Image))
EndIf
EndWith
EndProcedure
; ----
Procedure SetText(Gadget, Text.s)
Protected *data.udtButtonColorGadget
With *data
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
\Text = Text
DrawButton(*data)
EndIf
EndWith
EndProcedure
; ----
Procedure SetFont(Gadget, FontID)
Protected *data.udtButtonColorGadget
With *data
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
\FontID = FontID
DrawButton(*data)
EndIf
EndWith
EndProcedure
; ----
Procedure SetColor(Gadget, ColorType, Color)
Protected *data.udtButtonColorGadget
With *data
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
Select ColorType
Case #PB_Gadget_FrontColor
\FrontColor = Color
Case #PB_Gadget_BackColor
\BackColor = Color
Case #PB_Gadget_LineColor
\LineColor = Color
EndSelect
DrawButton(*data)
EndIf
EndWith
EndProcedure
; ----
Procedure Resize(Gadget, x, y, Width, Height)
Protected *data.udtButtonColorGadget
With *data
ResizeGadget(Gadget, x, y, Width, Height)
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
DrawButton(*data)
EndIf
EndWith
EndProcedure
; ----
Procedure Create(Gadget, x, y, Width, Height, Text.s, FrontColor, BackColor, Flags = 0)
Protected result, *data.udtButtonColorGadget
With *data
result = ButtonImageGadget(Gadget, x, y, Width, Height, 0, Flags)
If result
If Gadget = #PB_Any
Gadget = result
EndIf
*data = AllocateStructure(udtButtonColorGadget)
If *data
\Gadget = Gadget
\Text = Text
\FontID = #PB_Default
\FrontColor = FrontColor
\BackColor = BackColor
\LineColor = #Gray
\Image = CreateImage(#PB_Any, Width, Height, 32, #Gray)
If StartDrawing(ImageOutput(\Image))
Box(1, 1, Width - 2 , Height - 2, BackColor)
DrawingFont(\FontID)
DrawText(Width / 2 - TextWidth(Text) /2, Height / 2 - TextHeight(Text) / 2, Text, FrontColor, BackColor)
StopDrawing()
SetGadgetAttribute(Gadget, #PB_Button_Image, ImageID(\Image))
SetGadgetData(Gadget, *data)
ProcedureReturn result
EndIf
EndIf
EndIf
; Rollback
If *data
If \Image
FreeImage(\Image)
EndIf
FreeStructure(*data)
EndIf
If result
FreeGadget(Gadget)
EndIf
ProcedureReturn 0
EndWith
EndProcedure
; ----
Procedure Free(Gadget)
Protected *data.udtButtonColorGadget
With *data
*data = GetGadgetData(Gadget)
If *data And *data\Gadget = Gadget
If \Image
FreeImage(\Image)
EndIf
FreeStructure(*data)
EndIf
FreeGadget(Gadget)
EndWith
EndProcedure
EndModule
; *****************************************************************************
;- Example
CompilerIf #PB_Compiler_IsMainFile
Enumeration Windows
#Main
EndEnumeration
Enumeration Gadgets
#Button
EndEnumeration
Enumeration Status
#MainStatusBar
EndEnumeration
LoadFont(0, "Courier", 20, #PB_Font_Bold)
Procedure Main()
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 480, 320, "Module ButtonColorGadget Number 42 ;)" , #PB_Window_SystemMenu)
ButtonColorGadget::Create(#Button, 10, 10, 120, 30, "My Button", #Yellow, #Red)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #Button
If GadgetWidth(#Button) <= 120
ButtonColorGadget::Resize(#Button, #PB_Ignore, #PB_Ignore, 240, 60)
ButtonColorGadget::SetText(#Button, "My Big Button")
ButtonColorGadget::SetFont(#Button, FontID(0))
ButtonColorGadget::SetColor(#Button, #PB_Gadget_BackColor, #Green)
ButtonColorGadget::SetColor(#Button, #PB_Gadget_FrontColor, #Black)
ButtonColorGadget::SetColor(#Button, #PB_Gadget_LineColor, #Red)
Else
UseModule ButtonColorGadget
Resize(#Button, #PB_Ignore, #PB_Ignore, 120, 30)
SetText(#Button, "My Button")
SetFont(#Button, #PB_Default)
SetColor(#Button, #PB_Gadget_BackColor, #Red)
SetColor(#Button, #PB_Gadget_FrontColor, #Yellow)
SetColor(#Button, #PB_Gadget_LineColor, #Gray)
UnuseModule ButtonColorGadget
EndIf
EndSelect
EndSelect
ForEver
ButtonColorGadget::Free(#Button)
EndIf
EndProcedure : Main()
CompilerEndIf