PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Select colors with / for ButtonImageGadget

https://www.purebasic.fr/english/viewtopic.php?t=2369

Page 1 of 1

Select colors with / for ButtonImageGadget

Posted: Wed Oct 16, 2002 2:55 pm
by BackupUser
Code updated for 5.20+

Restored from previous forum. Originally posted by fweil.

Hello,

As an example of use of colors and buttons, I post a cut of an application program I have (first purpose is to build dynamic popup menus in JS, this part being a color selector). Click one of the buttons to change its color.

I find this code nice to show ...

Code: Select all

Procedure.l MyImage(ImageNumber.l, Width.l, Height.l, Color.l)
  ImageID.l = CreateImage(ImageNumber, Width, Height)
  StartDrawing(ImageOutput(ImageNumber))
    Box(0, 0, Width, Height, Color)
  StopDrawing()
  ProcedureReturn ImageID
EndProcedure

;
; Main starts here
;
Quit.l = #False

If OpenWindow(0, 200, 200, 320, 200, "F.Weil - Colored buttons", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar)
  AddKeyboardShortcut(0, #PB_Shortcut_Escape, 99)
  FrameGadget(205, 100, 80, 80, 60, "Color1", 0)
  ButtonImageGadget(105, 120, 100, 40, 20, MyImage(1, 40, 20, $996600))
  FrameGadget(206, 180, 80, 80, 60, "Color2", 0)
  ButtonImageGadget(106, 200, 100, 40, 20, MyImage(2, 40, 20, $999933))
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Quit = #True
      Case #PB_Event_Menu
        Select EventMenu()
          Case 99
            Quit = #True
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 105                                                         ; Select first color
            FreeGadget(105)
            ButtonImageGadget(105, 120, 100, 40, 20, MyImage(1, 40, 20, ColorRequester()))
          Case 106                                                         ; Select second color
            FreeGadget(106)
            ButtonImageGadget(106, 200, 100, 40, 20, MyImage(2, 40, 20, ColorRequester()))
        EndSelect
    EndSelect
  Until Quit
EndIf
End
Francois Weil
14, rue Douer
F64100 Bayonne

Posted: Fri Sep 05, 2003 4:32 am
by MikeB
The coloured buttons bit is just what I was wanting, an easy way to get a coloured text button, a quick modification and you have the text! If the text is off center it is probably because you are using a different font, change the x & y values.

Procedure.l MyImage(ImageNumber.l, Width.l, Height.l, Color.l,a$,x,y)
ImageID.l = CreateImage(ImageNumber, Width, Height)
StartDrawing(ImageOutput())
DrawingMode(1)
Box(0, 0, Width, Height, Color)
FrontColor(0,0,0)
Locate(x,y)
DrawText(a$)
StopDrawing()
ProcedureReturn ImageID
EndProcedure


mywin=OpenWindow(0,0,0,218,68,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"Coloured buttons")
If mywin
wbrush=createsolidbrush_(RGB(0,0,255))
setclasslong_(mywin, #GCL_HBRBACKGROUND, wbrush)
If CreateGadgetList(mywin)
hGadget=ContainerGadget (0,10,10,198,48,#PB_Container_Raised)
hBrush = CreateSolidBrush_(RGB(255,255,0))
SetClassLong_(hGadget, #GCL_HBRBACKGROUND, hBrush)
;
ButtonImageGadget(1, 10, 8, 80, 24,MyImage(1,80,24,RGB(255,155,0),"Button 1",13,4))
;
ButtonimageGadget(2, 100, 8, 80, 24,MyImage(2,80,24,RGB(255,155,0),"Button 2",13,4))
CloseGadgetList()
EndIf
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
EndIf

MikeB

Posted: Wed Feb 22, 2006 9:18 am
by PB
And here's MikeB's code updated for v4.00 because it doesn't support ButtonGadget color yet:

Code: Select all

; Original code by MikeB.
; Updated to v4.00 by PB.

Procedure  ColorButton(gadget,text.s,x,y,width.l,height.l,color.l)
  iih.l=CreateImage(#PB_Any,width.l,height.l)
  If StartDrawing(ImageOutput(0))
     Box(0,0,width.l,height.l,color.l)
     If text.s<>"":DrawText(2,2,text.s):EndIf
     StopDrawing()
   EndIf
  ButtonImageGadget(gadget,x,y,width.l,height.l,iih.l)
EndProcedure

Procedure.l MyImage(ImageNumber.l,Width.l,Height.l,Color.l,a$,x,y)
  ImageID.l=CreateImage(ImageNumber,Width,Height)
  StartDrawing(ImageOutput(ImageNumber))
  DrawingMode(1)
  Box(0,0,Width,Height,Color)
  FrontColor(RGB(0,0,0))
  DrawText(x,y,a$)
  StopDrawing()
  ProcedureReturn ImageID
EndProcedure

mywin=OpenWindow(0,300,200,218,68,#PB_Window_SystemMenu,"Coloured buttons")
If mywin
  wbrush=CreateSolidBrush_(RGB(0,0,255))
  SetClassLong_(mywin,#GCL_HBRBACKGROUND,wbrush)
  If CreateGadgetList(mywin)
    hGadget=ContainerGadget(0,10,10,198,48,#PB_Container_Raised)
    hBrush=CreateSolidBrush_(RGB(255,255,0))
    SetClassLong_(hGadget,#GCL_HBRBACKGROUND,hBrush)
    ButtonImageGadget(1,10,8,80,24,MyImage(1,80,24,RGB(255,155,0),"Button 1",13,4))
    ButtonImageGadget(2,100,8,80,24,MyImage(2,80,24,RGB(255,0,0),"Button 2",13,4))
    CloseGadgetList()
  EndIf
  Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
EndIf

Posted: Wed Feb 22, 2006 4:13 pm
by MLK
and here is MLKs ColorButton for PB4

Code: Select all

Procedure XOrColor(c1) ;by Deeem2031
  c2 = 0:If c1&$FF < 128:c2 | $FF:EndIf:If (c1&$FF00)>>8 < 128:c2 | $FF00:EndIf:If (c1&$FF0000)>>16 < 128:c2 | $FF0000:EndIf
  ProcedureReturn c2
EndProcedure

Procedure ChangeColorButton(Gadget.l, Color.l, Text$ = "")
  Static Font : If Not Font : Font = GetGadgetFont(#PB_Default) : EndIf
  
  width = GadgetWidth(Gadget)
  height= GadgetHeight(Gadget)
  
  Image = GetGadgetData(Gadget)
  If Not Image
    Image = CreateImage(-1, width, height)
    SetGadgetData(Gadget, Image)
  EndIf  
  
  If StartDrawing(ImageOutput(Image))
    Box(0, 0, width, height, Color)
    DrawingMode(2 | 4)
    Box(0, 0, width, height, Color)
    DrawingFont(Font)
    DrawingMode(1)
    DrawText(width/2-TextWidth(Text$)/2, height/2-TextHeight(Text$)/2, Text$, XOrColor(Color))
    StopDrawing()
    ProcedureReturn SetGadgetState(Gadget, ImageID(Image))
  EndIf
EndProcedure




OpenWindow(0, 0, 0, 100, 35, #PB_Window_ScreenCentered, #Null$) 
CreateGadgetList(WindowID(0))
Button = ButtonImageGadget(-1, 5, 5, 90, 25, #Null) : ChangeColorButton(Button, $FF0000, "ColorButton")

Repeat
  If WaitWindowEvent() = #PB_Event_Gadget And EventGadget() = Button
    ChangeColorButton(Button, Random($FFFFFF), "ColorButton")
  EndIf 
Until GetAsyncKeyState_(#VK_ESCAPE)
until DrawingMode(XOR) doesnt support DrawText(), there is XorColor() needed.

(u can use an ImageGadget instead of ButtonImageGadget to get a colored 'button' in flat style.)

Posted: Wed Feb 22, 2006 6:42 pm
by ABBKlaus
and this one works as well with disabling the button :

Code: Select all

; Original code by MikeB. 
; Updated to v4.00 by PB. 

Procedure  ColorButton(gadget,text.s,x,y,width.l,height.l,color.l) 
  iih.l=CreateImage(#PB_Any,width.l,height.l) 
  If StartDrawing(ImageOutput(0)) 
     Box(0,0,width.l,height.l,color.l) 
     If text.s<>"":DrawText(2,2,text.s):EndIf 
     StopDrawing() 
   EndIf 
  ButtonImageGadget(gadget,x,y,width.l,height.l,iih.l) 
EndProcedure 

Procedure.l MyImage(ImageNumber.l,Width.l,Height.l,Color.l,a$,x,y) 
  ImageID.l=CreateImage(ImageNumber,Width,Height) 
  StartDrawing(ImageOutput(ImageNumber)) 
  DrawingMode(1) 
  Box(0,0,Width,Height,Color) 
  FrontColor(RGB(0,0,0)) 
  DrawText(x,y,a$) 
  StopDrawing() 
  ProcedureReturn ImageID 
EndProcedure 

Procedure ChangeImage(GadgetID,ImageID,Enable)
  GadgetHandle=GadgetID(GadgetID)
  If Enable=#True
    DisableGadget(GadgetID,#False)
    SetWindowLong_(GadgetHandle,#GWL_STYLE,GetWindowLong_(GadgetHandle,#GWL_STYLE)|#BS_BITMAP)
    SendMessage_(GadgetHandle,#BM_SETIMAGE,#IMAGE_BITMAP,ImageID(ImageID))
    InvalidateRect_(GadgetHandle,0,1)
  Else
    SetWindowLong_(GadgetHandle,#GWL_STYLE,GetWindowLong_(GadgetHandle,#GWL_STYLE)&~#BS_BITMAP)
    DisableGadget(GadgetID,#True)
    InvalidateRect_(GadgetHandle,0,1)
  EndIf
EndProcedure

mywin=OpenWindow(0,300,200,218,68,#PB_Window_SystemMenu,"Coloured buttons") 
If mywin 
  wbrush=CreateSolidBrush_(RGB(0,0,255)) 
  SetClassLong_(mywin,#GCL_HBRBACKGROUND,wbrush) 
  If CreateGadgetList(mywin) 
    hGadget=ContainerGadget(0,10,10,198,48,#PB_Container_Raised) 
    hBrush=CreateSolidBrush_(RGB(255,255,0)) 
    SetClassLong_(hGadget,#GCL_HBRBACKGROUND,hBrush)
    Button1=MyImage(1,80,24,RGB(255,155,0),"Button 1",13,4)
    Button2=MyImage(2,80,24,RGB(255,0,0),"Button 2",13,4)
    ButtonGadget(1,10,8,80,24,"Button 1")
    ButtonGadget(2,100,8,80,24,"Button 2") 
    CloseGadgetList() 
  EndIf
  ChangeImage(1,1,#True)
  ChangeImage(2,2,#False)
  Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow 
EndIf

Posted: Wed Feb 22, 2006 6:52 pm
by ts-soft
>> and this one works as well with disabling the button :
but looks not like xp-style

Posted: Fri Dec 15, 2006 12:12 pm
by RichardL
I put together the attached code in rather a hurry to demonstrate an idea.
It is based on ideas in earlier entries in this topic.
Only lightly tested... but seems to work.

Code: Select all

Procedure.l ButtonImageText(GadNum.l,Caption$,ForeColour.l,BackColour.l,Font.l) ;- Draw text on a ButtonImageGadget
  ; A method of drawing multi-line text into a ButtonImageGadget() with 
  ; user specified Foreground and Background colours and Font
  
  ; Plus...
  
  ; If the first text element starts with '~' the rest of the element is parsed
  ; as a number that identifies an image to be drawn on the left of the button.
  ; The image is left aligned in the box with a small margin and text is put to the right.
  
  ; Recover the width and height of the gadget
  Bw.w  = GadgetWidth(GadNum.l) 
  Bh.w  = GadgetHeight(GadNum.l)
  
  ; Recover/create the Image ID
  hI.l  = GetGadgetData(GadNum)            ; Get a previously stored Image ID
  If hI.l = 0                              ; If one does not exist...
    hI.l = CreateImage(-1, Bw.w, Bh.w)     ; Make an image 
    SetGadgetData(GadNum, hI.l)            ; Store it's ID for next time
  EndIf 
  
  ; If a font is not specified then use the PB standard one
  If Font.l = 0
    Font.l = GetGadgetFont(#PB_Default)
  EndIf
  
  ; Do the drawing etc...
  If StartDrawing(ImageOutput(hI.l))
    
    ; Fill whole area with background colour
    DrawingMode(#PB_2DDrawing_Transparent)
    Box(0,0,Bw,Bh,BackColour)
    
    ;Prepare to draw...
    DrawingFont(Font)                         ; Set the font to be used
    Fh.w  =  TextHeight(Caption$)             ; The height of the caption = row spacing
    Ne.w  = CountString(Caption$,"|")+1       ; Number of elements in the caption = number of lines.
    
    Fe.w = 1                                  ; First text element to draw
    x.w = 0                                   ; Default horizontal offset for text
    If Left(Caption$,1)="~"                   ; If an image is specified
      Fe.w=2                                  ; The first text element is the second field in the caption
      k$=StringField(Caption$,1,"|")          ; Extract the image ID field...
      P_ID.l = Val(PeekS(@k$+1))              ; and get the image ID from it
      x.w = ImageWidth(P_ID)+7                ; Adjust the offset for the text
      DrawImage(ImageID(P_ID),7,(Bh-ImageHeight(P_ID))/2) ; Draw the image
    EndIf
    
    Vs.w = Bh /(Ne.w+2-Fe.w)                  ; Vertical spacing of lines, half a line top and bottom
    y.w  = (Bh-(Ne.w+1-Fe.w)* Fh.w)/2         ; Vertical position of first line
    FrontColor(ForeColour)                    ; Set the colour for the text
    
    If Ne.w=>Fe.w
      For n.w = Fe.w To Ne.w                  ; For each line of the caption...
        k$=StringField(Caption$,n.w,"|")      ; Extract the text element
        DrawText(x.w+(Bw-TextWidth(k$)-x.w)/2, y.w, k$,ForeColour); Put it on the image, centralised in the text area
        y.w + Vs.w                            ; Move the vertical position down by one line
      Next
    EndIf
    StopDrawing()
    
    ; Refresh the gadget from the image
    SetGadgetState(GadNum,ImageID(hI))
  EndIf
  
EndProcedure

; Test my text + colour button.
OpenWindow(0, 0, 0, 300, 100, "ButtonImage Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))

ButtonImageGadget(1, 10, 10, 200, 80,#Null ) ; Create the button
f.l = LoadFont(1,"arial",12)                 ; Select a font for the button
ButtonImageText(1,"Fred is here",Random($FFFFFF),Random($FFFFFF),f.l ) ; Draw the initial content

; Create a test image to display to the left of the text
TestImage.w = 2
CreateImage(TestImage.w,50,50)
StartDrawing(ImageOutput(2))
Box(0,0,50,50,$FFFFFF)
Circle(25,25,15,$00FF00)
StopDrawing()

Repeat 
  EventID = WaitWindowEvent()
  
  Select EventID
    Case #PB_Event_CloseWindow 
    End
    
    Case #PB_Event_Gadget 
      Select EventGadget()
        Case 1
           
          ButtonImageText(1,"~"+Str(TestImage.w)+"|Press this button|to feed all|the fish in the sky.",Random($FFFFFF),Random($FFFFFF),f.l)
          ;ButtonImageText(1,"Press this button|to feed all|the fish in the sea.",Random($FFFFFF),Random($FFFFFF),f.l)
          ;ButtonImageText(1,"~"+Str(TestImage.w)+"",Random($FFFFFF),Random($FFFFFF),f.l)
          ;ButtonImageText(1,"",Random($FFFFFF),Random($FFFFFF),f.l)
          
      EndSelect
      
  EndSelect
  
ForEver
Feel free to use, modify or discard...

Posted: Fri Dec 15, 2006 1:33 pm
by rsts
Very nice. I like it - especially the part about the fish :)

cheers
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited