With CanvasGadget ...
Code: Select all
;- CanvasButtonGadget by mk-soft, v1.05, 08.12.2023
Procedure DrawCanvasButton(Gadget, Image, BackColor, Offset = 0)
Protected dx, dy, Image2
dx = DesktopScaledX(GadgetWidth(Gadget))
dy = DesktopScaledY(GadgetHeight(Gadget))
If StartDrawing(CanvasOutput(Gadget))
If Offset
Box(0, 0, dx, dy, $DCDCDC)
Box(Offset, Offset, dx, dy, BackColor)
Else
Box(0, 0, dx, dy, BackColor)
EndIf
If IsImage(Image)
If ImageWidth(image) = dx
DrawAlphaImage(ImageID(Image), Offset, Offset)
Else
Image2 = CopyImage(Image, #PB_Any)
ResizeImage(Image2, dx, dy)
DrawAlphaImage(ImageID(Image2), Offset, Offset)
FreeImage(Image2)
EndIf
EndIf
StopDrawing()
EndIf
EndProcedure
Procedure DoCanvasButtonEvent()
Protected Gadget = EventGadget()
Protected Image = GetGadgetData(Gadget)
Select EventType()
Case #PB_EventType_MouseEnter
DrawCanvasButton(Gadget, Image, $FFFFE0)
Case #PB_EventType_MouseLeave
DrawCanvasButton(Gadget, Image, $DCDCDC)
Case #PB_EventType_LeftButtonDown
DrawCanvasButton(Gadget, Image, $EEEEAF, 1)
Case #PB_EventType_LeftButtonUp
DrawCanvasButton(Gadget, Image, $FFFFE0)
EndSelect
EndProcedure
Procedure CanvasButtonGadget(Gadget, x, y, Width, Height, Image)
Protected r1
r1 = CanvasGadget(Gadget, x, y, Width, Height)
If Gadget = #PB_Any
Gadget = r1
EndIf
If r1
SetGadgetData(Gadget, Image)
DrawCanvasButton(Gadget, Image, $DCDCDC)
BindGadgetEvent(Gadget, @DoCanvasButtonEvent())
EndIf
ProcedureReturn r1
EndProcedure
; ****
Procedure CreateButtonImage(Image, Width, Height, Text.s, IconID)
Static Font
Protected r1, dx, dy
If Not Font
Font = LoadFont(#PB_Any, "Segoe UI", 11, #PB_Font_HighQuality)
EndIf
dx = DesktopScaledX(Width)
dy = DesktopScaledY(Height)
r1 = CreateImage(Image, dx, dy, 32, #PB_Image_Transparent)
If Image = #PB_Any
Image = r1
EndIf
If r1
If StartDrawing(ImageOutput(Image))
DrawImage(IconID, DesktopScaledX(4), DesktopScaledY(4))
DrawingFont(FontID(Font))
DrawingMode( #PB_2DDrawing_AlphaChannel | #PB_2DDrawing_Transparent )
DrawText(DesktopScaledX(40), DesktopScaledY(10), Text.s)
StopDrawing()
EndIf
EndIf
ProcedureReturn r1
EndProcedure
Procedure CreateButtonVectorImage(Image, Width, Height, Text.s, IconID)
Static Font
Protected r1, dx, dy
If Not Font
Font = LoadFont(#PB_Any, "Segoe UI", 11, #PB_Font_HighQuality)
EndIf
dx = DesktopScaledX(Width)
dy = DesktopScaledY(Height)
r1 = CreateImage(Image, dx, dy, 32, #PB_Image_Transparent)
If Image = #PB_Any
Image = r1
EndIf
If r1
If StartVectorDrawing(ImageVectorOutput(Image))
MovePathCursor(DesktopScaledX(4), DesktopScaledY(4))
DrawVectorImage(IconID, 255, DesktopScaledX(32), DesktopScaledY(32))
VectorFont(FontID(Font), DesktopScaledX(12 * 96 / 72))
MovePathCursor(DesktopScaledX(8+32+4), (VectorOutputHeight() - DesktopScaledY(2*4) - VectorTextHeight(Text, #PB_VectorText_Visible))/2)
DrawVectorText(Text)
StopVectorDrawing()
EndIf
EndIf
ProcedureReturn r1
EndProcedure
UsePNGImageDecoder()
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
hIcon = ExtractIcon_(0,"imageres.dll", 100)
CreateButtonImage(10, 120, 40, "Hi there", hIcon)
DestroyIcon_(hIcon)
hIcon = ExtractIcon_(0,"imageres.dll", 101)
CreateButtonVectorImage(11, 120, 40, "Its Nice", hIcon)
DestroyIcon_(hIcon)
CompilerElse
hIcon = LoadImage(0, #PB_Compiler_Home + "examples/3d/Data/Textures/GLX_icon.png")
CreateButtonVectorImage(10, 120, 40, "Hi there", hIcon)
hIcon = LoadImage(0, #PB_Compiler_Home + "examples/3d/Data/Textures/grass1.png")
CreateButtonVectorImage(11, 120, 40, "Its Nice", hIcon)
CompilerEndIf
OpenWindow(0,0,0,640,480,"Canvas Button Test",#PB_Window_SystemMenu| #PB_Window_ScreenCentered)
CanvasButtonGadget(1, 10, 10, 120, 40, 10)
CanvasButtonGadget(2, 140, 10, 120, 40, 11)
CanvasButtonGadget(3, 10, 60, 360, 120, 11)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Select EventType()
Case #PB_EventType_LeftClick
Debug "Button 1"
EndSelect
Case 2
Select EventType()
Case #PB_EventType_LeftClick
Debug "Button 2"
EndSelect
EndSelect
EndSelect
Until Quit = 1