Color Button using API [Windows]

Share your advanced PureBasic knowledge/code with the community.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Color Button using API [Windows]

Post by RASHAD »

1- Using Windows API
2- Usual Windows Button effects
3- Use Vector lib. to do what you want to do

Suit yourself it's only a scratch for beginning
Have fun

Code: Select all

Procedure colorBUTTON(gad,w,h,font.s,fsize,text.s,tcolor)
  LoadFont(0,font,fsize)
  CreateImage(gad,w-6,h-8,32,#PB_Image_Transparent)  
  StartVectorDrawing(ImageVectorOutput(gad))
  MovePathCursor(10,10)
  AddPathCircle(10,10,5)
  VectorSourceColor(tcolor|$FF000000)
  StrokePath(10)
  VectorFont(FontID(0), 16)
  VectorSourceColor(tcolor|$FF000000)
  MovePathCursor(26,1)
  DrawVectorText(text)
  StopVectorDrawing()
  SendMessage_(GadgetID(gad), #BM_SETIMAGE, #IMAGE_BITMAP, ImageID(gad))
EndProcedure 


If OpenWindow(0,100,100,400,200,"Button",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)  
  ButtonGadget(0, 10,10,100,28," ",#BS_FLAT| #BS_LEFT)
  colorBUTTON(0,100,28,"Georgia",12,"RASHAD",$00FF00)
  ButtonGadget(1, 10,40,100,28," ",#BS_FLAT| #BS_LEFT)
  text.s = GetGadgetText(1)
  colorBUTTON(1,100,28,"Tahoma",10,"Purebasic",$0000FF)
  Repeat  
    Select WaitWindowEvent(1)
      Case #PB_Event_CloseWindow
        Quit = 1
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Debug "Gadget #0"
          Case 1
            Debug "Gadget #1"
        EndSelect
    EndSelect
  Until Quit = 1
EndIf

Egypt my love
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8425
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Re: Color Button using API [Windows]

Post by netmaestro »

Nice clean concise code, RASHAD! Great work as always. Putting it in my library.
BERESHEIT
User avatar
blueb
Addict
Addict
Posts: 1041
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Color Button using API [Windows]

Post by blueb »

Hmmm, am I the only one with a problem. I can't seem to get the font to change.

Code: Select all

Procedure colorBUTTON(gad,w,h,font.s,fsize,text.s,tcolor)
  LoadFont(0,font,fsize)
  CreateImage(gad,w-6,h-8,32,#PB_Image_Transparent)  
  StartVectorDrawing(ImageVectorOutput(gad))
  MovePathCursor(10,10)
  AddPathCircle(10,10,5)
  VectorSourceColor(tcolor|$FF000000)
  StrokePath(10)
  VectorFont(FontID(0), 16)
  VectorSourceColor(tcolor|$FF000000)
  MovePathCursor(26,1)
  DrawVectorText(text)
  StopVectorDrawing()
  SendMessage_(GadgetID(gad), #BM_SETIMAGE, #IMAGE_BITMAP, ImageID(gad))
EndProcedure 


If OpenWindow(0,100,100,400,200,"Button",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)  
  ButtonGadget(0, 10,10,100,28," ",#BS_FLAT| #BS_LEFT)
  colorBUTTON(0,100,28,"Arial Rounded MT Bold", 24,"RASHAD",$00FF00)
  
  ButtonGadget(1, 10,40,100,28,"Bob",#BS_FLAT| #BS_LEFT)
  text.s = GetGadgetText(1)
  Debug text
  colorBUTTON(1,100,28,"Bookman Old Style", 24,"Purebasic",$0000FF)
  Repeat  
    Select WaitWindowEvent(1)
      Case #PB_Event_CloseWindow
        Quit = 1
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Debug "Gadget #0"
          Case 1
            Debug "Gadget #1"
        EndSelect
    EndSelect
  Until Quit = 1
EndIf

- It was too lonely at the top.

System : PB 6.10 Beta 9 (x64) and Win Pro 11 (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
pjay
Enthusiast
Enthusiast
Posts: 163
Joined: Thu Mar 30, 2006 11:14 am

Re: Color Button using API [Windows]

Post by pjay »

@Rashad - thanks for sharing :)

@blueb - I think the font is changing OK, but the font size isn't being applied correctly as it's not being used in the VectorFont() command.

Also, it's not DPI aware, so that could cause scaling problems on other systems.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Color Button using API [Windows]

Post by RASHAD »

Hi guys
Thanks blueb and pjay for your comments
NM I am so glad to read your comments at any PB post :)
I hope you are in a very good shape
Egypt my love
Post Reply