Page 1 of 1

ButtonGadget ( background color & window font )

Posted: Thu Nov 18, 2004 4:43 am
by eddy
Code updated For 5.20+

It works like the PB standard command "ButtonGadget"

3 functions:
- Load Window Font
- Color Button Callback
- Color Button

Code: Select all

; ==========================
; load window font (from gadget or window)
; ==========================

Procedure LoadWindowFont(fntID,source)
  Protected fnt.l,fntName$,fntWeight.l,fntHeight.l,fntStyle.l
  Protected NewFont.l
  
  fnt.l = SendMessage_(source, #WM_GETFONT, 0, 0)
  GetObject_(fnt, SizeOf(LOGFONT), @lf.LOGFONT) 
  fntName$ = PeekS(@lf\lfFacename)
  fntWeight.l = lf\lfWeight
  fntHeight.l = Round(-lf\lfHeight*72/GetDeviceCaps_(GetDC_(source),#LOGPIXELSY),1)     
  fntStyle=0
  
  If lf\lfWeight>400
    fntStyle|#PB_Font_Bold
  EndIf
  If lf\lfItalic
    fntStyle|#PB_Font_Italic
  EndIf
  If lf\lfUnderline
    fntStyle|#PB_Font_Underline
  EndIf
  If lf\lfStrikeOut
    fntStyle|#PB_Font_StrikeOut
  EndIf
  If lf\lfQuality<>#DEFAULT_QUALITY
    fntStyle|#PB_Font_HighQuality
  EndIf   
  
  NewFont=LoadFont(fntID,fntName$,fntHeight,fntStyle)
  ProcedureReturn NewFont
EndProcedure

; ==========================
; Create colored button
; ==========================

Procedure ColorButtonCallBack(Window.l, Message.l, wParam.l, lParam.l )
  Protected button
  Protected buttonSkin.l
  Protected buttonCB.l 
  Protected buttonImageID.l,buttonImageID2.l
  
  button=Window
  buttonSkin=GetWindowLong_(button, #GWL_USERDATA )
  
  ;get information
  buttonSkin.l =GetWindowLong_(button, #GWL_USERDATA)
  buttonImageID  =PeekL(buttonSkin+ 0) ;normal
  buttonImageID2 =PeekL(buttonSkin+ 4) ;pushed   
  buttonCB=PeekL(buttonSkin+8)   
  ID=PeekL(buttonSkin+12) 
  
  Select Message
    Case #WM_DESTROY   
      GlobalFree_( buttonSkin )
      PostQuitMessage_(0)
      
    Case #WM_LBUTTONDOWN
      ;change image
      ;              UseImage(buttonImageID2)
      SendMessage_(button,#BM_SETIMAGE,#IMAGE_BITMAP,ImageID(buttonImageID2))     
      InvalidateRect_(button,0,1)
      
    Case #WM_LBUTTONUP
      ;change image
      ;              UseImage(buttonImageID)
      SendMessage_(button,#BM_SETIMAGE,#IMAGE_BITMAP,ImageID(buttonImageID))     
      InvalidateRect_(button,0,1)
    Case #WM_ENABLE
      ;enable / disable color image
      enable=wParam
      If enable
        SetWindowLong_(button,#GWL_STYLE,GetWindowLong_(button,#GWL_STYLE)|#BS_BITMAP)
      Else
        SetWindowLong_(button,#GWL_STYLE,GetWindowLong_(button,#GWL_STYLE)!#BS_BITMAP)
      EndIf
      
    Case #BM_SETCHECK
      ;change image
      ;              UseImage(buttonImageID)
      If wParam=#BST_CHECKED
        buttonImageID=buttonImageID2
      EndIf
      SendMessage_(button,#BM_SETIMAGE,#IMAGE_BITMAP,ImageID(buttonImageID))       
      InvalidateRect_(button,0,1)
  EndSelect
  
  result.l = CallWindowProc_(buttonCB, Window, Message, wParam, lParam )
  
  ProcedureReturn result
  
EndProcedure

; ==========================
; Create colored button
; ==========================

Procedure ColorButtonGadget(ID,x,y,w,h,txt.s,colorBG,colorTXT,colorBG2,colorTXT2,flags)
  Protected button
  Protected buttonSkin.l
  Protected buttonFlags.l
  Protected buttonFontID.l
  Protected buttonImageID.l,buttonImageID2.l
  Protected buttonImageDC.l
  
  
  Protected buttonTxtSize.SIZE
  Protected buttonTxtH
  Protected buttonTxtMargin
  Protected buttonTxtX
  Protected buttonTxtY
  Protected buttonTxtAlign
  
  buttonFlags=flags|#BS_BITMAP
  If (flags&#PB_Button_Left)  : buttonFlags!#PB_Button_Left : EndIf
  If (flags&#PB_Button_Right) : buttonFlags!#PB_Button_Right : EndIf
  button=ButtonGadget(ID,x,y,w,h,txt,buttonFlags) 
  If ID=#PB_Any 
    ID=button
    button=GadgetID(ID)
    result=ID
  Else
    result=button   
  EndIf 
  
  ; ================
  ; Button Normal
  ; ================
  buttonImageID=CreateImage(#PB_Any,w,h)
  buttonFontID=LoadWindowFont(#PB_Any,GadgetID(ID))
  buttonImageDC.l = StartDrawing(ImageOutput(buttonImageID))
  ;back color
  DrawingMode(1)
  Box(0, 0, w,h, colorBG) 
  ;text color
  FrontColor(RGB(Red(colorTXT),Green(colorTXT),Blue(colorTXT)))
  ;text font
  
  DrawingFont(FontID(buttonFontID)) 
  ;text align
  GetTextExtentPoint32_(buttonImageDC,txt,Len(txt),@buttonTxtSize)
  buttonTxtH = buttonTxtSize\cy
  buttonTxtMargin = 4
  If (flags&#PB_Button_Left)
    buttonTxtX=buttonTxtMargin
    buttonTxtY=(h-buttonTxtH)/2
    buttonTxtAlign=#TA_LEFT
  ElseIf (flags&#PB_Button_Right)
    buttonTxtX=w-buttonTxtMargin
    buttonTxtY=(h-buttonTxtH)/2
    buttonTxtAlign=#TA_RIGHT
  Else   
    buttonTxtX=w/2
    buttonTxtY=(h-buttonTxtH)/2
    buttonTxtAlign=#TA_CENTER
  EndIf         
  DrawText(buttonTxtX,buttonTxtY,"")
  SetTextAlign_(buttonImageDC,buttonTxtAlign|#TA_UPDATECP) 
  ;draw text
  GetClientRect_(button,rc.Rect)
  DrawText_(buttonImageDC,txt,Len(txt),rc,0)
  StopDrawing()
  
  ; ================
  ; Button Pushed
  ; ================
  buttonImageID2=CreateImage(#PB_Any,w,h)
  buttonImageDC.l = StartDrawing(ImageOutput(buttonImageID2))
  ;back color
  DrawingMode(1)
  Box(0, 0, w,h, colorBG2) 
  ;text color
  FrontColor(RGB(Red(colorTXT2),Green(colorTXT2),Blue(colorTXT2)) )
  ;text font
  DrawingFont(FontID(buttonFontID)) 
  ;text align
  DrawText(buttonTxtX,buttonTxtY,"")
  SetTextAlign_(buttonImageDC,buttonTxtAlign|#TA_UPDATECP) 
  ;draw text
  GetClientRect_(button,rc.Rect)
  DrawText_(buttonImageDC,txt,Len(txt),rc,0)
  StopDrawing()
  
  FreeFont(buttonFontID)
  
  ;draw button
  SendMessage_(button,#BM_SETIMAGE,#IMAGE_BITMAP,ImageID(buttonImageID)) 
  
  ;save information
  buttonSkin.l = AllocateMemory(4*4)
  SetWindowLong_(button, #GWL_USERDATA,buttonSkin)   
  PokeL( buttonSkin+ 0, buttonImageID )
  PokeL( buttonSkin+ 4, buttonImageID2 )
  PokeL( buttonSkin+ 8, SetWindowLong_( button, #GWL_WNDPROC, @ColorButtonCallBack() ))
  PokeL( buttonSkin+ 12, ID )
  
  ProcedureReturn result
EndProcedure

; ==========================
; EXAMPLE
; ==========================

Enumeration
  #WIN 
  #SIMPLE
  #TOGGLE
  #BUTLEFT
  #BUTRIGHT
  #SWITCH
EndEnumeration

OpenWindow(#WIN,0,0,300,220,"Standard buttons VS Colored buttons",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)


ButtonGadget(#PB_Any,5, 10, 80, 18,"Button T",#PB_Button_Toggle)
ColorButtonGadget(#TOGGLE, 90, 10, 80, 18,"Button T",RGB(255,255,0),RGB(0,0,0),RGB(155,155,155),RGB(255,0,0),#PB_Button_Toggle)

ButtonGadget(#SWITCH,25, 30, 120, 25,"Switch the Button T")

ColorButtonGadget(#BUTLEFT, 5, 120, 80, 18,"Button L",RGB(255,255,0),RGB(0,0,0),RGB(155,155,155),RGB(255,0,0),#PB_Button_Left)
ColorButtonGadget(#BUTRIGHT, 90, 120, 80, 18,"Button R",RGB(255,255,0),RGB(0,0,0),RGB(155,155,155),RGB(255,0,0),#PB_Button_Right)
SetGadgetState(#TOGGLE,1)

AnyButton=ColorButtonGadget(#PB_Any,25, 150, 120, 25,"Button (#PB_any)",RGB(255,255,0),RGB(0,0,0),RGB(155,0,155),RGB(255,255,255),0)

Repeat
  ev=WaitWindowEvent()
  If ev=#PB_Event_Gadget
    If EventGadget()=#SWITCH
      SetGadgetState(#TOGGLE,1-GetGadgetState(#TOGGLE))
    EndIf
    If EventGadget()=AnyButton
      MessageRequester("Color Button","Works with #PB_any")
    EndIf
  EndIf
  
Until ev=#PB_Event_CloseWindow

Re: ButtonGadget ( background color & window font )

Posted: Thu Nov 18, 2004 11:08 am
by PB
This crashes when I click the colored toggle button (image id is too high).
If you fix this, I would be most grateful -- I've wanted to do this for years!

Posted: Thu Nov 18, 2004 2:57 pm
by Blade
Is it possible to modify the gadget border colors? Could be useful fot a better looking gadget...

Posted: Thu Nov 18, 2004 8:00 pm
by eddy
I've updated the code.

But i don't understand why you have a 'ImageID out of range' bug

Posted: Thu Nov 18, 2004 9:18 pm
by fsw
eddy wrote: But i don't understand why you have a 'ImageID out of range' bug
Because you use #PB_ANY for your gadgets.
Check the value of ToggleImageID with:
Debug ToggleImageID
and you will see a very high number.

On this machine with WinXPpro the number is 8920976.

This is the number you get from a gadget that uses #PB_ANY.
And this should be the Gadget pb number not the handle.

Don't know why this number is so high.
But as I remember right some month ago, after #PB_ANY was introduced, I played with it and discovered these high numbers. Because of that I never use #PB_ANY 8O

Posted: Fri Nov 19, 2004 12:53 am
by dontmailme
Changing line 134 to...

buttonImageID=CreateImage(#PB_Any,w,h)

works for me :)

Mind you.... what does...

ToggleImageID=ColorButtonImageID()

do ?

when the procedure is....

Procedure ColorButtonImageID()
ProcedureReturn ColorButtonImageID
EndProcedure

What am I missing here ?

Posted: Fri Nov 19, 2004 1:00 am
by eddy
buttonImageID=CreateImage(#PB_Any,w,h)
works for me
Yes it works but the previous image must be destroyed.
If not, there's a memory leak. :?

To do that, i need the ImageID of previous image.
For the moment, there's no command to retrieve ImageID from ImageHandle. :?

Posted: Fri Nov 19, 2004 6:55 am
by eddy
Ok i updated the code. Look above. :)

Now the example is simplier and shorter.

- I removed the global variable
- I removed UpdateColorButton ( obsolete )
- color changes are automatic (works with any text alignement)

Posted: Fri Nov 19, 2004 7:05 am
by PB
Thanks Eddy, it all works fine now. :D

Posted: Fri Nov 19, 2004 8:03 am
by eddy
Great !! :) :)

I've updated the code again.
BUG FIXED : SetGadgetState() with "Toggle" ColorButton
--------------

Posted: Sat Nov 20, 2004 4:22 am
by eddy
BUG FIXED :
------------
[fixed] DisableGadget() effect. (uses window default color)
[fixed] use #PB_any
[fixed] LoadWindowFont

You can extend this function to add "disabled" color :)