Tweet
#RESOURCE "truetype.pbr" 'MyFont RCDATAT alphalcd.ttf
CASE %WM_INITDIALOG
sFontFile = "C:\PowerBasic\Samples\alphalcd.ttf" '<-if from file
'sFontFile = "MyFont" '<-if from resource/ note: doesn't work
lRt& = AddFontResource(BYVAL STRPTR(sFontFile))
'SendMessage(%HWND_BROADCAST, %WM_FONTCHANGE, 0, 0) '<--not necessary if confined within your own process.
'SendMessage(%HWND_BROADCAST, %WM_SETTINGCHANGE, 0, 0)'<-- ditto
hFont = PBFormsMakeFont("Alphanumeric LCD",80,400,%FALSE,%FALSE,%FALSE,%ANSI_CHARSET)
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_BUTTON1
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
A$ = FORMAT$(123456, "00\:00\:00")
CONTROL SET TEXT CBHNDL, %IDC_LABEL1,A$
CONTROL SEND CBHNDL, %IDC_LABEL1, %WM_SETFONT, hFont, 0
CONTROL REDRAW CBHNDL, %IDC_LABEL1
END IF
END SELECT
CASE %WM_DESTROY
DeleteObject hFont
RemoveFontResource( BYVAL STRPTR(sFontFile)) '<--corrected VARPTR to STRPTR per MCM catch.
lRt& = AddFontResource(BYVAL STRPTR(sFontFile))
...
RemoveFontResource( BYVAL VARPTR(sFontFile))
#COMPILE EXE '#Win 8.03#
#REGISTER NONE
#INCLUDE "Win32Api.inc" '#2005-01-27#
#INCLUDE "Pbforms.inc"
OPTION EXPLICIT
%ButtonOne = 101
%TimerOne = 201
%labelOne = 301
'______________________________________________________________________________
CALLBACK FUNCTION DlgProc
STATIC TimerCount AS LONG
LOCAL hCtrl AS LONG
STATIC szFontFile AS ASCIIZ * %MAX_PATH
LOCAL hFont AS LONG, I AS LONG
LOCAL sFontFace AS STRING
SELECT CASE CBMSG
CASE %WM_INITDIALOG
CONTROL HANDLE CBHNDL, %LabelOne TO hCtrl
' file from Jules Marchildon / tripod
szFontFile = "alphalcd.ttf"
sFontFace = "Alphanumeric LCD"
' file from Harvey Twyman
szFontFile = "7 Segment.ttf"
sFontFace = "7 Segment"
I = AddFontResource(BYVAL VARPTR(szFontFile))
MSGBOX USING$ ("Added # fonts", I)
'hFont = PBFormsMakeFont(sFontFace, 36, 200,%FALSE,%FALSE,%FALSE,%ANSI_CHARSET)
' LED font would not work with ANSI_CHARSET
hFont = PBFormsMakeFont(sFontFace, 30, 200,%FALSE,%FALSE,%FALSE,%DEFAULT_CHARSET)
IF ISFALSE hFont THEN
MSGBOX "MakeFont failed"
END IF
CONTROL SEND CBHNDL, %LabelOne, %WM_SETFONT, hFont, %NULL
CONTROL SET USER CBHNDL, %LabelOne, 1, hFont
CASE %WM_SETCURSOR
IF (CBWPARAM = GetDlgItem(CBHNDL, %ButtonOne)) AND _ 'Is it the button handle
(HI(WORD, CBLPARAM) = %WM_LBUTTONDOWN) THEN 'Is button pushed
DIALOG SET TEXT CBHNDL, HEX$(HI(WORD, CBLPARAM)) & " : Button is down "
SetTimer CBHNDL, %TimerOne, 100, BYVAL %NULL 'Set a 100 miliseconds timer
ELSE
DIALOG SET TEXT CBHNDL, HEX$(HI(WORD, CBLPARAM)) & " : Button is up"
KillTimer CBHNDL, %TimerOne
END IF
CASE %WM_DESTROY
CONTROL GET USER CBHNDL, %LabelOne, 1 TO hFont
DeleteObject hFont
RemoveFontResource( BYVAL VARPTR(szFontFile))
CASE %WM_TIMER
SELECT CASE CBWPARAM
CASE %TimerOne
INCR TimerCount
CONTROL SET TEXT CBHNDL, %ButtonOne, "Timercount :" & STR$(Timercount)
CONTROL SET TEXT CBHNDL, %LabelOne, USING$("Count #,", TimerCount)
END SELECT
CASE %WM_COMMAND
SELECT CASE LOWRD(CBWPARAM)
CASE %ButtonOne
IF CBCTLMSG = %BN_CLICKED THEN
END IF
END SELECT
END SELECT
END FUNCTION
'______________________________________________________________________________
FUNCTION PBMAIN()
LOCAL hDlg AS DWORD
DIALOG NEW %HWND_DESKTOP ,"Button down / LED FONT", , , 200, 120, _
%WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU, 0 TO hDlg
SetClassLong hDlg, %GCL_HICON, LoadIcon(BYVAL %NULL, BYVAL %IDI_INFORMATION)
CONTROL ADD BUTTON, hDlg, %ButtonOne, "Button", 50, 43, 100, 15, _
%BS_CENTER OR %BS_VCENTER OR %WS_TABSTOP, %WS_EX_LEFT
CONTROL ADD LABEL, hDlg, %LabelOne, "", 50,63,120, 80
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
'______________________________________________________________________________
Comment