Round & fancy buttons - Windows only

einander · Post by **einander** » Tue Jul 13, 2004 1:00 am

New update july 28 2004
Moving away debugger window

; Button Factory by einander - July 13 2004 - PB 3.91 
; Shape and coloured buttons.
; Also detect button pressed (not only button released) - handy to do some actions while pressing button 

Procedure Init():  
  Global _BkgWin,_BkgRGB,_MK,_MX,_MY,_Selected
  Global _PressMe,_Quit,_Change,_MonoRGB,_GID
  
  Structure BtnAttrib 
    DC.l                 ;BTN hDC
    ID.w                 ;Button id
    Pos.POINT     
    Size.SIZE
    RimWidth.w 
    RimRGB.l
    OutRGB.l
    InRGB.l
    Corner.w
    Txt.s    
    Fontname.s
    FontWidth.w
    FontHeight.w
    FontRGB.l
    ShadowWidth.w
    ShadowRGB.l
    Flags.l
  EndStructure
  NewList BTN.BtnAttrib()
 
EndProcedure

Procedure Get(DC,X, Y, Width, Height) ; get Image from DC and stores it on memory; returns handle for the stored Image
  Hnd = CreateCompatibleDC_(DC)     ; memory handle to store Image 
  SelectObject_(Hnd, CreateImage(0, Width, Height))
  BitBlt_(Hnd, 0, 0, Width, Height, DC, X, Y, #SrcCopy)  ; transfer from DC to handle
  ProcedureReturn Hnd  
EndProcedure

Procedure InvertRGB(RGB)  ; return another color that combines fine with first one
  ProcedureReturn RGB((Red(RGB)+128)%255,(Green(RGB)+128)%255,(Blue(RGB)+128)%255)
EndProcedure

Procedure Limit(A,b,C)
  If A < b : ProcedureReturn b :EndIf
  If A > C : ProcedureReturn C :EndIf
  ProcedureReturn A
EndProcedure
; 
Procedure RoundRect(DC,X,Y,X1,Y1,Rim,RGB,Corner)    ;draw rectangle with rounded corners
  Pen=CreatePen_( #PS_INSIDEFRAME,Rim,RGB)            
  Brush = CreateSolidBrush_(RGB) 
  SelectObject_(DC,Pen) 
  SelectObject_(DC,Brush) 
  RoundRect_(DC,X,Y,X1,Y1,Corner,Corner)   
  DeleteObject_(Pen)
  DeleteObject_(Brush)
EndProcedure

Procedure CreateBTN(DC,X,Y,Width,Height,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$,FontName$,FontWidth,FontHeight,FontRGB,ShadowWidth,ShadowRGB,Flags)  
  If Flags>>4&1
    SelectElement(BTN(),0)  ; is a TipBTN, non selectable, stored as Zero element in list BTN()
  Else    
    _GID+1
    AddElement(BTN())  
    BTN()\ID=_GID 
  EndIf
  BTN()\DC=DC
  BTN()\Pos\X=X
  BTN()\Pos\Y=Y
  BTN()\Size\Cx=Width
  BTN()\Size\Cy=Height
  
  BTN()\RimWidth=RimWidth
  BTN()\RimRGB=RimRGB
  BTN()\OutRGB=OutRGB
  BTN()\InRGB=InRGB
  BTN()\Corner=Corner
  
  BTN()\Txt=Txt$    
  BTN()\Fontname=FontName$
  BTN()\FontWidth=FontWidth
  BTN()\FontHeight=FontHeight
  BTN()\FontRGB=FontRGB
  
  BTN()\ShadowWidth=ShadowWidth
  BTN()\ ShadowRGB=ShadowRGB 
  BTN()\Flags=Flags
  If BTN()\ID=_GID : ProcedureReturn _GID:EndIf        ; number of the new BTN on the list
  ProcedureReturn 0 
EndProcedure

Procedure DrawBTN()  ; with Invert=0, original button; Invert=1,2,3, different inverted colors
  DC=BTN()\DC
  X=BTN()\Pos\X
  Y=BTN()\Pos\Y
  Width=BTN()\Size\Cx
  Height=BTN()\Size\Cy
  
  RimWidth=BTN()\RimWidth
  RimRGB=BTN()\RimRGB
  OutRGB=BTN()\OutRGB
  InRGB=BTN()\InRGB
  Corner=BTN()\Corner
  Txt$=BTN()\Txt    
  FontName$=BTN()\Fontname
  FontWidth=BTN()\FontWidth
  FontHeight=BTN()\FontHeight
  FontRGB=BTN()\FontRGB
  Flags=BTN()\Flags
  
  ShadowWidth=BTN()\ShadowWidth
  ShadowRGB=BTN()\ ShadowRGB 
  
  If Flags>>5 &1  ;grayed
    OutRGB=RGB(200,200,200):InRGB=RGB(230,230,230):RimRGB=RGB(180,180,180):FontRGB=RGB(180,180,180)
    BTN()\Flags|1<<10
  ElseIf Flags>>6&1:OutRGB=#White:InRGB=#BLACK:FontRGB=#yellow   ; highlighted
  EndIf
  
  XX=X+ShadowWidth+RimWidth : YY=Y+ShadowWidth+RimWidth
  X1=X+Width : Y1=Y+Height
  Red= Red(ShadowRGB)-22:Green=Green(ShadowRGB)-22:Blue=Blue(ShadowRGB)-22  ; start ShadowWidth with RGB background, and fading to black
  For i=  1 To ShadowWidth  ; ShadowWidth gradient from background RGB to black
    If Red<0:Red=0:EndIf   ; no less than black !  :-)
    If Green<0:Green=0:EndIf   
    If Blue<0:Blue=0:EndIf
    RoundRect(DC,XX,YY,X1,Y1,4,RGB(Red,Green,Blue),Corner)        
    XX-1:YY-1:X1-1:Y1-1
    Red-22 :Green-22: Blue-22   ; fading to black  
  Next
  
  Gradient.f=Log(Height)*50    ; gradient rate
  Pen=CreatePen_(#PS_INSIDEFRAME,RimWidth*2,RimRGB)  ; line thickness =4, to avoid corner gaps (try 1 to see gaps)
  SelectObject_(DC, Pen);
  XX=X:YY=Y    
  RoundRect_(DC,XX,YY,X1,Y1,Corner,Corner)  ; BTN rim
  DeleteObject_(Pen);
  
  XX+RimWidth:YY+RimWidth:X1-RimWidth:Y1-RimWidth
  If Gradient<1:Gradient=1:EndIf    ; fading RGB inside BTN from OutRGB to InRGB
  Gradient/10
  Red=Red(OutRGB):Green=Green(OutRGB):Blue=Blue(OutRGB)
  R2=Red(InRGB):G2=Green(InRGB):B2=Blue(InRGB)
  StpR.f=(R2-Red)/Gradient
  StpG.f=(G2-Green)/Gradient
  StpB.f=(B2-Blue)/Gradient
  
  Repeat                   ; draw gradient inside BTN
    Pen=CreatePen_(#PS_INSIDEFRAME,4,RGB(Red,Green,Blue))
    SelectObject_(DC, Pen)
    Red=Limit( Red+StpR,0,255):
    Green=Limit(Green+StpG,0,255)
    Blue=Limit(Blue+StpB,0,255)
    RoundRect_(DC,XX,YY,X1,Y1,Corner-GradientShape,Corner+GradientShape)
    GradientShape+6                    ; gradient shape more elliptical
    XX+1:YY+1:X1-1:Y1-1
    DeleteObject_(Pen);  
  Until XX>=X1 Or YY>=Y1:
  
  Fon = CreateFont_(FontHeight,FontWidth,0,0,100,0,0,0,0,0,0,0,0,FontName$) 
  SetTextcolor_(DC,FontRGB)
  OldFont = SelectObject_(DC,Fon) 
  SetBkMode_(DC,#Transparent) 
  R.RECT\Left=X:R\Top=Y:R\Right=X+Width:R\Bottom=Y+Height+ShadowWidth
  GetTextExtentPoint32_(DC, Txt$, Len(Txt$), Sz.SIZE)   ; text sizes to center text 
  
  If Flags &1=1 And Flags>>1&1=0
    ExtTextOut_(DC, X+RimWidth+3, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  ElseIf Flags >>1 &1=1 And Flags&1=0
    ExtTextOut_(DC, X+(Width-Sz\Cx-ShadowWidth)-RimWidth-3, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  Else
    ExtTextOut_(DC, X+(Width-Sz\Cx-ShadowWidth)/2, Y+(Height-Sz\Cy-ShadowWidth)/2, #eto_clipped,@R,Txt$, Len(Txt$),0) 
  EndIf
  SelectObject_(DC,OldFont) 
  DeleteObject_(Fon) 
EndProcedure

    
Procedure SelectBTN()    ; return  _Selected BTN , starting at 1:  0=not  selected
  ForEach BTN()  
    X=BTN()\Pos\X:Y=BTN()\Pos\Y
    X1=X+BTN()\Size\Cx:Y1=Y+BTN()\Size\Cy
    Corner=BTN()\Corner
    Hnd=CreateRoundRectRgn_( X,Y, X1,Y1,Corner, Corner) 
    If  PtInRegion_(Hnd,WindowMouseX(),WindowMouseY()) 
      DeleteObject_(Hnd) : ProcedureReturn Sel
    EndIf 
    DeleteObject_(Hnd) : Sel+1
  Next
  ProcedureReturn 0
EndProcedure
    
Procedure TestBTN(DC)
  h2 = FindWindow_(#Null, "PureBasic - Debug Output")  ; thanks dmoc for this trick! 
  If h2: CloseWindow_(h2): EndIf                         ; close debugger window if open
   
  _GID=0
  ; Flags |1 <<5    ; BIT 5 set; button grayed and not selectable
  
  Debug "flags="+Bin(Flags)
  ClearList(BTN())
  AddElement(BTN())  ; this is the Zero element, used only for temporary buttons. The  Registered buttons start at element 1
  
  _BkgRGB=Random($FFFFFF)   
  RoundRect(DC,0,0,WindowWidth(),WindowHeight()-20,0,_BkgRGB,0)   ; draw window background
  Pen=CreatePen_(#Ps_Solid,2,InvertRGB(RGB(Blue(_BkgRGB),Red(_BkgRGB),Green(_BkgRGB))))  
  SelectObject_(DC,Pen) 
  For X = 0 To WindowWidth() Step 7   ;background diag lines
    MoveToEx_(DC,X,0,0) : LineTo_(DC,X*2,WindowHeight()-22) 
  Next
  DeleteObject_(Pen) 
  Width=110  ; first  BTN size
  Height=44
  Corner=36  ; Corner angle   
  Txt$="BTN NÂº "
  RimWidth=2
  RimRGB=#BLUE
  InRGB=#White
  FontName$="Arial"
  FontWidth=8:FontHeight=12
  FontRGB=#BLACK
  ShadowWidth=8
  For i= 1 To 10    ;Test BTNs changing width 
    OutRGB=RGB(Random(210),Random(190),255)
    BTN=CreateBTN(DC,10,(i-1)*48+20,Width+i*4,Height,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$+Str(i),FontName$,FontWidth,FontHeight+i/2,FontRGB,ShadowWidth,_BkgRGB,Flags)
    DrawBTN()
  Next
  
  ;- Round buttons
  Width=70:Height=70
  Corner=360
  Txt$=""
  FontRGB=#BLUE
  ShadowWidth=12
  FontWidth=9:FontHeight=14
  For i= 1 To 5   ;Test round BTNs , corner=360 , Width=Height
    RimWidth=Random(6)
    OutRGB=Random($FFFFFF)
    RimRGB=Random($FFFFFF)
    FontHeight+i/2.5 
    BTN=CreateBTN(DC,160,(i-1)*82+50,Width+(i-2)*4,Height+(i-2)*4,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$+Str(i+10),FontName$,FontWidth,FontHeight,FontRGB,ShadowWidth,_BkgRGB,Flags)
    DrawBTN()
  Next
  ;- More buttons with different corners
  ShadowWidth=6
  Width=200:Height=40
  FontWidth=6: FontHeight=14
  FontName$="times new roman"
  Txt$="BTN NÂº ":T$=Txt$
  FontRGB=0
  RimWidth=1
  RimRGB=InvertRGB(_BkgRGB)
  FontWidth=12
  For i= 1 To 10     ;Test changing width & height ; random RGBs
    Corner=Random(100)
    OutRGB=Random($FFFFFF)
    InRGB=InvertRGB(OutRGB)
    
    If Random(5)=0: Flags|1<<5  ; Bit 5 set : grayed and not selectable button
      T$="Non selectable "
    Else
      If Random(4)=0 : R=Random(1)
        Flags|1<<R
        If R=0:T$="Left text " :Else:T$="Right text ":EndIf
      EndIf  
    EndIf
    BTN=CreateBTN(DC,260,(i-1)*Height+i*11,Width-i*4,Height+i,RimWidth,RimRGB,OutRGB,InRGB,Corner,T$+Str(i+15),FontName$,FontWidth-i/2,FontHeight,FontRGB,ShadowWidth,_BkgRGB,Flags)
    DrawBTN()
    T$=Txt$ : Flags=0
  Next
  Flags=0   ; show last 3 buttons in normal style
  
  ;The ID for each BTN is returned from procedure BTN ; (on the previous calls we don't need the ID)  
  _PressMe=CreateBTN(DC,500,10,150,40,RimWidth,RimRGB,OutRGB,#red,16,"Press Me!","Arial",10,16,#White,ShadowWidth,_BkgRGB,Flags)
  DrawBTN()  
  _Quit=CreateBTN(DC,500,70,150,50,RimWidth,RimRGB,OutRGB,InRGB,Random(100),"Quit","Arial",10,20,FontRGB,ShadowWidth,_BkgRGB,Flags)
  DrawBTN()
  _Change=CreateBTN(DC,470,140,210,40,RimWidth,Random($FFFFF),Random($FFFFF),Random($FFFFF),10,"Change buttons","Arial",10,20,FontRGB,ShadowWidth,_BkgRGB,Flags)    
  DrawBTN()
  _BkgWin=Get(DC, 0,0,WindowWidth(),WindowHeight()-20)  ; full window image used for redraw
  If h2: ShowWindow_(h2,#SW_RESTORE ): EndIf   ; open again debugger
  EndProcedure
    
Procedure Callback(Win, Msg, wParam, lParam) ; control mouse & key messages
  Result = #PB_ProcessPureBasicEvents
  Select Msg
    Case #WM_LButtonDOWN
      If _MK = 2 : _MK = 3 : Else : _MK = 1 : EndIf
    Case #WM_LBUTTONUP
      If _MK = 3 : _MK = 2 : Else : _MK = 0 : EndIf
    Case #WM_RBUTTONDOWN
      If _MK = 1 : _MK = 3 : Else : _MK = 2 : EndIf
    Case #WM_RBUTTONUP
      If _MK = 3 : _MK = 1 : Else : _MK = 0 : EndIf
    Case #WM_KEYDOWN
      If EventwParam() = 27 : End : EndIf
    Case #PB_EventCloseWindow : End
  EndSelect
  If Msg= #PB_Event_Repaint Or Msg=    #WM_ERASEBKGND 
    BitBlt_(GetDC_(WindowID()), 0,0,WindowWidth(),WindowHeight()-20,_BkgWin, 0, 0, #SrcCopy)    
  EndIf
  _MX=WindowMouseX()
  _MY=WindowMouseY()
  ProcedureReturn Result
EndProcedure

;-________________________
Init()
style= #ws_overlapped |#ws_minimizebox  | #ws_clipsiblings | #ws_caption| #PB_Window_ScreenCentered 
hWnd=  OpenWindow(0, 30, 40, 700, 550, style, "Button Factory")
hDC=GetDC_(hWnd)    
SetWindowPos_(hWnd,#HWND_TOP,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE|#SWP_NOREDRAW)
CreateStatusBar(0, hWnd)  ; for testing: show BTN states
SetWindowCallback(@Callback())
TestBTN(hDC) 
Repeat          
  WaitWindowEvent()
  _Selected=SelectBTN()
  If _MK=1
    ;    _Selected=SelectBTN()
    If _Selected 
      SelectElement(BTN(),_Selected) 
      StatusBarText(0,0,"Down "+Str(_Selected))
      If BTN()\Flags>>10&1 =0 ; if selectable    
        Highlighted=_Selected  
        BTN()\Flags|1<<6    ; highlight flag
        DrawBTN()
        While _MK =1                                      ; wait until BTN is released 
          If _Selected=_PressMe                    ; BTN "Press me" , action while BTN is pressed
            While _MK=1                               ; loop to show  sample BTNs  
              OutRGB=Random($FFFFFF)
              RimRGB=Random($FFFFFF)
              RimWidth=Random(16)
              ShadowWidth=Random(20)
              If BKG      ;restore previous background
                BitBlt_(hDC,480,300,200,200,BKG, 0,0, #SrcCopy)    
              EndIf
              BKG=Get(hDC,480,300,200,200)    ; keep background  to erase button
              Flags|1<<4  ;sets BIT 4 (BTN_Tip), stored as Zero element in BTN()
              CreateBTN(hDC,480,300,200,200,RimWidth,RimRGB,OutRGB,InvertRGB(OutRGB),Random(360),"Another BTN","Arial",12,Random(60)+20,OutRGB,ShadowWidth,_BkgRGB,Flags)
              DrawBTN()
              Delay (500)            
              WindowEvent()
            Wend              
            If BKG :  BitBlt_(hDC,480,300,200,200,BKG, 0,0, #SrcCopy)    
              BTN()\Flags&~(1<<4)   ; clears  BIT 4 BTN_Tip
              BKG=0
            EndIf
          EndIf
          WindowEvent()
        Wend
      EndIf
    Else
      StatusBarText(0,0,"Down Ignored")
    EndIf
  Else
    If _Selected:StatusBarText(0,0,"Mouse over "+Str(_Selected)) :
    Else:StatusBarText(0,0,"")
    EndIf
  EndIf
  If _MK=0   ; no button pressed
    If Highlighted; restore original button  
      SelectElement(BTN(),Highlighted) 
      BTN()\Flags&~(1<<6)   ; clears  BIT 6 : BTN_Tip
      DrawBTN() 
      Highlighted=0
      If  SelectBTN()=_Selected
        If _Selected=_Quit :  End
        ElseIf _Selected=_Change : TestBTN(hDC)
        EndIf
        StatusBarText(0,0,"Up "+Str(_Selected))
        _Selected=0
      Else
        StatusBarText(0,0,"Restored "+Str(_Selected))
      EndIf
    EndIf
  EndIf
ForEver

Best regards
Einander

thefool · Post by **thefool** » Tue Jul 13, 2004 10:35 am

looks pretty cool, except when you press (and hold) a button, a square can be seen.

einander · Post by **einander** » Tue Jul 13, 2004 4:57 pm

Thanks thefool:
edited new code without squares.

GreenGiant · Post by **GreenGiant** » Tue Jul 13, 2004 6:25 pm

Yeah, looks nice. But for me the background doesnt redraw properly. Try dragging the debug window about over the top of the window. For me the background gets greyed out.

thefool · Post by **thefool** » Tue Jul 13, 2004 6:38 pm

that was much better, but the background dosent refresh, and if you hold down the mouse on a button and drag the mouse button outside the window, then it keeps being down.

but its still looking nice.
If im going to use this, when it gets better, i want to ask: is this public?

i dont like using other peoples source if i am not allowed to do it!

thefool · Post by **thefool** » Tue Jul 13, 2004 6:51 pm

by the way, how hard would it be making an userlib that has a command, eg RoundBtnGadget() that would replace the normal buttongadget()
command, so it would be easy to use it with PB?

einander · Post by **einander** » Tue Jul 13, 2004 11:01 pm

@thefool:

i want to ask: is this public?

Yes. And I think that all the code posted to this forum is public.

how hard would it be making an userlib that has a command, eg RoundBtnGadget() that would replace the normal buttongadget()

I dont know how hard, but this code could be a step to the rounded buttons library.
My approach is making the buttons from the code, instead of loading images.
To make buttons loading images, you have a nice code from GPI-CustomButtons, and Paul's excellent PureVision.

@greengiant:
try the new edited code; added a callback to redraw, but as a standalone program, this code is useless.
_________
Best regards
Einander

thefool · Post by **thefool** » Tue Jul 13, 2004 11:14 pm

Yes. And I think that all the code posted to this forum is public.

are you 100% sure?

nowhere it stands that the author dosent have right to the posted code. I mean, a book is easly copied, but it cant.
Publishing source code dosent mean that you dont have the right to it.
So i belive, if someone posting a source here tells that we can use it but not claim we made it, i would do as he says.

thefool · Post by **thefool** » Tue Jul 13, 2004 11:17 pm

My approach is making the buttons from the code, instead of loading images.

yes. thats why it is interesting. it should be much less in size than images. So if the user has a simple command where he choses size, color and stuff, then he would be able to make a very small program with a fancy interface.

einander · Post by **einander** » Wed Jul 14, 2004 1:12 am

thefool wrote: are you 100% sure?

No.
I am musician, not lawyer.
The point is: what means exactly "public"?

I think: anybody can use the code published on the forum, but only the original writer can claim he wrote it.

Simple logic tells me that if somebody claims he made code that is made by another person, the claimer is simply a thief.

And how can one be enough sure that some code is completely original?
May be this fine legal point is unsolvable.

thefool · Post by **thefool** » Wed Jul 14, 2004 9:03 am

i belive it is unsolveable.

einander · Post by **einander** » Thu Jul 15, 2004 11:16 am

Updated

TronDoc · Post by **TronDoc** » Thu Jul 15, 2004 10:47 pm

way cool!

but, buttons 25, 26 and 27 look blank
and clicking 26 makes a blank box blink
twice before showing the circles with the number

I don't have the greatest video card
and only WinDoze '98fe; so that may
be the problem.

the ones that do work look great

Joe

einander · Post by **einander** » Fri Jul 16, 2004 2:05 am

Hi TronDoc:
I can test it only with WinXP.

This is a work in progress; on the WeekEnd I'll try to debug and clean, and then i'll update again.
I'm tryng to make a library with this approach.

TronDoc · Post by **TronDoc** » Fri Jul 16, 2004 3:36 am

no problem