2002-12-12 22:03

'From:  "Pascal Delcombel Wed Dec 11, 2002  4:45 pm
' Add / remove Windows font

'Install Font (just for windows's session, all application may see it)
'P. Delcombel / December 2002


     DECLARE FUNCTION AddFontResource LIB "gdi32" ALIAS "AddFontResourceA" (BYVAL lpFileName AS STRING) AS LONG
     DECLARE FUNCTION RemoveFontResource LIB "gdi32" ALIAS "RemoveFontResourceA" (BYVAL lpFileName AS STRING) AS LONG
     DECLARE FUNCTION PostMessageW LIB "user32" ALIAS "PostMessageA" (BYVAL hwnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
     CONST HWND_BROADCAST = &HFFFF&
     CONST WM_FONTCHANGE = &H1D

     DIM FontFileName AS STRING
     DIM FontName AS STRING

     FontFileName = "c:\windows\fonts\BusIndus.ttf" 'change as appropriate
     FontName = "Business/Industrial" 'change as appropriate

     AddFontResource(FontFileName)
     CREATE MainForm AS QFORM
      Width = 340
      Height = 205
      CREATE Bouton AS QCOOLBTN
       font.name = FontName
       Font.Bold = 1
       CAPTION = "Et oui!"
       Top = 32
       Left = 125
       Width = 45
      END CREATE
     END CREATE
     MainForm.SHOWMODAL
     RemoveFontResource(FontFileName)


     SUB AddFont(Filename AS STRING)
      DIM lResult AS LONG
      lResult = AddFontResource(FileName)
      lResult = PostMessageW(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
     END SUB
     SUB RemoveFont(Filename AS STRING)
      DIM lResult AS LONG
      lResult = RemoveFontResource(FileName)
      lResult = PostMessageW(HWND_BROADCAST, WM_FONTCHANGE, 0, 0)
     END SUB

2002-12-12 22:03