ButtonColorGadget (CrossPlattform)

[ts-soft]

Weil immer mal wieder gefragt wird

Code: Alles auswählen

; target OS all (windows erfordert XP-Style enabled!)

; Version: 4.0 ++ (ich bekomme mit 4.20 einen IMA ???)

; Id, x, y, w, h, text.s, flags = wie bei ButtonGadget auch!
; fcolor = FrontColor, bcolor = BackColor, fontid = FontID()
Procedure ButtonColorGadget(Id, x, y, w, h, text.s, fcolor, bcolor, flags = 0, fontid = #PB_Font_Default)
  Protected img
  img = CreateImage(#PB_Any, w, h)
  If StartDrawing(ImageOutput(img))
    DrawingFont(fontid)
    Box(0, 0, w, h, bcolor)
    DrawText(w / 2 - TextWidth(text) / 2, h / 2 - TextHeight(text) / 2, text, fcolor, bcolor)
    StopDrawing()
    ProcedureReturn  ButtonImageGadget(Id, x, y, w, h, ImageID(img), flags)
  EndIf
EndProcedure

; Beispiel
Define btnBlack, btnWhite

OpenWindow(0, 100, 100, 340, 100, "ColorButton", #PB_Window_SystemMenu)
ButtonColorGadget(1, 10, 10, 150, 30, "toogle", #Black, #Red, #PB_Button_Toggle)
ButtonColorGadget(2, 10, 50, 150, 30, "courier", #Blue, #Yellow, 0, LoadFont(0, "courier", 10))
btnBlack = ButtonColorGadget(#PB_Any, 170, 10, 150, 30, "black / white", #Black, #White)
btnWhite = ButtonColorGadget(#PB_Any, 170, 50, 150, 30, "white  / black", #White, #Black)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          Debug "red / black"
        Case 2
          Debug "blue / yellow"
        Case btnBlack
          Debug "black / white"
        Case btnWhite
          Debug "white / black"
      EndSelect
  EndSelect
ForEver

[Andesdaf]

schöne Sache

[michel51]

...
Procedure ButtonColorGadget(Id, x, y, w, h, text.s, fcolor, bcolor, flags = 0, fontid = #PB_Default)
...[/code]

Leider nicht ganz "crossplattform".

PB V 4.30 PPC (Mac) läßt nur max. 9 Parameter bei Proceduren zu.

[Kaeru Gaman]

PB V 4.30 PPC (Mac) läßt nur max. 9 Parameter bei Proceduren zu.

LOL?

... das ist ja tiefstes Mittelalter!

[ts-soft]

Leider nicht ganz "crossplattform".

PB V 4.30 PPC (Mac) läßt nur max. 9 Parameter bei Proceduren zu.

Da kann ich dann aber leider nichts ändern. Ich hab kein äpfelchen, kann
somit nicht testen und halte mich nur an die PB-Hilfe.

Wirste Dich also entscheiden müssen, auf welchen Parameter Du verzichtest.

Gruß

Thomas

[michel51]

PB V 4.30 PPC (Mac) läßt nur max. 9 Parameter bei Proceduren zu.

LOL?

... das ist ja tiefstes Mittelalter!

Danke für das "Kompliment" !!!!!
Hat ja nicht jeder eine Geldpresse im Keller!

[ts-soft]

Version für MacOS:

Code: Alles auswählen

EnableExplicit
; Farbkonstanten sind nur auf Windows vordefiniert
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
  #Black  = $000000
  #Red    = $0000FF
  #Blue   = $FF0000
  #Yellow = $00FFFF
  #White  = $FFFFFF
CompilerEndIf

Define fontid = #PB_Font_Default

Procedure SetColorButtonGadgetFont(font = #PB_Font_Default)
  Shared fontid
  fontid = font
EndProcedure

Procedure ButtonColorGadget(Id, x, y, w, h, text.s, fcolor, bcolor, flags = 0)
  Shared fontid
  Protected img
  img = CreateImage(#PB_Any, w, h)
  If StartDrawing(ImageOutput(img))
    DrawingFont(fontid)
    SetColorButtonGadgetFont()
    Box(0, 0, w, h, bcolor)
    DrawText(w / 2 - TextWidth(text) / 2, h / 2 - TextHeight(text) / 2, text, fcolor, bcolor)
    StopDrawing()
    ProcedureReturn  ButtonImageGadget(Id, x, y, w, h, ImageID(img), flags)
  EndIf
EndProcedure

; Beispiel
Define btnBlack, btnWhite

OpenWindow(0, 100, 100, 340, 100, "ColorButton", #PB_Window_SystemMenu)
ButtonColorGadget(1, 10, 10, 150, 30, "toogle", #Black, #Red, #PB_Button_Toggle)
SetColorButtonGadgetFont(LoadFont(0, "courier", 10))
ButtonColorGadget(2, 10, 50, 150, 30, "courier", #Blue, #Yellow)
btnBlack = ButtonColorGadget(#PB_Any, 170, 10, 150, 30, "black / white", #Black, #White)
btnWhite = ButtonColorGadget(#PB_Any, 170, 50, 150, 30, "white  / black", #White, #Black)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          Debug "red / black"
        Case 2
          Debug "blue / yellow"
        Case btnBlack
          Debug "black / white"
        Case btnWhite
          Debug "white / black"
      EndSelect
  EndSelect
ForEver

[edel]

sieht bestimmt ganz toll aus mit "DrawingFont(fontid) "

[michel51]

Version für MacOS:

Code: Alles auswählen

...
  If StartDrawing(ImageOutput(img))
    DrawingFont(fontid)      <-#######
    SetColorButtonGadgetFont()  <-######
...

Wenn man diese beiden Zeilen vertauscht, funktioniert es. Ich habe dann schöne farbige Buttons
Also:

Code: Alles auswählen

...
 If StartDrawing(ImageOutput(img))
    SetColorButtonGadgetFont()
    DrawingFont(fontid)  ...

und es klappt...

Danke für den Code und die Anpassung !

[edel]

Weiss ja nicht wie das unter Mac so ist, aber #PB_Default mit DrawingFont
ist nicht das gleiche wie PB_Default mit GetGadgetFont.

Sowas macht also nicht wirklich sinn :

Code: Alles auswählen

Define fontid = #PB_Default 

Es muesste dann heissen :

Code: Alles auswählen

Define fontid = GetGadgetFont(#PB_Default)

Oder man laesst es gleich auf null und aendert SetColorButtonGadgetFont so :

Code: Alles auswählen

Procedure SetColorButtonGadgetFont(font = #PB_Default) 
  Shared fontid 
  If font = #PB_Default
    fontid = GetGadgetFont(font)
  Else
    fontid = font 
  EndIf 
EndProcedure