help please. i am trying to use the numFontFamiliesEx

**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.

*/

**ErosOlmi** · 16-04-2024, 20:54

Ciao,

here below my reduced at the minimum version showing how to do.
You need to complete with all your needs

Main problem was the identification on how to get a REAL pointer to a script function in thinBasic. Not easy to get, sorry.
You need to used CodePtr function

thinBasic function is a source script code in memory. There is not code pointer to a function.
To get this job done, thinCore (thinBasic engine) ha s set of predefined internal real compiled proxy functions to be associated to script functions.
This allow CodePtr to return a real pointer to compiled functions.

Let me know.
Eros

USES "CONSOLE"
uses "UI"




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
    lfFaceName As Stringz * 32
End Type




Declare Function EnumFontFamiliesEx Lib "gdi32.dll" _
        Alias "EnumFontFamiliesExA" ( 
                                      ByVal hdc As Long, 
                                      byval lpLogfont As dword, 
                                      ByVal lpEnumFontFamExProc As Long, 
                                      ByVal lParam As Long, 
                                      ByVal dwFlags As Long ) As Long


printl "Start enumerating fonts ..."
EnumerateFonts


printl "Finished. Pressa key to end."
WaitKey


Sub EnumerateFonts()
   Local hDC  As Dword
   local lf   As LogFont
   
   hDC = win_GetDC(%HWND_Desktop)
   
   '---CodePtr is the function to use to get a real binary compiled function pointer
   '---CodePtr will associate an internal real compiled thinCore (thinBasic engine) proxy function
   '---with the script function name passed to it
   EnumFontFamiliesEx hDC, varptr(lf), CodePtr(EnumFontName), 0, 0
   
   win_ReleaseDC %HWND_Desktop, hDC
End Sub


Function EnumFontName(lf As long, tm As long, ByVal FontType As Long, hWnd As Dword) As Long
  '---lf is a LOGFONT pointer. To associate LOGFONT data to it, just
  '---define a local LOGFONT virtual variable dimensioned at the same memory area where lp points
  local lfx as LOGFONT at lf


  '---Now whe can use lfx as a real variable but in reality it is a proxy variable
      printl lfx.lfFaceName


   Function = 1
End Function

**F_Dixon** · 18-04-2024, 08:00

Originally Posted by ErosOlmi

Ciao,

here below my reduced at the minimum version showing how to do.
You need to complete with all your needs

Main problem was the identification on how to get a REAL pointer to a script function in thinBasic. Not easy to get, sorry.
You need to used CodePtr function

thinBasic function is a source script code in memory. There is not code pointer to a function.
To get this job done, thinCore (thinBasic engine) ha s set of predefined internal real compiled proxy functions to be associated to script functions.
This allow CodePtr to return a real pointer to compiled functions.

Let me know.
Eros

USES "CONSOLE"
uses "UI"




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
    lfFaceName As Stringz * 32
End Type




Declare Function EnumFontFamiliesEx Lib "gdi32.dll" _
        Alias "EnumFontFamiliesExA" ( 
                                      ByVal hdc As Long, 
                                      byval lpLogfont As dword, 
                                      ByVal lpEnumFontFamExProc As Long, 
                                      ByVal lParam As Long, 
                                      ByVal dwFlags As Long ) As Long


printl "Start enumerating fonts ..."
EnumerateFonts


printl "Finished. Pressa key to end."
WaitKey


Sub EnumerateFonts()
   Local hDC  As Dword
   local lf   As LogFont
   
   hDC = win_GetDC(%HWND_Desktop)
   
   '---CodePtr is the function to use to get a real binary compiled function pointer
   '---CodePtr will associate an internal real compiled thinCore (thinBasic engine) proxy function
   '---with the script function name passed to it
   EnumFontFamiliesEx hDC, varptr(lf), CodePtr(EnumFontName), 0, 0
   
   win_ReleaseDC %HWND_Desktop, hDC
End Sub


Function EnumFontName(lf As long, tm As long, ByVal FontType As Long, hWnd As Dword) As Long
  '---lf is a LOGFONT pointer. To associate LOGFONT data to it, just
  '---define a local LOGFONT virtual variable dimensioned at the same memory area where lp points
  local lfx as LOGFONT at lf


  '---Now whe can use lfx as a real variable but in reality it is a proxy variable
      printl lfx.lfFaceName


   Function = 1
End Function

just found this, very early in the morning. I havent looked at it yet. I will right after i get some sleep.
I had found the sever posts about the script needing to use function_ or code_ptr (not sure on spell right now) In a one of the 2 posts I tried both of the options, mostly from frustration, i was thinking function was the the right one. i tried both. I was sure i was doing something wrong.

either way I will look at this later in my day. I am in a +6 or +7 times zone, so much later.
Thank you for the reply. I will give it go. some days Im to stubborn to quit and not smart enough to know better.

**F_Dixon** · 18-04-2024, 19:51

Originally Posted by F_Dixon

just found this, very early in the morning. I havent looked at it yet. I will right after i get some sleep.
I had found the sever posts about the script needing to use function_ or code_ptr (not sure on spell right now) In a one of the 2 posts I tried both of the options, mostly from frustration, i was thinking function was the the right one. i tried both. I was sure i was doing something wrong.

either way I will look at this later in my day. I am in a +6 or +7 times zone, so much later.
Thank you for the reply. I will give it go. some days Im to stubborn to quit and not smart enough to know better.

Really working on lack of sleep. Thanks for this working example. I will dig through and see when i went wrong. Thanks for taking the time to show me.

I really want to comment on what an outstanding job I think you have done on thinbasic and the effort you guys have put into every little corner of this great tool. not to mention help some random person from the internet with there questions. what a great job. i'll go away now not be a bother for a bit.

Thread: help please. i am trying to use the numFontFamiliesEx

Thread Tools

Search Thread

Display

help please. i am trying to use the numFontFamiliesEx

Members who have read this thread: 1

Bookmarks

Bookmarks

Posting Permissions