Code:
#PBFORMS CREATED V1.50
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly. See the PB/Forms documentation for
' more information.
' Named blocks begin like this: #PBFORMS BEGIN ...
' Named blocks end like this: #PBFORMS END ...
' Other PB/Forms metastatements such as:
' #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
' ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#INCLUDE"CTLBTN1.INC"
#PBFORMS END INCLUDES
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%LBL_LABEL1 = 1001
%LBL_LABEL2 = 1002
%LBL_LABEL3 = 1003
%LBL_LABEL4 = 1004
%LBL_LABEL5 = 1005
%LBL_LABEL6 = 1006
%LBL_LABEL7 = 1007
%LBL_LABEL8 = 1008
%LBL_LABEL9 = 1009
%TXT_TEXTBOX1 = 1010
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Main Application Entry Point **
'------------------------------------------------------------------------------
GLOBAL CUR_CTRL_ID AS LONG,CUR_CTRL AS LONG,PRESS_BUTTON_ON AS INTEGER, hFontlb AS LONG, hFontlbul AS LONG,V_BRUSH AS LONG
GLOBAL hdlg AS LONG
FUNCTION MakeFont(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
LOCAL hDC AS LONG
LOCAL CyPixels AS LONG
hDC = GetDC(%HWND_DESKTOP)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_DESKTOP, hDC
PointSize = (PointSize * CyPixels) \ 72
FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
%ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
%DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
END FUNCTION
FUNCTION MakeFontUL(BYVAL CFont AS STRING, BYVAL PointSize AS LONG) AS LONG
LOCAL hDC AS LONG
LOCAL CyPixels AS LONG
hDC = GetDC(%HWND_DESKTOP)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_DESKTOP, hDC
PointSize = (PointSize * CyPixels) \ 72
FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, -1, 0, _
%ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
%DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY CFONT)
END FUNCTION
MACRO M_txtwdth
hDC = GetDC(hdlg)
hfont = SelectObject(hDC&,hFontlb)
GetTextExtentPoint32 hDC, BYVAL STRPTR(btext$), LEN(btext$),lpsize
SelectObject hDC, hFont
ReleaseDC hdlg, hDC
WdPix = lpSize.cx + 9
HtPix = lpSize.cy + 1
DIALOG PIXELS hdlg, WdPix, HtPix TO UNITS WdPix, HtPix
btextl = WdPix
END MACRO
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
LOCAL lb AS LOGBRUSH
lb.lbstyle= %BS_SOLID
lb.lbcolor = RGB(224,224,224)
V_Brush = CreateBrushIndirect(Lb)
hFontlb = MakeFont("Tahoma",9)
hFontlbul = MakeFontul("Tahoma",9)
' Initialization handler
CASE %WM_DESTROY
DeleteObject hFontlb
DeleteObject hFontlbul
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_CTLCOLORSTATIC
SELECT CASE GetDlgCtrlID(CBLPARAM)
CASE %LBL_LABEL1 TO %LBL_LABEL3
IF GetDlgCtrlID(CBLPARAM) = CUR_CTRL_ID& THEN
'SetCursor HandMousePointer
SelectObject CBWPARAM, hFontlbul
SetTextColor CBWPARAM, RGB(196,0,0) ' change red when over
ELSE
SelectObject CBWPARAM, hFontlb
SetTextColor CBWPARAM, RGB(0,0,0)
END IF
SetBkColor CBWPARAM, RGB(128,128,128)
SetBkMode CBWPARAM, %Transparent
FUNCTION = V_BRUSH
END SELECT
CASE %WM_SETCURSOR
CUR_CTRL_ID& = GetDlgCtrlID(CBWPARAM)
IF CUR_CTRL_ID& >= %LBL_LABEL2 AND CUR_CTRL_ID& <= %LBL_LABEL3 THEN
CONTROL HANDLE CBHNDL, CUR_CTRL_ID& TO CUR_CTRL&
RedrawWindow CUR_CTRL&, BYVAL 0, 0, %RDW_ERASE OR %RDW_INVALIDATE
PRESS_BUTTON_ON = -1
ELSEIF CUR_CTRL_ID& = 0 AND PRESS_BUTTON_ON = -1 THEN
RedrawWindow CBHNDL, BYVAL 0, 0, %RDW_INVALIDATE '@@@@@
PRESS_BUTTON_ON = 0
END IF
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %LBL_LABEL1
CASE %TXT_TEXTBOX1
CASE %LBL_LABEL2
CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do this"
CASE %LBL_LABEL3
CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"Do that"
CASE %LBL_LABEL4
CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"kp1"
CASE %LBL_LABEL5
CONTROL SET TEXT CBHNDL,%TXT_TEXTBOX1,"kp2"
END SELECT
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
HoverBtn_Initialize
LOCAL lRslt AS LONG, CNT AS LONG
#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
LOCAL btext AS STRING,btextl AS INTEGER,nlm AS INTEGER
LOCAL hFont AS LONG, hDC AS LONG, WdPix AS LONG, HtPix AS LONG, lpSize AS SIZEL
DIALOG NEW hParent, "Button highlight demo", 70, 70, 267, 142, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR _
%WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET COLOR hDlg, -1, RGB(224,224,224)
CONTROL ADD LABEL, hDlg, %LBL_LABEL1, "Field 1", 15, 15, 40, 10
CONTROL ADD TEXTBOX, hDlg, %TXT_TEXTBOX1, "TextBox1", 60, 15, 75, 10
btext$ = "Do this"
nlm = 15 + btextl + 1
M_txtwdth
CONTROL ADD LABEL, hDlg, %LBL_LABEL2, btext$, nlm ,100, btextl, 10, _
%WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL SEND hdlg,%LBL_LABEL2 , %WM_SETFONT, hFontlb, %True
btext$ = "Do that"
nlm = 15 + btextl + 1
M_txtwdth
CONTROL ADD LABEL, hDlg, %LBL_LABEL3, btext$, nlm, 100, btextl, 10, _
%WS_CHILD OR %WS_VISIBLE OR %SS_LEFT OR %SS_NOTIFY, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL SEND hdlg,%LBL_LABEL3 , %WM_SETFONT, hFontlb, %True
CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL4, "Check Button", 10, 70, 50, 14, %HBS_NORMAL
CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
CONTROL SEND hDlg, %LBL_LABEL4, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
CONTROL ADD $HOVERBTNCLASS, hDlg, %LBL_LABEL5, "Check Button", 60, 70, 50, 14, %HBS_NORMAL
CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETCOLORS, %BLUE,RGB(224,224,224)
CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETHOVERCOLORS, %RED,RGB(224,224,224)
CONTROL SEND hDlg, %LBL_LABEL5, %HBM_SETFOCUSCOLOR, -1,RGB(224,224,224)
#PBFORMS END DIALOG
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
Leave a comment: