Hover gradient button control for PBWIN 8
Inspired by Peter Lameijn's "Hover Button": http://www.powerbasic.com/support/pb...ad.php?t=24521

Happy New Year!

Code:
#COMPILER PBWIN 8
#COMPILE EXE
'===============================================================
' Nice looking Hover gradient button control for PBWIN 8
' Inspired by Peter Lameijn's "Hover Button":
' http://www.powerbasic.com/support/pbforums/showthread.php?t=24521
' Feel free to use and modify. Alex Art, 28.12.2007
'===============================================================
#INCLUDE "win32api.inc"

%IDC_HBUT1 = 1001
%IDC_HBUT2 = 1010
%IDC_HBUT3 = 1020
%IDC_HBUT4 = 1030
%IDC_HBUT5 = 1040

GLOBAL hBut AS DWORD
GLOBAL hDlg AS DWORD

'---------------------------------------------------------------
'     Slightly modified Peter Lameijn's "Hover Button" code
'---------------------------------------------------------------
FUNCTION PaintButton(BYVAL wMsg AS DWORD) AS LONG
  LOCAL Pt AS POINTAPI, Rc AS RECT, Result AS DWORD, hDc AS DWORD
  STATIC OnButton AS DWORD, MouseDown AS DWORD
  GetCursorPos(Pt)
  ScreenToClient hDlg, Pt
    Result=ChildWindowFromPointEx(hDlg, pt.x, pt.y, %CWP_ALL)
    cID&=GetDlgCtrlID(Result)
  IF OnButton=0 THEN CONTROL GET USER hDlg, cId&,1 TO hBut
  hDc = GetDc (hBut)
  GetClientRect(hBut,Rc)
  IF (wMsg = %WM_LBUTTONDOWN) OR (wMsg = %WM_LBUTTONUP) THEN OnButton = 0
  IF hBut = Result THEN
        IF OnButton = 0 THEN
          OnButton = 1
          IF wMsg = %WM_LBUTTONDOWN THEN
            DrawEdge(hdc, Rc, %BDR_SUNKENINNER OR %BDR_SUNKENOUTER, %BF_RECT)
          ELSE
            DrawEdge(hdc, Rc, %BDR_RAISEDINNER OR %BDR_RAISEDOUTER, %BF_RECT)
          END IF
       END IF
  ELSE
    IF OnButton = 1 THEN OnButton = 0 : InValidateRect hBut, BYVAL 0, BYVAL 0
  END IF
  ReleaseDc hBut, hDc
      IF OnButton AND wMsg = %WM_LBUTTONUP THEN CALL HButtCallback(cID&)
END FUNCTION

'---------------------------------------------------------------
' Functionality for clicked buttons - main callback for our control
'---------------------------------------------------------------
SUB HButtCallback(ButID AS LONG)
    SELECT CASE ButID
        CASE %IDC_HBUT1
             x&=10 : y&=30: Id&=%IDC_HBUT1 : CALL DemoButts (x&, y&, Id&, 0)
        CASE %IDC_HBUT2
             x&=90 : y&=30: Id&=%IDC_HBUT2 : CALL DemoButts (x&, y&, Id&, 1)
        CASE %IDC_HBUT3
             x&=170 : y&=30: Id&=%IDC_HBUT3 : CALL DemoButts (x&, y&, Id&, 2)
        CASE %IDC_HBUT4
             x&=250 : y&=30: Id&=%IDC_HBUT4 : CALL DemoButts (x&, y&, Id&, 3)
        CASE %IDC_HBUT5
            DIALOG END hDlg
        CASE ELSE : ? "ID="+STR$(ButID)
   END SELECT
END SUB

'---------------------------------------------------------------
'    DEMO: add fully functional extra buttons, menu style
'---------------------------------------------------------------
SUB DemoButts (x&, y&, Id&, Stl&)
  Fnt$="Arial"
  FSize&=9
  Colr&=RGB(100,210,220)
    FOR i&=1 TO 5
     CALL CONTROL_ADD_HBUTTON (hDlg, Id&+i&, x&,y&,70,25, Colr&, "Demo"+STR$(Stl&), Fnt$, FSize&, Stl&)
     y&=y&+25
    NEXT i&
END SUB

