home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 6 / Eagles_Nest_Mac_Collection_Disc_6.TOAST / Windows / VisBasAPIex / VBAPIGUIDE.image / FONTVIEW.FRM < prev    next >
Text File  |  1992-12-01  |  8KB  |  237 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "Font Viewer"
  4.    Height          =   4425
  5.    Left            =   1035
  6.    LinkMode        =   1  'Source
  7.    LinkTopic       =   "Form1"
  8.    ScaleHeight     =   4020
  9.    ScaleWidth      =   7365
  10.    Top             =   1140
  11.    Width           =   7485
  12.    Begin TextBox TxtWeight 
  13.       Height          =   315
  14.       Left            =   1260
  15.       TabIndex        =   8
  16.       Text            =   "400"
  17.       Top             =   2880
  18.       Width           =   1335
  19.    End
  20.    Begin CommandButton CmdShowMetrics 
  21.       Caption         =   "ShowMetrics"
  22.       Height          =   495
  23.       Left            =   2820
  24.       TabIndex        =   16
  25.       Top             =   2760
  26.       Width           =   1215
  27.    End
  28.    Begin TextBox TxtEscapement 
  29.       Height          =   315
  30.       Left            =   1260
  31.       TabIndex        =   6
  32.       Text            =   "0"
  33.       Top             =   2520
  34.       Width           =   1335
  35.    End
  36.    Begin CommandButton CmdShowFont 
  37.       Caption         =   "ShowFont"
  38.       Height          =   495
  39.       Left            =   2820
  40.       TabIndex        =   13
  41.       Top             =   2160
  42.       Width           =   1215
  43.    End
  44.    Begin TextBox TxtWidth 
  45.       Height          =   315
  46.       Left            =   1260
  47.       TabIndex        =   4
  48.       Text            =   "10"
  49.       Top             =   2160
  50.       Width           =   1335
  51.    End
  52.    Begin PictureBox PicText 
  53.       Height          =   1635
  54.       Left            =   4200
  55.       ScaleHeight     =   1605
  56.       ScaleWidth      =   2865
  57.       TabIndex        =   9
  58.       Top             =   2100
  59.       Width           =   2895
  60.    End
  61.    Begin TextBox TxtHeight 
  62.       Height          =   315
  63.       Left            =   1260
  64.       TabIndex        =   1
  65.       Text            =   "10"
  66.       Top             =   1800
  67.       Width           =   1335
  68.    End
  69.    Begin TextBox TxtSample 
  70.       Height          =   315
  71.       Left            =   5400
  72.       TabIndex        =   14
  73.       Text            =   "ABC"
  74.       Top             =   1440
  75.       Width           =   1755
  76.    End
  77.    Begin CheckBox ChkStrikeout 
  78.       Caption         =   "StrikeOut"
  79.       Height          =   375
  80.       Left            =   4140
  81.       TabIndex        =   12
  82.       Top             =   1020
  83.       Width           =   1575
  84.    End
  85.    Begin CheckBox ChkItalic 
  86.       Caption         =   "Italic"
  87.       Height          =   375
  88.       Left            =   4140
  89.       TabIndex        =   11
  90.       Top             =   600
  91.       Width           =   1575
  92.    End
  93.    Begin CheckBox ChkUnderline 
  94.       Caption         =   "Underline"
  95.       Height          =   315
  96.       Left            =   4140
  97.       TabIndex        =   10
  98.       Top             =   240
  99.       Width           =   1635
  100.    End
  101.    Begin ListBox FontList 
  102.       Height          =   1395
  103.       Left            =   240
  104.       Sorted          =   -1  'True
  105.       TabIndex        =   0
  106.       Top             =   240
  107.       Width           =   3015
  108.    End
  109.    Begin Label Label4 
  110.       Alignment       =   1  'Right Justify
  111.       Caption         =   "Weight"
  112.       Height          =   315
  113.       Left            =   120
  114.       TabIndex        =   7
  115.       Top             =   2940
  116.       Width           =   1035
  117.    End
  118.    Begin Label Label3 
  119.       Alignment       =   1  'Right Justify
  120.       Caption         =   "Escapement"
  121.       Height          =   315
  122.       Left            =   60
  123.       TabIndex        =   5
  124.       Top             =   2580
  125.       Width           =   1155
  126.    End
  127.    Begin Label Label2 
  128.       Alignment       =   1  'Right Justify
  129.       Caption         =   "Width"
  130.       Height          =   255
  131.       Left            =   540
  132.       TabIndex        =   3
  133.       Top             =   2220
  134.       Width           =   675
  135.    End
  136.    Begin Label Label1 
  137.       Alignment       =   1  'Right Justify
  138.       Caption         =   "Height"
  139.       Height          =   255
  140.       Left            =   540
  141.       TabIndex        =   2
  142.       Top             =   1860
  143.       Width           =   675
  144.    End
  145.    Begin Label Label5 
  146.       Caption         =   "Sample Text"
  147.       Height          =   255
  148.       Left            =   4200
  149.       TabIndex        =   15
  150.       Top             =   1500
  151.       Width           =   1095
  152.    End
  153. End
  154.  
  155. ' Creates a logical font based on the various control
  156. ' settings. Then displays a sample string in that font.
  157. '
  158. Sub CmdShowFont_Click ()
  159.     Dim lf As LOGFONT
  160.     Dim oldhdc%
  161.     Dim rc As RECT
  162.     PicText.Cls
  163.     If FontToUse% <> 0 Then di% = DeleteObject(FontToUse%)
  164.     lf.lfHeight = Val(TxtHeight.Text)
  165.     lf.lfWidth = Val(TxtWidth.Text)
  166.     lf.lfEscapement = Val(TxtEscapement.Text)
  167.     lf.lfWeight = Val(TxtWeight.Text)
  168.     If (ChkItalic.Value = 1) Then lf.lfItalic = Chr$(1)
  169.     If (ChkUnderline.Value = 1) Then lf.lfUnderline = Chr$(1)
  170.     If (ChkStrikeout.Value = 1) Then lf.lfStrikeOut = Chr$(1)
  171.     lf.lfOutPrecision = Chr$(OUT_DEFAULT_PRECIS)
  172.     lf.lfClipPrecision = Chr$(OUT_DEFAULT_PRECIS)
  173.     lf.lfQuality = Chr$(DEFAULT_QUALITY)
  174.     lf.lfPitchAndFamily = Chr$(DEFAULT_PITCH Or FF_DONTCARE)
  175.     lf.lfCharSet = Chr$(DEFAULT_CHARSET)
  176.     lf.lfFaceName = FontList.Text + Chr$(0)
  177.     FontToUse% = CreateFontIndirect(lf)
  178.     If FontToUse% = 0 Then Exit Sub
  179.     oldhdc% = SelectObject(PicText.hDC, FontToUse%)
  180.  
  181.     ' Get the client rectangle in order to place the
  182.     ' text midway down the box
  183.     GetClientRect agGetControlHwnd(PicText), rc
  184.     di% = TextOut(PicText.hDC, 1, rc.bottom / 2, (TxtSample.Text), Len(TxtSample.Text))
  185.     di% = SelectObject(PicText.hDC, oldhdc%)
  186. End Sub
  187.  
  188. ' Display the text metrics for the physical font.
  189. '
  190. Sub CmdShowMetrics_Click ()
  191.     Dim tm As TEXTMETRIC
  192.     Dim r$
  193.     Dim crlf$
  194.     Dim oldfont%
  195.     Dim tbuf As String * 80
  196.     crlf$ = Chr$(13) + Chr$(10)
  197.     If FontToUse% = 0 Then
  198.         MsgBox "Font not yet selected"
  199.         Exit Sub
  200.     End If
  201.     oldfont% = SelectObject(PicText.hDC, FontToUse%)
  202.     di% = GetTextMetrics(PicText.hDC, tm)
  203.     di% = GetTextFace(PicText.hDC, 79, tbuf)
  204.     ' Add to r$ only the part up to the null terminator
  205.     r$ = "Facename = " + agGetStringFromLPSTR$(tbuf) + crlf$
  206.     If (Asc(tm.tmPitchAndFamily) And TMPF_TRUETYPE) <> 0 Then r$ = r$ + "... is a TrueType font" + crlf$
  207.     If (Asc(tm.tmPitchAndFamily) And TMPF_DEVICE) <> 0 Then r$ = r$ + "... is a Device font" + crlf$
  208.     ' Curiously enough, this bit is set for variable width fonts.
  209.     If (Asc(tm.tmPitchAndFamily) And TMPF_FIXED_PITCH) = 0 Then r$ = r$ + "... is a fixed pitch font" + crlf$
  210.     r$ = r$ + "Height=" + Str$(tm.tmHeight) + ", Ascent=" + Str$(tm.tmAscent) + ", Descent=" + Str$(tm.tmDescent) + crlf$
  211.     r$ = r$ + "Internal Leading=" + Str$(tm.tmInternalLeading) + ", External Leading=" + Str$(tm.tmExternalLeading) + crlf$
  212.     r$ = r$ + "Average char width=" + Str$(tm.tmAveCharWidth) + ", Max char width=" + Str$(tm.tmMaxCharWidth) + crlf$
  213.     r$ = r$ + "Weight=" + Str$(tm.tmWeight) + ", First char=" + Str$(Asc(tm.tmFirstChar)) + ", Last char=" + Str$(Asc(tm.tmLastChar)) + crlf$
  214.  
  215.     MsgBox r$, 0, "Physical Font Metrics"
  216.     di% = SelectObject(PicText.hDC, oldfont%)
  217. End Sub
  218.  
  219. '   Load the font list dialog box with the available fonts
  220. '
  221. Sub Form_Load ()
  222.     Dim x%
  223.     Dim a$
  224.     Screen.MousePointer = 11
  225.     For x% = 1 To Screen.FontCount
  226.         a$ = Screen.Fonts(x%)
  227.         If a$ <> "" Then FontList.AddItem a$
  228.     Next x%
  229.     Screen.MousePointer = 0
  230. End Sub
  231.  
  232. Sub Form_Unload (Cancel As Integer)
  233.     ' Be sure to clean up GDI objects when leaving the program
  234.     If FontToUse% <> 0 Then di% = DeleteObject(FontToUse%)
  235. End Sub
  236.  
  237.