Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Getting the Font Name from a TTF File

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC Getting the Font Name from a TTF File

    The function GetTTFontName, if successful, will return the name of the font of the target true-type font file, otherwise it will return an empty string. By "name" I mean the name you would use with the "FONT NEW" statement or its API call equivalent.

    It's based on the source I found here: https://www.codeproject.com/Articles...-from-TTF-file

    The two functions MLLE (Make Long word Little-endian) and MSLE (Make Short word Little-endian) reverses the byte order of unsigned 32 bit and unsigned16 bit integers respectively. They are required because the data in TTF files are stored in Motorola CPU compatible format (big endian) rather than Intel format (little endian).

    I've tried this program with only a handful of different TTF files, so I'm not going to vouch for its reliability.

    This:
    Code:
      'Each character of the returned name is preceded by a space
                'for some reason. This removes the superflous spaces
    It just dawned on me the font name is stored in wide format .

    Code:
    #COMPILE EXE
    #DIM ALL
    
    #IF NOT %DEF (%TRUE)
    %TRUE = -1
    #ENDIF
    #IF NOT %DEF (%FALSE)
    %FALSE = NOT %TRUE
    #ENDIF
    
    MACRO macTRAP(FUNC) = IF FUNC THEN EXIT FUNCTION
    
    TYPE tOFFSET_TABLE
     wMajorVersion AS WORD
     wMinorVersion AS WORD
     wNumOfTables  AS WORD
     wSearchRange  AS WORD
     wEntrySelector AS WORD
     wRangeShift AS WORD
    END TYPE
    
    TYPE tTABLE_DIRECTORY
     szTag AS STRINGZ * 4   'table name
     dwCheckSum  AS DWORD  'Check sum
     dwOffset AS DWORD    'Offset from beginning of file
     dwLength AS DWORD     'length of the table in bytes
    END TYPE
    
    TYPE tNAME_TABLE_HEADER
     wFSelector AS WORD           'format selector. Always 0
     wNRCount AS WORD             'Name Records count
     wStorageOffset AS WORD       'Offset for strings storage, from start of the table
    END TYPE
    
    TYPE tNAME_RECORD
     wPlatformID AS WORD
     wEncodingID AS WORD
     wLanguageID AS WORD
     wNameID AS WORD
     wStringLength AS WORD
     wStringOffset AS WORD        'from start of storage area
    END TYPE
    
    FUNCTION PBMAIN () AS LONG
    
      ?GetTTFontName("Font file name.ttf")
    
      WAITKEY$
    
    END FUNCTION
    
    FUNCTION GetTTFontName(BYREF sFontFileName AS STRING) AS STRING
      LOCAL hFile, gCounterA, gCounterB AS LONG
      DIM tOSTable AS tOFFSET_TABLE
    
      ON ERROR GOTO ErrOut
    
      hFile = FREEFILE
    
      OPEN sFontFileName FOR BINARY AS hFile BASE = 0
    
      IF GetFileData(hFile, VARPTR(tOSTable), SIZEOF(tOFFSET_TABLE)) THEN GOTO ErrOut
        tOSTable.wNumOfTables = MSLE(tOSTable.wNumOfTables)
        tOSTable.wMajorVersion = MSLE(tOSTable.wMajorVersion)
        tOSTable.wMinorVersion = MSLE(tOSTable.wMinorVersion)
    
        'check if this is a true type font and the version is 1.0
        IF (tOSTable.wMajorVersion <> 1) OR (tOSTable.wMinorVersion <> 0) THEN
          EXIT FUNCTION
        END IF
    
        DIM tBLDir AS tTABLE_DIRECTORY
        LOCAL bFound AS BYTE
        LOCAL szTag AS STRINGZ * 5 'This is not good
        LOCAL pbIn, pbOut AS BYTE PTR
        LOCAL gCounterC AS LONG
    
        bFound = %FALSE
    
        FOR gCounterA = 0 TO tOSTable.wNumOfTables
    
          macTRAP(GetFileData(hFile, VARPTR(tBLDir), SIZEOF(tTABLE_DIRECTORY)))
          pbIn = VARPTR(tBLDir.szTag)
          pbOut = VARPTR(szTag)
    
          FOR gCounterC = 1 TO SIZEOF(tBLDir.szTag)
             @pbOut = @pbIn
             INCR pbOut
             INCR pbIn
          NEXT gCounterC
    
          szTag = szTag + $NUL
    
          IF UCASE$(szTag) = "NAME" THEN
            bFound = %TRUE
            tBLDir.dwLength = MLLE(tBLDir.dwLength)
            tBLDir.dwOffset = MLLE(tBLDir.dwOffset)
            EXIT FOR
          END IF
    
        NEXT gCounterA
    
        IF bFound THEN
         'move to offset we got from Offsets Table
          SEEK #hFile, tBLDir.dwOffset
          DIM tNTHeader AS tNAME_TABLE_HEADER
    
          macTRAP(GetFileData(hFile, VARPTR(tNTHeader), SIZEOF(tNAME_TABLE_HEADER)))
    
          tNTHeader.wNRCount = MSLE(tNTHeader.wNRCount)
          tNTHeader.wStorageOffset = MSLE(tNTHeader.wStorageOffset)
    
          DIM tNRec AS tNAME_RECORD
          LOCAL gPos AS LONG
    
          FOR gCounterB = 0 TO tNTHeader.wNRCount
            macTRAP(GetFileData(hFile, VARPTR(tNRec), SIZEOF(tNAME_RECORD)))
            tNRec.wNameID = MSLE(tNRec.wNameID)
    
            IF tNRec.wNameID = 1 THEN
              tNRec.wStringLength = MSLE(tNRec.wStringLength)
              tNRec.wStringOffset = MSLE(tNRec.wStringOffset)
              'Save current file pos
              gPos = SEEK(hFile)
    
              SEEK #hFile, tBLDir.dwOffset + tNTHeader.wStorageOffset + tNRec.wStringOffset
    
              LOCAL sNameBuff AS STRING
    
              sNameBuff = STRING$(tNRec.wStringLength, CHR$(0))
    
              macTRAP(GetFileData(hFile, STRPTR(sNameBuff), tNRec.wStringLength))
    
              IF LEN(sNameBuff) THEN
                'Each character of the returned name is preceded by a space
                'for some reason. This removes the superflous spaces
                pbOut = STRPTR(sNameBuff)
                pbIn = pbOut + 1
    
                FOR gCounterA = 1 TO tNRec.wStringLength
                  @pbOut = @pbIn
                  INCR pbOut
                  pbIn = pbIn + 2
                NEXT gCounterA
    
                FUNCTION = LEFT$(sNameBuff, tNRec.wStringLength/2)
    
                EXIT FUNCTION
              END IF
              'Restore file pos for next iteration
              SEEK hFile, gPos
            END IF
    
          NEXT gCounterB
         END IF
    
    ErrOut:
      FUNCTION = ""
    
    END FUNCTION
    
    FUNCTION GetFileData(BYVAL hFile AS LONG, BYVAL pDest AS BYTE PTR, BYVAL dwSizeOf AS DWORD) AS LONG
      DIM sBuffer AS STRING
      LOCAL pszBPtr AS BYTE PTR
      LOCAL gCounter AS LONG
    
      ON ERROR GOTO ErrOut
    
      GET$ #hFile, dwSizeOf, sBuffer
    
      pszBPtr = STRPTR(sBuffer)
    
      FOR gCounter = 1 TO dwSizeOf
        @pDest = @pszBPtr
        INCR pDest
        INCR pszBPtr
      NEXT gCounter
    
      EXIT FUNCTION
    
    ErrOut:
      FUNCTION = ERR
    
    END FUNCTION
    
    FUNCTION MSLE(BYVAL wWord AS WORD) AS WORD
     FUNCTION = MAK(WORD, HI(BYTE, wWord), LO(BYTE, wWord))
    END FUNCTION
    
    FUNCTION MLLE(BYVAL dwDWord AS DWORD) AS DWORD
     FUNCTION = MAK(DWORD, MSLE(HI(WORD, dwDWord)), MSLE(LO(WORD, dwDWord)))
    END FUNCTION
Working...
X