PureBasic Forums - English

Posted: **Sun Jul 18, 2004 11:25 pm**

Debugged and updated again.
Now only with API graphics.
Comments welcomed.

Posted: **Mon Jul 19, 2004 9:43 pm**

Hi, Einander. Nice. At last i have ADSL at home, but from Telefonica-Spain, which means poor service and poor conection reliability

Could you change color inside buttons when pressed? I mean to get the sensation of to press a rubber button, this is, shadow swapping effect.

Posted: **Tue Jul 20, 2004 12:18 am**

Hi Psychophanta!
Changing color inside buttons was my first approach, but the code was longer.

To disallow the Rim growing effect, eliminate all the +2 and -2 in procedure Highlight.
Doing that, with some button colors, the selection could be less noticeable.

Posted: **Sun Jul 25, 2004 7:07 pm**

Psychophanta wrote:Could you change color inside buttons when pressed?

Done.
Also added flags to LeftText, RightText, and Grayed non selectable buttons.

Posted: **Sun Jul 25, 2004 9:38 pm**

That's good, you have obtained the effect, but just what i mean is to get the same color in pushed buttons, but with its darkness center, just like if it was a real button with real light.
Besides, i guess this must be easier to do than what you have done, isn't it?

Posted: **Sun Jul 25, 2004 9:46 pm**

Psychophanta wrote:That's good, you have obtained the effect, but just what i mean is to get the same color in pushed buttons, but with its darkness center, just like if it was a real button with real light.
Besides, i guess this must be easier to do than what you have done, isn't it?

Now the buttons are redrawed when selected, so is easy to change the colours as you like.
What colours you think fits better for the "real light" effect?

Posted: **Sun Jul 25, 2004 9:59 pm**

What colours you think fits better for the "real light" effect?

Just the deal is to take same button color, but with obscured center.

Posted: **Sun Jul 25, 2004 10:40 pm**

Updated again. Now button color is the same, but with dark center and yellow font. But this effect is a darker button , not a lighter one.

The controls for the highlighted buttons are on lines 148 / 149

To explore more combinations, uncomment line 149, comment line 148 and change the colors on the constants #OutLight,#Inlight and #FontLight.

Posted: **Mon Jul 26, 2004 10:51 am**

Thanks!.

Now, could you minimize and simplify all that code as much as possible?Well, only if possible, and you have time and will

Posted: **Tue Jul 27, 2004 6:49 am**

Hover color available?

Posted: **Tue Jul 27, 2004 4:35 pm**

@Psychophanta: I'm cleaning and simplifyng.

@Shannara: Is possible to change colors also when mouse is over button, even if no mousebutton is pressed.
You mean "Hover" or "Over"?

Soon another update.

Posted: **Tue Jul 27, 2004 4:56 pm**

it looks cool, but when the debugger is on, and the debugger is on, then
the variable view window is over the button factory. And when you move that variable window, it can be seen on the button factory like the window background is not repainted

Posted: **Wed Jul 28, 2004 12:28 am**

@Thefool: your request was easy, using Dmoc's trick to close debugger window.

See
viewtopic.php?t=7949&highlight=top+window+debugger
Last line in procedure TestBTN() open again the DebuggerWindow.

Updated.

Posted: **Wed Jul 28, 2004 9:54 am**

@Psychophanta: minimized and simplyfied; added flags.
Suggestions welcomed

Code: Select all

#OutLight=#White           ;Define 3 colors to highlight selected button 
#InLight=#Yellow 
#FontLight=#Red 
; Flags
#BTN_Left=1                 ;BIT 0    ; Left Text  
#BTN_Right=2               ;BIT 1 ; Right Text 
#BTN_Grayed=32          ;BIT 5  ;Grayed non selectable button
#BTN_Highlighted=64     ;BIT 6  ; highlight when button pressed

Global _BkgRGB,_MK,_MX,_MY, _GID 
Global _PressMe,_Quit,_Change    ; identifiers for each button  

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() 

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 DrawBTN()   ; Style 0=normal; 1= highlight; 2=grayed; easy to define more   
  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 
  
  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 
  
  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=#OutLight:InRGB=#InLight : FontRGB=#FontLight   ; Highlighted 
  EndIf 
  
  Gradient.f=Log(Height)*50    ; gradient rate 
  Pen=CreatePen_(#PS_INSIDEFRAME,RimWidth*2,RimRGB)  
  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+StpR :If Red<0:Red=0:ElseIf Red>255:Red=255:EndIf 
    Green+StpG : :If Green<0:Green=0:ElseIf Green>255:Green=255:EndIf 
    Blue+StpB : If Blue<0:Blue=0:ElseIf Blue>255:Blue=255:EndIf 
    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 CreateBTN(DC,X,Y,Width,Height,RimWidth,RimRGB,OutRGB,InRGB,Corner,Txt$,FontName$,FontWidth,FontHeight,FontRGB,ShadowWidth,ShadowRGB,Flags)  
  _GID+1 
  AddElement(BTN())  
  BTN()\ID=_GID 
  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 
  DrawBTN()
  ProcedureReturn _GID        ; number of the new BTN on the list 
EndProcedure 
    
Procedure SelectBTN()    ; return  Selected BTN , starting at 1:  0=not  selected 
  ForEach BTN()  
    Shadow=BTN()\ShadowWidth 
    X=BTN()\Pos\X:Y=BTN()\Pos\Y 
    X1=X+BTN()\Size\Cx-Shadow:Y1=Y+BTN()\Size\Cy-Shadow 
    Corner=BTN()\Corner 
    Hnd=CreateRoundRectRgn_( X,Y, X1,Y1,Corner, Corner) 
    Inside= PtInRegion_(Hnd,WindowMouseX(),WindowMouseY()) ; mouse inside button region
    DeleteObject_(Hnd) 
    If Inside : StatusBarText(0,0, "Mouse over "+Str(Sel))
      ProcedureReturn Sel
    EndIf
    Sel+1 
  Next 
  StatusBarText(0,0, "Mouse out")
  ProcedureReturn 0 
EndProcedure 

Procedure ProcessBTN(Sel)   ;    
  If _MK=1   And Sel>0 :      StatusBarText(0,0,"pressed "+Str(Sel))
    SelectElement(BTN(),Sel) 
    If BTN()\Flags>>10&1 =0 ; if selectable    
      Highlighted=Sel  
      BTN()\Flags|1<<6    ; SET highlight flag 
      DrawBTN() 
      Repeat  : WindowEvent() 
        ; here call procedures while button is pressed
   Until _MK=0 
    EndIf 
    If _MK=0 And Highlighted>0; restore original button  
      SelectElement(BTN(),Highlighted) 
      BTN()\Flags&~(1<<6)   ; clear  BIT 6; highlight flag 
      DrawBTN()  
      If  SelectBTN()=Sel
        If Sel=_Quit :  End:EndIf 
        ;Here call procedures when button is released( Windows style)
      EndIf
    EndIf 
  EndIf
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 
  ProcedureReturn Result 
EndProcedure 
;-________________________ 

hWnd=  OpenWindow(0, 30, 40, 700, 550,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget  | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Button Factory") 
CreateStatusBar(0, hWnd)
hDC=GetDC_(hWnd)    
SetWindowPos_(hWnd,#HWND_TOPMOST,0,0,0,0,#SWP_NOMOVE|#SWP_NOSIZE) 
AddElement(BTN())  ; this is the Zero element, used only for temporary buttons. The  Registered buttons start at element 1 

_PressMe=CreateBTN(hDC,100,20,250,50,4,#BLACK,#green,#White,60,"Press Me","Arial",10,20,#BLACK,6,RGB(222,222,222),#BTN_Left) 
_Quit=CreateBTN(hDC,100,100,250,50,4,#BLACK,#BLUE,#White,60,"Quit","Arial",10,20,#BLACK,6,RGB(222,222,222),0) 
_Change=CreateBTN(hDC,100,180,250,50,4,#Red,#Yellow,#BLUE,60,"Change","Arial",10,20,#BLACK,6,RGB(222,222,222),#BTN_Grayed |#BTN_Right) 

SetWindowCallback(@Callback()) 
Repeat          
  WaitWindowEvent() 
  ProcessBTN(SelectBTN()) 
ForEver

Posted: **Thu Jul 29, 2004 7:56 am**

Very nice example again! But if you minimize and restore the window, the buttons
are no longer visible until you're able to do a blind click ;-)

cya dige

PureBasic Forums - English

Round & fancy buttons - Windows only