'---------------------------------------------------------------
'    CODE FOR MAIN CONTROL
'---------------------------------------------------------------
SUB CONTROL_ADD_HBUTTON (hDlg AS DWORD, _       '  Dialog handle
                         cId AS DWORD, _        '  Control ID
                         cX AS LONG, _          '  x
                         cY AS LONG, _          '  y
                         cWidth AS LONG, _      '  Width
                         cHeight AS LONG, _     '  Height
                         cColor AS LONG, _      '  Back Color
                         cText AS STRING, _     '  Button text
                         cFont AS STRING, _     '  Font face
                         cFSize AS LONG, _      '  Font size
                         cStyle AS LONG )       '  Button style

  CONTROL ADD GRAPHIC, hDlg, cId, "", cX, cY, cWidth, cHeight, %SS_CENTER
  GRAPHIC ATTACH hDlg, cId
  GRAPHIC CLEAR cColor
'''''''''''' Draw gradient background
'       Background slyle is defined by the the 1-st bit of cStyle:  0=tube, 1=box
    stp&=0.5*cHeight
    cR&=cColor AND &hFF : cG&=cColor\256 AND &hFF : cB&=cColor\65536 AND &hFF
        CurCol&=cColor
        Styl&=cStyle AND &h1
        FOR i&=0 TO stp&
            IF Styl&  THEN    ' cStyle=1,3 --> Box
                GRAPHIC BOX (i&, i&)-(cWidth-i&, cHeight-i&),0,CurCol&
                       ELSE    ' cStyle=0,2 --> Hor line
                GRAPHIC BOX (0, i&)-(cWidth, cHeight-i&),,CurCol&
            END IF
            cB&=cB&+4: IF cB&>255 THEN cB&=255
            cG&=cG&+4: IF cG&>255 THEN cG&=255
            cR&=cR&+4: IF cR&>255 THEN cR&=255
            CurCol&=RGB(cR&, cG&, cB&)
        NEXT i&
''''''''''''' Draw button Text
'       Text slyle is defined by the the 2-nd bit of cStyle:  0=plain, 1=smooth
     GRAPHIC FONT cFont, cFSize, 0
     GRAPHIC TEXT SIZE cText TO tWidth&, tHeight&
     tLeft&=(cWidth-tWidth&)/2
     tTop&=(cHeight-tHeight&)/2
        Styl&=cStyle AND &h2
            IF Styl&  THEN    ' cStyle=2,3 --> Smooth font
                 GRAPHIC COLOR %WHITE,-2
                 GRAPHIC SET POS (tLeft&-1, tTop&-1)
                 GRAPHIC PRINT cText

                 GRAPHIC COLOR cColor,-2
                 GRAPHIC SET POS (tLeft&+1, tTop&+1)
                 GRAPHIC PRINT cText
            END IF
     GRAPHIC COLOR %BLACK,-2
     GRAPHIC SET POS (tLeft&, tTop&)
     GRAPHIC PRINT cText
  CONTROL HANDLE hDlg, cId TO hBut
  CONTROL SET USER hDlg, cId,1, hBut
END SUB

'---------------------------------------------------------------
'    Dialog callback
'---------------------------------------------------------------
CALLBACK FUNCTION CbMain ()
  SELECT CASE CBMSG
    CASE %WM_LBUTTONDOWN, %WM_LBUTTONUP, %WM_MOUSEMOVE
        PaintButton(CBMSG)
  END SELECT
END FUNCTION

'---------------------------------------------------------------
'    Dialog
'---------------------------------------------------------------
FUNCTION PBMAIN AS LONG
  Fnt$="Times New Roman"
  FSize&=11
  Colr&=RGB(220,210,100)
  DIALOG NEW PIXELS, 0,"Hover gradient button - click to test",200,200,420,180,%WS_SYSMENU OR %DS_CENTER TO hDlg
 CONTROL_ADD_HBUTTON hDlg, %IDC_HBUT1,  10,5,80,25, Colr&, "Style-0", Fnt$, FSize&, 0
 CONTROL_ADD_HBUTTON hDlg, %IDC_HBUT2, 90,5,80,25, Colr&, "Style-1", Fnt$, FSize&, 0
 CONTROL_ADD_HBUTTON hDlg, %IDC_HBUT3, 170,5,80,25, Colr&, "Style-2", Fnt$, FSize&, 0
 CONTROL_ADD_HBUTTON hDlg, %IDC_HBUT4, 250,5,80,25, Colr&, "Style-3", Fnt$, FSize&, 0
 CONTROL_ADD_HBUTTON hDlg, %IDC_HBUT5, 330,5,80,25, Colr&, "Exit", Fnt$, FSize&, 0
  CONTROL SET COLOR hDlg, 1001, RGB(255,255,255), RGB(217,215,105)
  DIALOG SHOW MODAL hDlg CALL CbMain
END FUNCTION