Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Include "Win32API.inc"
%IDC_ListBox = 500
%IDC_TextBox = 501
%IDC_CheckBox = 502
Global hDlg,hListBox,hFont,CheckStatus As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "EnumFonts",300,300,200,250, %WS_OverlappedWindow To hDlg
Control Add TextBox, hDlg, %IDC_TextBox, "0 0 abc ABC", 0,5,125,30
Control Add CheckBox, hDlg, %IDC_CheckBox,"Mono",135,5,65,30
Control Add ListBox, hDlg, %IDC_ListBox, , 0, 35, 200, 200, %LBS_NoIntegralHeight Or %LBS_Sort Or %LBS_Notify Or %WS_TabStop Or %WS_VScroll, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_ListBox To hListBox
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
EnumerateFonts
ListBox Select hDlg, %IDC_ListBox, 1
UpdateDisplay
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_ListBox
If Cb.CtlMsg = %LBN_SelChange Then UpdateDisplay
Case %IDC_CheckBox
If Cb.CtlMsg = %BN_Clicked Then
EnumerateFonts
ListBox Select hDlg, %IDC_ListBox, 1
UpdateDisplay
End If
End Select
End Select
End Function
Sub EnumerateFonts
Local hDC As Dword
ListBox Reset hDlg, %IDC_ListBox
Control Get Check hDlg, %IDC_CheckBox To CheckStatus
hDC = GetDC(%HWND_Desktop)
EnumFonts hDC, ByVal %NULL, CodePtr(EnumFontName), ByVal VarPtr(hListBox)
ReleaseDC %HWND_Desktop, hDC
End Sub
Function EnumFontName(lf As LogFont, tm As TextMetric, ByVal FontType As Long, hWnd As Dword) As Long
If CheckStatus Then
If (FontType And %TMPF_Fixed_Pitch) Then ListBox Add hDlg, %IDC_ListBox, lf.lfFaceName
Else
ListBox Add hDlg, %IDC_ListBox, lf.lfFaceName
End If
Function = 1
End Function
Sub UpdateDisplay
Local temp$
Font End hFont
ListBox Get Text hDlg, %IDC_ListBox To temp$
Font New temp$, 12, 0 To hFont
Control Set Font hDlg, %IDC_TextBox, hFont
Control ReDraw hDlg, %IDC_TextBox
Control Set Focus hDlg, %IDC_ListBox
End Sub
'gbs_01280
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm