F_Dixon
16-04-2024, 03:14
I finally got all the types sorted out, I think.
I also found how to deal with the "address Of" here in the forum, again I think. at least when i step through i get something in the var.
I dont think it is calling the function though. i get no errors. it just finishes.
I would be grateful for any pointers. code below. also in the code are comments where the code or types came from. I also made a few changes to make things stop giving errors. they are maked with "FRD"
Thanks Fred, I will also try to add a zip of the file in case it gets garbled.
'USES "CONSOLE"
'http://www.jasinskionline.com/WindowsApi/ref/l/logfont.html
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
'~~~~~~~~~ FRD I changed "string" to stringz
lfFaceName As Stringz * 32
End Type
'http://www.jasinskionline.com/WindowsApi/ref/e/enumlogfontex.html
Type ENUMLOGFONTEX
elfLogFont As LOGFONT
elfFullName As String * 64
elfStyle As String * 32
elfScript As String * 32
End Type
'http://www.jasinskionline.com/WindowsApi/ref/n/newtextmetric.html
Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type
'https://pic.hallikainen.org/techref/os/win/api/win32/struc/src/str08_11.htm
/*
sUsb - A 128-bit Unicode subset bitfield (USB) identifying up to 126 Unicode subranges. Each bit, except the two most significant bits, represents a single subrange. The most significant bit is always 1 and identifies the bitfield as a font signature; the second most significant bit is reserved and must be 0. Unicode subranges are numbered in accordance with the ISO 10646 standard.
fsCsb - A 64-bit, code-page bitfield (CPB) that identifies a specific character set or code-page. Windows code-pages are in the lower 32 bits of this bitfield. The high 32 are used for non-Windows code-pages. For more information, see Code-Page Bitfields.
*/
' fsUsb[4] as dword * 4
' fsCsb[2] as dword * 2
'~~~~~~~~~ FRD I added
type FONTSIGNATURE
fsUsb(4) as dword
fsCsb(2) as dword
END TYPE
'http://www.jasinskionline.com/WindowsApi/ref/n/newtextmetricex.html
Type NEWTEXTMETRICEX
ntmTm As NEWTEXTMETRIC
ntmFontSig As FONTSIGNATURE
End Type
'~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~
'http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamexproc.html
Const %DEVICE_FONTTYPE = &H2
Const %RASTER_FONTTYPE = &H1
Const %TRUETYPE_FONTTYPE = &H4
'~~~~~~~~~ FRD I added
const %ANSI_CHARSET = 0
const %DEFAULT_CHARSET = 1
''http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamexproc.html
'Function EnumFontFamExProc (ByVal lpelfe As Long, _
' ByVal lpntme As Long, _
' ByVal FontType As Long, _
' ByVal lParam As Long) As Long
' ' application-specific code goes here
'End Function
'http://www.jasinskionline.com/WindowsApi/ref/c/copymemory.html
Declare Sub CopyMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'
Declare Function EnumFontFamiliesEx Lib "gdi32.dll" _
Alias "EnumFontFamiliesExA" (ByVal hdc As Long, _
lpLogfont As LOGFONT, _
ByVal lpEnumFontFamExProc As Long, _
ByVal lParam As Long, _
ByVal dwFlags As Long) As Long
'
'~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~
'http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamiliesex.html
' This code is licensed according to the terms and conditions listed here.
' Enumerate some of the fonts available for window Form1.
' These fonts must have the ANSI character set and have the
' Times New Roman typeface. Display some information about
' each font as it is enumerated.
' *** Place the following code in a module. ***
' The following callback function processes the enumerated fonts.
Function EnumFontFamExProc (ByVal lpelfe As Long, _
ByVal lpntme As Long, _ ' A pointer to an ENUMLOGFONTEX structure describing the logical attributes of the font.
ByVal FontType As Long, _ ' A combination of the following flags (although usually only one is used) identifying the type of font: ' [FRD] See const above.
ByVal lParam As Long) As Long ' Additional data specified by EnumFontFamiliesEx.
Dim elfx As ENUMLOGFONTEX ' receives information about the font
Dim ntmx As NEWTEXTMETRICEX ' receives text metrics for TrueType fonts
Dim tm As TEXTMETRIC ' receives text metrics for non-TrueType fonts
' Copy the font information into the appropriate structure.
CopyMemory elfx, ByVal lpelfe, Len(elfx)
' If the font is TrueType, use the following code.
If (FontType And TRUETYPE_FONTTYPE) = TRUETYPE_FONTTYPE Then
' Copy the text metrics into the appropriate structure.
CopyMemory ntmx, ByVal lpntme, Len(ntmx)
' Display the name of the font (removing empty space from it).
printL "Font Name: "; Left(elfx.elfFullName, InStr(elfx.elfFullName, vbNullChar) - 1);
printL " (TrueType font)"
' Display the style of the font (again removing empty space).
printL "Font Style: "; Left(elfx.elfStyle, InStr(elfx.elfStyle, vbNullChar) - 1)
' Display the average character width.
printL "Average Character Width:"; ntmx.ntmTm.tmAveCharWidth
' Display the maximum character width.
printL "Maximum Character Width:"; ntmx.ntmTm.tmMaxCharWidth
' If the font is not TrueType, use the following code.
Else
' Copy the text metrics into the appropriate structure.
CopyMemory tm, ByVal lpntme, Len(tm)
' Display the name of the font (removing empty space from it).
printL "Font Name: ";
printL Left(elfx.elfLogFont.lfFaceName, InStr(elfx.elfLogFont.lfFaceName, vbNullChar) - 1);
' Display whether the font is a device or a raster font.
If FontType = %DEVICE_FONTTYPE Then
printL " (Device font)"
ElseIf FontType = %RASTER_FONTTYPE Then
printL " (Raster font)"
End If
printL "Font Style does not apply for this font."
' Display the average character width.
printL "Average Character Width:"; tm.tmAveCharWidth
' Display the maximum character width.
printL "Maximum Character Width:"; tm.tmMaxCharWidth
End If
printL "***" ' separator
' Tell EnumFontFamiliesEx to continue enumeration.
EnumFontFamExProc = 1
End Function
Function TBMain()
USES "CONSOLE"
dim EFFExProc as Long value 0
EFFExProc = Function_GetPtr( EnumFontFamExProc )
'EFFExProc = Function_GetPtr( EnumFontFamiliesEx )
' *** Place this code wherever you want the enumerate the fonts. ***
Dim lf As LOGFONT ' describes enumeration attributes
Dim retval As Long ' return value
' Initialize the structure to describe the fonts we want.
lf.lfCharset = %DEFAULT_CHARSET ' 1 is the default char_set 'ANSI_CHARSET ' fonts with the ANSI character set
'lf.lfFaceName = "Times New Roman" '& &h0 'vbNullChar ' fonts with the Times New Roman typeface
lf.lfFaceName = "" '& &h0 'vbNullChar ' fonts with the Times New Roman typeface
lf.lfPitchAndFamily = 0 ' this must be 0
' Enumerate such fonts available on window Form1.
'[breakpoint] <Any note here. Breakpoint will be set to line following this statement>
'retval = EnumFontFamiliesEx(Form1.hDC, lf, AddressOf EnumFontFamExProc, 0, 0)
retval = EnumFontFamiliesEx( 0, lf, EFFExProc, 0, 0)
printL "Enumeration complete."
'~~~~~~~~~ FRD I added
Print retval
End Function
'~~~~~~~~~ FRD I added
/*
https://stackoverflow.com/questions/34663570/what-is-the-win32-api-logfont-lfcharset-value-for-the-unicode-character-set
There is no lfCharset value defined for Unicode. That would defeat the purpose of specifying a charset in the first place. Use whichever charset the font actually implements. It looks like most of its barcode glyphs are available in most charsets (some charsets have a few less glyphs). So try setting the lfCharset to 0 (ANSI_CHARSET) or 1 (DEFAULT_CHARSET) if you must set a charset at all.
*/
I also found how to deal with the "address Of" here in the forum, again I think. at least when i step through i get something in the var.
I dont think it is calling the function though. i get no errors. it just finishes.
I would be grateful for any pointers. code below. also in the code are comments where the code or types came from. I also made a few changes to make things stop giving errors. they are maked with "FRD"
Thanks Fred, I will also try to add a zip of the file in case it gets garbled.
'USES "CONSOLE"
'http://www.jasinskionline.com/WindowsApi/ref/l/logfont.html
Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
'~~~~~~~~~ FRD I changed "string" to stringz
lfFaceName As Stringz * 32
End Type
'http://www.jasinskionline.com/WindowsApi/ref/e/enumlogfontex.html
Type ENUMLOGFONTEX
elfLogFont As LOGFONT
elfFullName As String * 64
elfStyle As String * 32
elfScript As String * 32
End Type
'http://www.jasinskionline.com/WindowsApi/ref/n/newtextmetric.html
Type NEWTEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
ntmFlags As Long
ntmSizeEM As Long
ntmCellHeight As Long
ntmAveWidth As Long
End Type
'https://pic.hallikainen.org/techref/os/win/api/win32/struc/src/str08_11.htm
/*
sUsb - A 128-bit Unicode subset bitfield (USB) identifying up to 126 Unicode subranges. Each bit, except the two most significant bits, represents a single subrange. The most significant bit is always 1 and identifies the bitfield as a font signature; the second most significant bit is reserved and must be 0. Unicode subranges are numbered in accordance with the ISO 10646 standard.
fsCsb - A 64-bit, code-page bitfield (CPB) that identifies a specific character set or code-page. Windows code-pages are in the lower 32 bits of this bitfield. The high 32 are used for non-Windows code-pages. For more information, see Code-Page Bitfields.
*/
' fsUsb[4] as dword * 4
' fsCsb[2] as dword * 2
'~~~~~~~~~ FRD I added
type FONTSIGNATURE
fsUsb(4) as dword
fsCsb(2) as dword
END TYPE
'http://www.jasinskionline.com/WindowsApi/ref/n/newtextmetricex.html
Type NEWTEXTMETRICEX
ntmTm As NEWTEXTMETRIC
ntmFontSig As FONTSIGNATURE
End Type
'~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~
'http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamexproc.html
Const %DEVICE_FONTTYPE = &H2
Const %RASTER_FONTTYPE = &H1
Const %TRUETYPE_FONTTYPE = &H4
'~~~~~~~~~ FRD I added
const %ANSI_CHARSET = 0
const %DEFAULT_CHARSET = 1
''http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamexproc.html
'Function EnumFontFamExProc (ByVal lpelfe As Long, _
' ByVal lpntme As Long, _
' ByVal FontType As Long, _
' ByVal lParam As Long) As Long
' ' application-specific code goes here
'End Function
'http://www.jasinskionline.com/WindowsApi/ref/c/copymemory.html
Declare Sub CopyMemory Lib "kernel32.dll" _
Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'
Declare Function EnumFontFamiliesEx Lib "gdi32.dll" _
Alias "EnumFontFamiliesExA" (ByVal hdc As Long, _
lpLogfont As LOGFONT, _
ByVal lpEnumFontFamExProc As Long, _
ByVal lParam As Long, _
ByVal dwFlags As Long) As Long
'
'~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~ '~~~~~~~~~
'http://www.jasinskionline.com/WindowsApi/ref/e/enumfontfamiliesex.html
' This code is licensed according to the terms and conditions listed here.
' Enumerate some of the fonts available for window Form1.
' These fonts must have the ANSI character set and have the
' Times New Roman typeface. Display some information about
' each font as it is enumerated.
' *** Place the following code in a module. ***
' The following callback function processes the enumerated fonts.
Function EnumFontFamExProc (ByVal lpelfe As Long, _
ByVal lpntme As Long, _ ' A pointer to an ENUMLOGFONTEX structure describing the logical attributes of the font.
ByVal FontType As Long, _ ' A combination of the following flags (although usually only one is used) identifying the type of font: ' [FRD] See const above.
ByVal lParam As Long) As Long ' Additional data specified by EnumFontFamiliesEx.
Dim elfx As ENUMLOGFONTEX ' receives information about the font
Dim ntmx As NEWTEXTMETRICEX ' receives text metrics for TrueType fonts
Dim tm As TEXTMETRIC ' receives text metrics for non-TrueType fonts
' Copy the font information into the appropriate structure.
CopyMemory elfx, ByVal lpelfe, Len(elfx)
' If the font is TrueType, use the following code.
If (FontType And TRUETYPE_FONTTYPE) = TRUETYPE_FONTTYPE Then
' Copy the text metrics into the appropriate structure.
CopyMemory ntmx, ByVal lpntme, Len(ntmx)
' Display the name of the font (removing empty space from it).
printL "Font Name: "; Left(elfx.elfFullName, InStr(elfx.elfFullName, vbNullChar) - 1);
printL " (TrueType font)"
' Display the style of the font (again removing empty space).
printL "Font Style: "; Left(elfx.elfStyle, InStr(elfx.elfStyle, vbNullChar) - 1)
' Display the average character width.
printL "Average Character Width:"; ntmx.ntmTm.tmAveCharWidth
' Display the maximum character width.
printL "Maximum Character Width:"; ntmx.ntmTm.tmMaxCharWidth
' If the font is not TrueType, use the following code.
Else
' Copy the text metrics into the appropriate structure.
CopyMemory tm, ByVal lpntme, Len(tm)
' Display the name of the font (removing empty space from it).
printL "Font Name: ";
printL Left(elfx.elfLogFont.lfFaceName, InStr(elfx.elfLogFont.lfFaceName, vbNullChar) - 1);
' Display whether the font is a device or a raster font.
If FontType = %DEVICE_FONTTYPE Then
printL " (Device font)"
ElseIf FontType = %RASTER_FONTTYPE Then
printL " (Raster font)"
End If
printL "Font Style does not apply for this font."
' Display the average character width.
printL "Average Character Width:"; tm.tmAveCharWidth
' Display the maximum character width.
printL "Maximum Character Width:"; tm.tmMaxCharWidth
End If
printL "***" ' separator
' Tell EnumFontFamiliesEx to continue enumeration.
EnumFontFamExProc = 1
End Function
Function TBMain()
USES "CONSOLE"
dim EFFExProc as Long value 0
EFFExProc = Function_GetPtr( EnumFontFamExProc )
'EFFExProc = Function_GetPtr( EnumFontFamiliesEx )
' *** Place this code wherever you want the enumerate the fonts. ***
Dim lf As LOGFONT ' describes enumeration attributes
Dim retval As Long ' return value
' Initialize the structure to describe the fonts we want.
lf.lfCharset = %DEFAULT_CHARSET ' 1 is the default char_set 'ANSI_CHARSET ' fonts with the ANSI character set
'lf.lfFaceName = "Times New Roman" '& &h0 'vbNullChar ' fonts with the Times New Roman typeface
lf.lfFaceName = "" '& &h0 'vbNullChar ' fonts with the Times New Roman typeface
lf.lfPitchAndFamily = 0 ' this must be 0
' Enumerate such fonts available on window Form1.
'[breakpoint] <Any note here. Breakpoint will be set to line following this statement>
'retval = EnumFontFamiliesEx(Form1.hDC, lf, AddressOf EnumFontFamExProc, 0, 0)
retval = EnumFontFamiliesEx( 0, lf, EFFExProc, 0, 0)
printL "Enumeration complete."
'~~~~~~~~~ FRD I added
Print retval
End Function
'~~~~~~~~~ FRD I added
/*
https://stackoverflow.com/questions/34663570/what-is-the-win32-api-logfont-lfcharset-value-for-the-unicode-character-set
There is no lfCharset value defined for Unicode. That would defeat the purpose of specifying a charset in the first place. Use whichever charset the font actually implements. It looks like most of its barcode glyphs are available in most charsets (some charsets have a few less glyphs). So try setting the lfCharset to 0 (ANSI_CHARSET) or 1 (DEFAULT_CHARSET) if you must set a charset at all.
*/