Fontdemo: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  Fontdemo.frm                                                              *
'                                                                            *
'  This program shows how use Windows stock fonts in Fastgraph for Windows,  *
'  and also how to create and use a Windows logical font. The logical font   *
'  is a 24x12 script font.                                                   *
'                                                                            *
'*****************************************************************************
Private Declare Function CreateFontIndirect _
   Lib "gdi32" Alias "CreateFontIndirectA" (lf As LogFont) As Long
Const vbWidth = 320
Const vbHeight = 240
Private Type LogFont
   Height As Long
   Width As Long
   Escapement As Long
   Orientation As Long
   Weight As Long
   Italic As Byte
   Underline As Byte
   StrikeOut As Byte
   CharSet As Byte
   OutPrecision As Byte
   ClipPrecision As Byte
   Quality As Byte
   PitchAndFamily As Byte
   FaceName(32) As Byte
End Type
Dim hFont As Long
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   Dim lf As LogFont
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   Call fg_setcolor(24)
   Call fg_fillpage
   lf.Height = 24           ' character height in pixels
   lf.Width = 12            ' character width in pixels
   lf.Escapement = 0        ' orientation of next character
   lf.Orientation = 0       ' orientation of first character
   lf.Weight = 400          ' normal thickness
   lf.Italic = False        ' not italic characters
   lf.Underline = False     ' not underlined characters
   lf.StrikeOut = False     ' not strikeout characters
   lf.CharSet = 255         ' OEM character set
   lf.OutPrecision = 0      ' default output precision
   lf.ClipPrecision = 0     ' default clipping precision
   lf.Quality = 0           ' default scaling quality
   lf.PitchAndFamily = 64   ' default pitch, script font family
   lf.FaceName(0) = Asc("s")
   lf.FaceName(1) = Asc("c")
   lf.FaceName(2) = Asc("r")
   lf.FaceName(3) = Asc("i")
   lf.FaceName(4) = Asc("p")
   lf.FaceName(5) = Asc("t")
   lf.FaceName(6) = 0       ' script typeface
   hFont = CreateFontIndirect(lf)
End Sub
Private Sub Form_Paint()
   Dim x As Long
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
   Call fg_setcolor(19)
   x = fg_xclient(20)
   Call fg_move(x, fg_yclient(20))
   Call fg_fontload(10)
   Call fg_print("OEM fixed font", 14)
   Call fg_move(x, fg_yclient(40))
   Call fg_fontload(11)
   Call fg_print("ANSI fixed font", 15)
   Call fg_move(x, fg_yclient(60))
   Call fg_fontload(12)
   Call fg_print("ANSI var font", 13)
   Call fg_move(x, fg_yclient(80))
   Call fg_fontload(13)
   Call fg_print("system font", 11)
   Call fg_move(x, fg_yclient(100))
   Call fg_fontload(14)
   Call fg_print("device default font", 19)
   Call fg_move(x, fg_yclient(120))
   Call fg_fontload(16)
   Call fg_print("system fixed font", 17)
   Call fg_move(x, fg_yclient(160))
   Call fg_logfont(hFont)
   Call fg_print("script font", 11)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub