FlatButtonEx Crossplattform

[uwekel]

I am using the code below for myself. My primary system is Linux but also develop on Windows. Mac is not supported so far. If i want to get a system colour, i have to hand-over a gadget and the state of the gadget (enabled, desabled, selected...). Then this procedure returns the corresponding colour.

Code: Select all

Procedure.l GtkGadgetColor(Gadget, Type, State)
  ;color types
  #GtkGadgetColorBase = 0
  #GtkGadgetColorBg = 1
  #GtkGadgetColorDark = 2
  #GtkGadgetColorFg = 3
  #GtkGadgetColorLight = 4
  #GtkGadgetColorText = 5
  ;states
  #GtkStateNormal = 0
  #GtkStateActive = 1
  #GtkStatePrelight = 2
  #GtkStateSelected = 3
  #GtkStateIntensitive = 4
  CompilerSelect #PB_Compiler_OS
    CompilerCase #PB_OS_Linux
      ;returns a widget color
      Protected *style.GtkStyle, *color.GdkColor
      ;get widget style
      *style = gtk_widget_get_style_(GadgetID(Gadget))
      ;return color according type and state
      Select Type
        Case #GtkGadgetColorBase
          *color = *style\base[State]
        Case #GtkGadgetColorBg
          *color = *style\bg[State]
        Case #GtkGadgetColorDark
          *color = *style\dark[State]
        Case #GtkGadgetColorFg
          *color = *style\fg[State]
        Case #GtkGadgetColorLight
          *color = *style\light[State]
        Case #GtkGadgetColorText
          *color = *style\text[State]
      EndSelect
      ;return color value
      ProcedureReturn RGB(*color\red >> 8, *color\green >> 8, *color\blue >> 8)
    CompilerCase #PB_OS_Windows
      Select Type
        Case #GtkGadgetColorBg, #GtkGadgetColorBase
          If State = #GtkStateSelected
            ProcedureReturn GetSysColor_(#COLOR_HIGHLIGHT)
          Else
            ProcedureReturn GetSysColor_(#COLOR_WINDOW)
          EndIf
        Case #GtkGadgetColorFg, #GtkGadgetColorText
          If State = #GtkStateSelected
            ProcedureReturn GetSysColor_(#COLOR_HIGHLIGHTTEXT)
          Else
            ProcedureReturn GetSysColor_(#COLOR_WINDOWTEXT)
          EndIf
        Case #GtkGadgetColorDark
          ProcedureReturn GetSysColor_(#COLOR_BTNSHADOW)
        Case #GtkGadgetColorLight
          ProcedureReturn GetSysColor_(#COLOR_3DLIGHT)
      EndSelect
  CompilerEndSelect
EndProcedure

[ts-soft]

Thx
I will add it for the next update!

[ts-soft]

Update:

; Version 1.6 (Feb 24, 2013)
; changed GetSpaceSupport() to GetShortCut()
; changed SetSpaceSupport() to SetShortCut(), default is #PB_Shortcut_Space, set to 0 for none shortcutsupport
; added default systemcolor for Linux, thx to uwekel

; Version 1.7 (Feb 24, 2013)
; added Gradient-Support
; SetGradient() and SetHotGradient()

[ts-soft]

Update:

; Version 1.8 (Feb 25, 2013)
; added Gradient-Type: SetGradientType([Type.i[, customcallback.i]])
; with types:
; #FlatButtonEx_Gradient_Linear (default)
; #FlatButtonEx_Gradient_Boxed
; #FlatButtonEx_Gradient_Custom (requires customcallback)

; Version 1.8.1 (Feb 25, 2013)
; added Support for texthotcolor
; new colorconstant: #FlatButtonEx_Color_TextHotColor

[wilbert]

For OS X (PB 5.10 Cocoa), you can get system colors like this

Code: Select all

CompilerCase #PB_OS_MacOS
  Protected ColorName.s, Color.i
  Protected.CGFloat R, G, B, A
  Select Type
    Case #GtkGadgetColorBg
      ColorName = "controlBackgroundColor"
    Case #GtkGadgetColorLight
      ColorName = "controlHighlightColor"
  EndSelect
  Color = CocoaMessage(0, 0, "NSColor " + ColorName)
  If Color : Color = CocoaMessage(0, Color, "colorUsingColorSpaceName:$", @"NSDeviceRGBColorSpace") : EndIf
  If Color : CocoaMessage(0, Color, "getRed:", @R, "green:", @G, "blue:", @B, "alpha:", @A) : EndIf
  ProcedureReturn RGBA(R * 255, G * 255, B * 255, A * 255)  
CompilerEndSelect

You first have to create a NSColor object using the color name and after that convert it to RGB color space and get the component values.
Possible color names for system colors are

Code: Select all

+ alternateSelectedControlColor
+ alternateSelectedControlTextColor
+ controlBackgroundColor
+ controlColor
+ controlAlternatingRowBackgroundColors
+ controlHighlightColor
+ controlLightHighlightColor
+ controlShadowColor
+ controlDarkShadowColor
+ controlTextColor
+ currentControlTint
+ disabledControlTextColor
+ gridColor
+ headerColor
+ headerTextColor
+ highlightColor
+ keyboardFocusIndicatorColor
+ knobColor
+ scrollBarColor
+ secondarySelectedControlColor
+ selectedControlColor
+ selectedControlTextColor
+ selectedMenuItemColor
+ selectedMenuItemTextColor
+ selectedTextBackgroundColor
+ selectedTextColor
+ selectedKnobColor
+ shadowColor
+ textBackgroundColor
+ textColor
+ windowBackgroundColor
+ windowFrameColor
+ windowFrameTextColor
+ underPageBackgroundColor

[ts-soft]

thx wilbert

Update:

; Version 1.8.2 (Feb 25, 2013)
; added default systemcolor for MacOSX, thx to wilbert

I think, it is complete now

[ts-soft]

Update:

; Version 1.8.3 (Feb 25, 2013)
; added Icon-Support for Windows
; Attention: Icons can't be resized!

[Frabbing]

An error in all buttons: The right bottom pixel is missing...?

[ts-soft]

An error in all buttons: The right bottom pixel is missing...?

Thx for report, fixed

Update:

; Version 1.8.4 (Feb 25, 2013)
; fixed a bug with right bottom pixel

[Frabbing]

Thank you!

[ts-soft]

Update:

; Version 1.9
; added: Icon resizing is full supported (windows only)
; optimized code

[idle]

looking good!

On linux, when I move the mouse over a button while it's got the keyboard focus (dotted box) it flickers
testing for mouse move fixes it

line 632

Code: Select all

  With *this
     If EventType <> #PB_EventType_MouseMove 
        StartDrawing(CanvasOutput(\ID))

[ts-soft]

thx for bugreport
I can't change this like you suggest, this give a problem with mouse outside button on windows.
I have made a other change (line 675), please check this.

Greetings - Thomas

[idle]

That still flickers, the issue appears to be caused from startdrawing()

Code: Select all

  CompilerIf #PB_Compiler_OS = #PB_OS_Linux 
            If EventType <> #PB_EventType_MouseMove 
         CompilerEndIf  

[ts-soft]

fixed (i hope it )