ButtonColor

[incaroad]

Thank you Bisonte, but it stops with an "Invalid memory access" error message.

[Bisonte]

Thank you Bisonte, but it stops with an "Invalid memory access" error message.

have you changed the "gadgetnumber.l" parameter from LONG to INTEGER in your dll ?

[incaroad]

have you changed the "gadgetnumber.l" parameter from LONG to INTEGER in your dll ?

Of course, I did everything you described.

[mk-soft]

It makes no sense to use the obsolete PureColor.
1. It is too expensive to use an extra DLL.
2. PureColor only supports buttons without themes.

So better write your own color buttons...


There are so many examples of custom buttons.

Here comes the 42nd

Update v1.02
- Bugfix Draw

Update v1.03
- Bugfix Memory leak (Free Resources)

Code: Select all

;-TOP
; Comment : ButtonColorGadget Number 42 ;)
; Author  : mk-soft
; Version : v1.03
; Create  : 30.04.2019

; OS      : All

EnableExplicit

; *****************************************************************************

Structure udtCommonData
  Gadget.i
  Image.i
  Image2.i
EndStructure

Structure udtButtonColorGadget Extends udtCommonData
  Text.s
  FontID.i
  FrontColor.i
  BackColor.i
  LineColor.i
EndStructure

; ----

Procedure DrawButtonColorGadget(*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 SetButtonText(Gadget, Text.s)
  Protected *data.udtButtonColorGadget
  
  With *data
    *data = GetGadgetData(Gadget)
    If *data And *data\Gadget = Gadget
      \Text = Text
      DrawButtonColorGadget(*data)
    EndIf
  EndWith
EndProcedure

; ----

Procedure SetButtonFont(Gadget, FontID = #PB_Default)
  Protected *data.udtButtonColorGadget
  
  With *data
    *data = GetGadgetData(Gadget)
    If *data And *data\Gadget = Gadget
      \FontID = FontID 
      DrawButtonColorGadget(*data)
    EndIf
  EndWith
EndProcedure

; ----

Procedure SetButtonColor(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
      DrawButtonColorGadget(*data)
    EndIf
  EndWith
EndProcedure

; ----

Procedure SetButtonSize(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
      DrawButtonColorGadget(*data)
    EndIf
  EndWith
EndProcedure

; ----

Procedure ButtonColorGadget(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 DestroyGadget(Gadget)
  Protected *data.udtCommonData
  With *data
    *data = GetGadgetData(Gadget)
    If *data And *data\Gadget = Gadget
      If \Image
        Debug "Free Resources Image"
        FreeImage(\Image)
      EndIf
      If \Image2
        Debug "Free Resources Image 2"
        FreeImage(\Image2)
      EndIf
      Debug "Free Memory"
      FreeStructure(*data)
    EndIf
    FreeGadget(Gadget)
  EndWith
EndProcedure

; *****************************************************************************

;- 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, "ButtonColorGadget Number 42 ;)" , #PB_Window_SystemMenu)
      ButtonColorGadget(#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
                  SetButtonSize(#Button, #PB_Ignore, #PB_Ignore, 240, 60)
                  SetButtonText(#Button, "My Big Button")
                  SetButtonFont(#Button, FontID(0))
                  SetButtonColor(#Button, #PB_Gadget_BackColor, #Green)
                  SetButtonColor(#Button, #PB_Gadget_FrontColor, #Black)
                  SetButtonColor(#Button, #PB_Gadget_LineColor, #Red)
                Else
                  SetButtonSize(#Button, #PB_Ignore, #PB_Ignore, 120, 30)
                  SetButtonText(#Button, "My Button")
                  SetButtonFont(#Button, #PB_Default)
                  SetButtonColor(#Button, #PB_Gadget_BackColor, #Red)
                  SetButtonColor(#Button, #PB_Gadget_FrontColor, #Yellow)
                  SetButtonColor(#Button, #PB_Gadget_LineColor, #Gray)
                EndIf
            EndSelect
            
        EndSelect
      ForEver
      
      DestroyGadget(#Button)
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf