Here's another option.
Code: Select all
CompilerIf (#PB_Compiler_IsMainFile)
EnableExplicit
CompilerEndIf
;- ImageButton
DeclareModule ImageButton
;
#PB_GadgetType_ImageButton = 34
#PB_Button_Top = #PB_Button_Left >>2
#PB_Button_Bottom = #PB_Button_Left >>3
;
Declare Repaint( Gadget )
Declare GadgetFree( Gadget )
Declare Gadget( Gadget, X,Y,Width,Height, Text.s, ImageID.i = #False, Flags.i = #False, ImgWidth.i = 16, ImgHeight.i = 16 )
EndDeclareModule
Module ImageButton
Structure ImageButton
Canvas.i
Flags.i
;
Img.i
Text.s
;
FontID.i
ColorFont.i
;
ColorIdleBorder.i
ColorIdleTop.i
ColorIdleBottom.i
;
ColorHoverBorder.i
ColorHoverTop.i
ColorHoverBottom.i
;
ColorPressBorder.i
ColorPressTop.i
ColorPressBottom.i
;
HoverItem.i
PressItem.i
EndStructure
Procedure Img( ImageID, Width = 16, Height = 16 )
If IsImage(ImageID)
ProcedureReturn ImageID
Else
If ImageID
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Protected ImgID = CopyImage_(ImageID, #IMAGE_ICON, Width, Height, #LR_COPYRETURNORG)
If ImgID
ImageID = ImgID
Else
ImageID = CopyImage_(ImageID, #IMAGE_BITMAP, Width, Height, #LR_COPYRETURNORG)
EndIf
CompilerEndSelect
If ImageID
Protected Image = CreateImage(#PB_Any, Width, Height, 32)
If StartDrawing(ImageOutput(Image))
DrawingMode(#PB_2DDrawing_AllChannels)
Box(0, 0, OutputWidth(), OutputHeight())
DrawImage(ImageID, 0, 0)
StopDrawing()
EndIf
ProcedureReturn Image
EndIf
Else
ProcedureReturn -1
EndIf
EndIf
EndProcedure
Procedure Redraw(*IMG.ImageButton)
Protected TopColor.i, BottomColor.i, BorderColor.i, DefaultColor.i, Width, Height
If (*IMG And IsGadget(*IMG\Canvas))
With *IMG
If (StartDrawing(CanvasOutput(\Canvas)))
Width = OutputWidth()
Height = OutputHeight()
;
If ((\PressItem = \HoverItem) And (\PressItem))
TopColor = \ColorPressTop
BottomColor = \ColorPressBottom
BorderColor = \ColorPressBorder
DefaultColor = \ColorPressBorder
ElseIf (\HoverItem)
TopColor = \ColorHoverTop
BottomColor = \ColorHoverBottom
BorderColor = \ColorHoverBorder
DefaultColor = \ColorHoverBorder
Else
TopColor = \ColorIdleTop
BottomColor = \ColorIdleBottom
BorderColor = \ColorIdleBorder
DefaultColor = \ColorHoverBorder
EndIf
;
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(TopColor)
FrontColor(BottomColor)
LinearGradient(0, 0, 0, Height)
Box(0, 0, Width, Height)
;
DrawingMode(#PB_2DDrawing_Outlined)
If ((\Flags & #PB_Button_Default) = #PB_Button_Default)
Box(0, 0, Width, Height, DefaultColor)
Else
Box(0, 0, Width, Height, BorderColor)
EndIf
Protected X, ImageWidth, Y, ImageHeight
DrawingFont(\FontID)
DrawingMode(#PB_2DDrawing_AlphaBlend)
X = (Width-TextWidth(\Text))>>1
Y = (Height-TextHeight(\Text))>>1
If IsImage(\Img)
ImageWidth = ImageWidth(\Img)
ImageHeight = ImageHeight(\Img)
If (\Flags & #PB_Button_Left) = #PB_Button_Left
X = X+1-ImageWidth>>1
Y = (Height - ImageHeight)>>1
ElseIf (\Flags & #PB_Button_Top) = #PB_Button_Top
X = (Width - ImageWidth)>>1
Y = Y-2-ImageHeight>>1
ElseIf (\Flags & #PB_Button_Right) = #PB_Button_Right
X = (X+TextWidth(\Text)+1)-ImageWidth>>1
Y = (Height - ImageHeight)>>1
ElseIf (\Flags & #PB_Button_Bottom) = #PB_Button_Bottom
X = (Width - ImageWidth)>>1
Y = (Y+2+TextHeight(\Text))-ImageHeight>>1
Else
X = (Width - ImageWidth)>>1
Y = (Height - ImageHeight)>>1
EndIf
DrawImage(ImageID(\Img), X, Y) ; center
X = (Width-TextWidth(\Text))>>1
Y = (Height-TextHeight(\Text))>>1
If (\Flags & #PB_Button_Left) = #PB_Button_Left
X = X+2+ImageWidth>>1
ElseIf (\Flags & #PB_Button_Top) = #PB_Button_Top
Y = Y+2+ImageHeight>>1
ElseIf (\Flags & #PB_Button_Right) = #PB_Button_Right
X = X-2-ImageWidth>>1
ElseIf (\Flags & #PB_Button_Bottom) = #PB_Button_Bottom
Y = Y-2-TextHeight(\Text)
EndIf
Else
If (\Flags & #PB_Button_Left) = #PB_Button_Left
X = 2
ElseIf (\Flags & #PB_Button_Top) = #PB_Button_Top
Y = 2
ElseIf (\Flags & #PB_Button_Right) = #PB_Button_Right
X = Width-TextWidth(\Text)-2
ElseIf (\Flags & #PB_Button_Bottom) = #PB_Button_Bottom
Y = Height-TextHeight(\Text)-2
EndIf
EndIf
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(X, Y, \Text, \ColorFont)
StopDrawing()
EndIf
EndWith
EndIf
EndProcedure
Procedure Repaint( Gadget )
; Static X,Y,W,H
; ForEach ImageButton()
; Gadget = ImageButton()\Canvas
; If (X!GadgetX(Gadget) Or
; Y!GadgetY(Gadget) Or
; W!GadgetWidth(Gadget) Or
; H!GadgetHeight(Gadget))
;
If IsGadget(Gadget)
Redraw(GetGadgetData(Gadget))
EndIf
;
; X=GadgetX(Gadget)
; Y=GadgetY(Gadget)
; W=GadgetWidth(Gadget)
; H=GadgetHeight(Gadget)
; EndIf
; Next
EndProcedure
Procedure Callback( )
Static Redraw
Protected *IMG.ImageButton = GetGadgetData(EventGadget())
If (*IMG And IsGadget(*IMG\Canvas))
With *IMG
Select (EventType())
Case #PB_EventType_MouseEnter,
#PB_EventType_MouseMove,
#PB_EventType_LeftButtonDown
If (GetGadgetAttribute(\Canvas, #PB_Canvas_MouseX) >=0 And
GadgetWidth(\Canvas) >= GetGadgetAttribute(\Canvas, #PB_Canvas_MouseX)) And
(GetGadgetAttribute(\Canvas, #PB_Canvas_MouseY) >=0 And
GadgetHeight(\Canvas) >= GetGadgetAttribute(\Canvas, #PB_Canvas_MouseY))
\HoverItem = #True
Else
\HoverItem = #False
EndIf
If (EventType() = #PB_EventType_LeftButtonDown)
\PressItem = #True
EndIf
Redraw = #True
Case #PB_EventType_LeftButtonUp
\PressItem = #False
Redraw = #True
Case #PB_EventType_MouseLeave
\HoverItem = #False
Redraw = #True
EndSelect
If Redraw = #True
Repaint( EventGadget() )
Redraw = #False
EndIf
EndWith
EndIf
EndProcedure
Procedure GadgetFree( Gadget )
If (IsGadget(Gadget))
SetGadgetData(Gadget, #Null)
UnbindGadgetEvent(Gadget, @Callback())
If (GetGadgetData(Gadget))
ClearStructure(GetGadgetData(Gadget), ImageButton)
FreeMemory(GetGadgetData(Gadget))
EndIf
FreeGadget(Gadget)
EndIf
ProcedureReturn (#Null)
EndProcedure
Procedure Gadget( Gadget, X.i, Y.i, Width.i, Height.i, Text.s, ImageID.i = #False, Flags.i = #False, ImgWidth.i = 16, ImgHeight.i = 16 )
Protected *IMG.ImageButton = #Null
Protected Canvas.i = CanvasGadget(Gadget, X, Y, Width, Height) :If Gadget ! -1 :Canvas = Gadget :EndIf
If IsGadget(Canvas)
*IMG = AllocateMemory(SizeOf(ImageButton))
If (*IMG)
InitializeStructure(*IMG, ImageButton)
With *IMG
\Canvas = Canvas
\ColorFont = RGB(0, 0, 0)
If ImageID And Text And Flags = #False
Flags = #PB_Button_Left
EndIf
\Flags = Flags
;
CompilerSelect (#PB_Compiler_OS)
CompilerCase (#PB_OS_Windows)
Protected Temp.i = TextGadget(#PB_Any, 0, 0, 25, 25, " ")
If (Temp)
\FontID = GetGadgetFont(Temp)
FreeGadget(Temp)
EndIf
: \FontID = GetGadgetFont(#PB_Default)
CompilerCase (#PB_OS_MacOS)
Protected Temp.i = TextGadget(#PB_Any, 0, 0, 25, 25, " ")
If (Temp)
\FontID = GetGadgetFont(Temp)
FreeGadget(Temp)
EndIf
CompilerDefault
CompilerError "Not tested on this OS yet"
CompilerEndSelect
; CompilerIf #PB_Compiler_OS = #PB_OS_Windows
; CanvasColor = GetSysColor_(#COLOR_3DFACE)
; CompilerEndIf
;
; Default colors (based on Windows 7)
\ColorIdleBorder = RGB(172, 172, 172)
\ColorIdleTop = RGB(240, 240, 240)
\ColorIdleBottom = RGB(229, 229, 229)
;\ColorHoverBorder = RGB(126, 180, 234)
\ColorHoverBorder = RGB(0, 160, 252)
\ColorHoverTop = RGB(236, 244, 252)
\ColorHoverBottom = RGB(220, 236, 252)
\ColorPressBorder = RGB(86, 157, 229)
\ColorPressTop = RGB(218, 236, 252)
\ColorPressBottom = RGB(196, 224, 252)
\Img = Img(ImageID,ImgWidth,ImgHeight)
\Text = " "+Text.s+" "
EndWith
;
SetGadgetData(Canvas, *IMG)
Repaint( Canvas )
BindGadgetEvent(Canvas, @Callback())
If GetWindowLongPtr_(GadgetID(Canvas), #GWL_STYLE) & #WS_CLIPSIBLINGS = #False
SetWindowLongPtr_( GadgetID(Canvas), #GWL_STYLE, GetWindowLongPtr_( GadgetID(Canvas), #GWL_STYLE )|#WS_CLIPSIBLINGS )
EndIf
Else
FreeGadget(Canvas)
EndIf
EndIf
ProcedureReturn (Canvas)
EndProcedure
EndModule
UseJPEG2000ImageDecoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
;{ Иконки на кнопках
DataSection
Icon4:
Data.b $89,$50,$4E,$47,$0D,$0A,$1A,$0A,$00,$00,$00,$0D,$49,$48,$44,$52,$00,$00,$00,$10
Data.b $00,$00,$00,$10,$08,$06,$00,$00,$00,$1F,$F3,$FF,$61,$00,$00,$02,$0D,$49,$44,$41
Data.b $54,$38,$8D,$95,$91,$B1,$6B,$1A,$61,$18,$C6,$9F,$3B,$BE,$FB,$C0,$03,$6F,$38,$6F
Data.b $38,$24,$14,$CD,$62,$14,$37,$C5,$21,$04,$11,$AC,$01,$43,$71,$0B,$84,$4E,$21,$43
Data.b $C6,$CB,$2E,$08,$86,$24,$84,$E0,$94,$FF,$20,$90,$A4,$C3,$8D,$2E,$2E,$1D,$22,$17
Data.b $30,$7A,$82,$06,$6C,$3A,$18,$AB,$74,$C8,$2D,$D5,$A1,$43,$D0,$0F,$73,$5F,$97,$1A
Data.b $0A,$D5,$36,$FE,$B6,$F7,$E5,$79,$7E,$C3,$FB,$0A,$98,$43,$2E,$97,$D3,$44,$51,$7C
Data.b $0F,$40,$01,$F0,$D3,$75,$DD,$CF,$E5,$72,$F9,$C7,$BC,$EC,$5C,$62,$B1,$D8,$8E,$65
Data.b $59,$F6,$70,$38,$E4,$96,$65,$D9,$B1,$58,$6C,$E7,$CD,$65,$00,$50,$55,$75,$DF,$71
Data.b $1C,$4E,$29,$CD,$3B,$8E,$C3,$55,$55,$DD,$5F,$4A,$00,$60,$CB,$34,$4D,$BB,$DF,$FF
Data.b $C6,$4D,$D3,$B4,$01,$6C,$2D,$2B,$F8,$00,$C0,$78,$78,$F8,$C2,$01,$18,$BF,$E7,$B9
Data.b $88,$0B,$F6,$91,$5E,$EF,$F1,$7C,$34,$1A,$A1,$D7,$7B,$3C,$07,$10,$59,$4A,$40,$08
Data.b $79,$0A,$85,$D6,$0A,$00,$10,$0A,$AD,$15,$08,$21,$4F,$8B,$04,$24,$1A,$8D,$7E,$14
Data.b $04,$E1,$DD,$6C,$C1,$39,$FF,$DE,$E9,$74,$AE,$08,$21,$79,$C6,$18,$00,$B8,$D3,$E9
Data.b $F4,$6A,$41,$EE,$13,$61,$8C,$AD,$36,$1A,$8D,$A3,$66,$B3,$39,$08,$06,$83,$81,$6C
Data.b $36,$5B,$00,$00,$D7,$75,$9F,$5F,$5E,$5C,$B8,$AE,$FB,$0C,$00,$8C,$B1,$D5,$4A,$A5
Data.b $72,$D4,$EF,$F7,$07,$F1,$78,$3C,$90,$48,$24,$0A,$00,$20,$4E,$26,$13,$B1,$5A,$AD
Data.b $0E,$74,$5D,$0F,$18,$C6,$C1,$C5,$78,$3C,$6E,$CF,$04,$80,$F8,$2A,$18,$8F,$C7,$6D
Data.b $C3,$38,$B8,$D0,$75,$3D,$50,$AD,$56,$07,$93,$C9,$44,$04,$00,$91,$31,$26,$F9,$FD
Data.b $2B,$81,$4C,$26,$73,$5C,$2C,$1E,$EE,$86,$C3,$91,$6D,$5D,$D7,$D7,$05,$41,$20,$A2
Data.b $28,$41,$10,$04,$A2,$EB,$FA,$7A,$38,$1C,$D9,$2E,$16,$0F,$77,$33,$99,$CC,$B1,$DF
Data.b $BF,$12,$60,$8C,$49,$00,$00,$4D,$D3,$F6,$7C,$3E,$DF,$89,$A6,$69,$39,$9F,$CF,$77
Data.b $52,$AB,$D9,$3C,$9D,$DE,$BC,$A4,$94,$E6,$6F,$6E,$EA,$9C,$52,$9A,$4F,$A7,$37,$2F
Data.b $6B,$35,$9B,$FF,$99,$D3,$34,$6D,$EF,$AF,$8B,$2A,$8A,$B2,$E1,$F5,$7A,$4F,$EB,$F5
Data.b $7B,$9E,$4A,$A5,$AF,$6F,$6F,$DB,$3C,$95,$4A,$5F,$D7,$EB,$F7,$DC,$EB,$F5,$9E,$2A
Data.b $8A,$B2,$B1,$E8,$1B,$AF,$C8,$B2,$9C,$F4,$78,$3C,$67,$AD,$56,$97,$DF,$DD,$7D,$E5
Data.b $AD,$56,$97,$7B,$3C,$9E,$33,$59,$96,$93,$FF,$2D,$CF,$A0,$94,$26,$25,$49,$2A,$D9
Data.b $76,$97,$4B,$92,$54,$A2,$94,$BE,$BD,$3C,$83,$10,$92,$24,$84,$94,$08,$21,$FF,$2C
Data.b $FF,$02,$6A,$A2,$D8,$0A,$79,$12,$C2,$C4,$00,$00,$00,$00,$49,$45,$4E,$44,$AE,$42
Data.b $60,$82
Icon4End:
EndDataSection
CatchImage(4, ?Icon4, ?Icon4End-?Icon4)
;}
;
;- CC_CreatorForm_Window_Enum
;
Enumeration Window
#CC_CreatorForm
EndEnumeration
;
;-
;
Procedure CC_CreatorForm_EventGadget( )
If EventType() ! #PB_EventType_MouseMove
Debug "Gadget "+EventType()
EndIf
EndProcedure
Procedure CC_CreatorForm_Gadget( Window,Width,Height )
UseModule ImageButton
Gadget(#PB_Any, 10,10,130,25,"image_left",ImageID(4),#PB_Button_Left)
Gadget(#PB_Any, 10,40,130,25,"image_right",ImageID(4),#PB_Button_Right)
Gadget(#PB_Any, 10,70,130,75,"image_top",ImageID(4),#PB_Button_Top,32,32)
Gadget(#PB_Any, 10,150,130,75,"image_bottom",ImageID(4),#PB_Button_Bottom,32,32)
Gadget(#PB_Any, 10,430,130,75,"",ImageID(4))
Gadget(#PB_Any, 10,230,130,35,"text_center",0,#PB_Button_Default)
Gadget(#PB_Any, 10,270,130,35,"text_left",0,#PB_Button_Left)
Gadget(#PB_Any, 10,310,130,35,"text_right",0,#PB_Button_Right)
Gadget(#PB_Any, 10,350,130,35,"text_top",0,#PB_Button_Top)
Gadget(#PB_Any, 10,390,130,35,"text_bottom",0,#PB_Button_Bottom)
UnuseModule ImageButton
ButtonGadget(#PB_Any, 210,40,130,25,"text center",#PB_Button_Default);"Form_"+Str(Count)+"_Button_"+Str(Count))
ButtonImageGadget(#PB_Any, 210,70,130,75,ImageID(4))
EndProcedure
;
;-
;
Procedure CC_CreatorForm_Window( ParentID = #False, Flag = #PB_Window_ScreenCentered, X = 450, Y = 250, Width = 401, Height = 601 )
Static Window =-1
Window = OpenWindow( #PB_Any, X,Y, Width, Height, "Form_",#PB_Window_Invisible |
#PB_Window_SystemMenu |
#PB_Window_MinimizeGadget |
#PB_Window_MaximizeGadget |
#PB_Window_SizeGadget, ParentID )
CC_CreatorForm_Gadget( Window,Width,Height )
BindEvent(#PB_Event_Gadget, @CC_CreatorForm_EventGadget(),Window)
If ((Flag & #PB_Window_Invisible) ! #PB_Window_Invisible)
HideWindow( Window, #False, Flag )
EndIf
ProcedureReturn Window
EndProcedure
Procedure CC_CreatorForm_Window_Show( ParentID = #False, Flag = #False )
Protected Window
Protected Event
If Not Flag
If ParentID
Flag = #PB_Window_WindowCentered
Else
Flag = #PB_Window_ScreenCentered
EndIf
EndIf
Window = CC_CreatorForm_Window( ParentID, Flag )
While IsWindow( Window )
Event = WaitWindowEvent()
Wend
ProcedureReturn Window
EndProcedure
;
;- CC_CreatorForm_Loop
;
CompilerIf #PB_Compiler_IsMainFile
Define Window = CC_CreatorForm_Window_Show( )
End
CompilerEndIf
DisableExplicit