Tweet
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!
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