Results 1 to 4 of 4

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

  1. #1

    help please. i am trying to use the numFontFamiliesEx

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

  2. #2
    thinBasic author ErosOlmi's Avatar
    Join Date
    Sep 2004
    Location
    Milan - Italy
    Age
    57
    Posts
    8,793
    Rep Power
    10
    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
    
    Last edited by ErosOlmi; 16-04-2024 at 21:15.
    www.thinbasic.com | www.thinbasic.com/community/ | help.thinbasic.com
    Windows 10 Pro for Workstations 64bit - 32 GB - Intel(R) Xeon(R) W-10855M CPU @ 2.80GHz - NVIDIA Quadro RTX 3000

  3. #3
    Quote Originally Posted by ErosOlmi View Post
    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.

  4. #4
    Quote Originally Posted by F_Dixon View Post
    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.

Members who have read this thread: 4

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •