'-------------------------------------------------------------------------
' This is "ResFont.inc", as taken from:
' https://forum.powerbasic.com/forum/user-to-user-discussions/programming/794788-embeded-fonts-in-exe-anyone-got-it-to-work
'-------------------------------------------------------------------------
' Usage:
' -----
' 1) In your RC file, add your font and compile:
'           FNT1 RCDATA "Square-Dot-Matrix.ttf"
'
' 2) In your main Callback, use the following:
'           STATIC idResFont AS DOUBLE
'           STATIC hFont AS DWORD
'
'           CASE %WM_INITDIALOG
'               idResFont = AddResFont("FNT1")
'               FONT NEW "Square Dot-Matrix", 18, 0 TO hFont
'               CONTROL SET FONT CB.HNDL, 101, hFont
'
'           CASE %WM_DESTROY
'               FONT END hFont
'               RemoveResFont(idResFont)
'-------------------------------------------------------------------------

'-------------------------------------------------------------------------
FUNCTION AddResFont(sResName AS STRING) AS DOUBLE
    LOCAL ts, sFileFromRes AS STRING
    LOCAL idf AS DOUBLE
    LOCAL ff AS LONG

    IF sResName = "" THEN EXIT FUNCTION
    ts = REMOVE$(DATE$,"-") + REMOVE$(TIME$,":")
    idf = VAL(ts)

    sFileFromRes = TempDir() + FORMAT$(idf) + ".ttf"
    ff = FREEFILE
    OPEN sFileFromRes FOR BINARY AS #ff
    PUT$ #ff, RESOURCE$(sResName)
    CLOSE #ff

    AddFontResourceEx(BYVAL STRPTR(sFileFromRes), %FR_PRIVATE, 0)

    FUNCTION = idf
END FUNCTION
'-------------------------------------------------------------------------

'-------------------------------------------------------------------------
FUNCTION RemoveResFont(BYVAL idRes AS DOUBLE) AS LONG
    LOCAL sFileFromRes AS STRING

    IF idRes = 0 THEN EXIT FUNCTION

    sFileFromRes = TempDir() + FORMAT$(idRes) + ".ttf"
    RemoveFontResourceEx(BYVAL STRPTR(sFileFromRes), %FR_PRIVATE, 0)
    KILL sFileFromRes

    FUNCTION = 1
END FUNCTION
'-------------------------------------------------------------------------

'-------------------------------------------------------------------------
FUNCTION RESOURCE$(BYVAL rid AS STRING)
    LOCAL L1, L2 AS LONG
    LOCAL D1, D2 AS DWORD

    L1 = FindResource  (GetModuleHandle(""), (rid), BYVAL %RT_RCDATA)
    D2 = SizeofResource(GetModuleHandle(""), L1)
    L2 = LoadResource  (GetModuleHandle(""), L1)
    D1 = LockResource  (L2)

    FUNCTION = PEEK$(D1,D2)
END FUNCTION
'-------------------------------------------------------------------------

'-------------------------------------------------------------------------
FUNCTION TempDir() AS STRING
    LOCAL lpBuffer AS ASCIIZ * %MAX_PATH
    GetTempPath(%MAX_PATH, lpBuffer)
    FUNCTION = RTRIM$(lpBuffer, "\") + "\"
END FUNCTION
'-------------------------------------------------------------------------