home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch4 / FMetrics.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-02  |  3.3 KB  |  102 lines
  1. VERSION 5.00
  2. Begin VB.Form frmFMetrics 
  3.    Caption         =   "FMetrics"
  4.    ClientHeight    =   3195
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   5580
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3195
  10.    ScaleWidth      =   5580
  11.    StartUpPosition =   3  'Windows Default
  12. Attribute VB_Name = "frmFMetrics"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = False
  15. Attribute VB_PredeclaredId = True
  16. Attribute VB_Exposed = False
  17. Option Explicit
  18. Private Const SAMPLE_SIZE = 96
  19. Private Const LABEL_SIZE = 12
  20. Private Type TEXTMETRIC
  21.     tmHeight As Long
  22.     tmAscent As Long
  23.     tmDescent As Long
  24.     tmInternalLeading As Long
  25.     tmExternalLeading As Long
  26.     tmAveCharWidth As Long
  27.     tmMaxCharWidth As Long
  28.     tmWeight As Long
  29.     tmOverhang As Long
  30.     tmDigitizedAspectX As Long
  31.     tmDigitizedAspectY As Long
  32.     tmFirstChar As Byte
  33.     tmLastChar As Byte
  34.     tmDefaultChar As Byte
  35.     tmBreakChar As Byte
  36.     tmItalic As Byte
  37.     tmUnderlined As Byte
  38.     tmStruckOut As Byte
  39.     tmPitchAndFamily As Byte
  40.     tmCharSet As Byte
  41. End Type
  42. Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long
  43. ' Draw text with a box around it and showing
  44. ' different text metrics.
  45. Private Sub BoxText(ByVal X As Single, ByVal Y As Single, ByVal txt As String)
  46. Dim text_width As Single
  47. Dim text_height As Single
  48. Dim text_metrics As TEXTMETRIC
  49. Dim extra As Single
  50. Dim internal_leading As Single
  51. Dim descent As Single
  52. Dim ascent As Single
  53. Dim hgt As Single
  54.     ' Draw the text.
  55.     Font.Size = SAMPLE_SIZE
  56.     CurrentX = X
  57.     CurrentY = Y
  58.     Print txt
  59.     ' Get the text's size.
  60.     text_width = TextWidth(txt)
  61.     text_height = TextHeight(txt)
  62.     ' Draw a box around the text.
  63.     Line (X, Y)-Step(text_width, text_height), , B
  64.     ' Get the text metrics.
  65.     GetTextMetrics hdc, text_metrics
  66.     extra = X / 2
  67.     Font.Size = LABEL_SIZE
  68.     ' Draw a line at the internal leading.
  69.     internal_leading = ScaleY(text_metrics.tmInternalLeading, vbPixels, ScaleMode)
  70.     Line (X - extra, Y + internal_leading)-Step(text_width + 2 * extra, 0)
  71.     CurrentY = CurrentY - TextHeight("X") / 2
  72.     CurrentX = CurrentX + 30
  73.     Print "Internal leading"
  74.     ' Draw a line at the ascent.
  75.     ascent = ScaleY(text_metrics.tmAscent, vbPixels, ScaleMode)
  76.     Line (X - extra, Y + ascent)-Step(text_width + 2 * extra, 0)
  77.     CurrentY = CurrentY - TextHeight("X") / 2
  78.     CurrentX = CurrentX + 30
  79.     Print "Ascent"
  80.     ' Draw a line at the descent.
  81.     descent = ScaleY(text_metrics.tmDescent, vbPixels, ScaleMode)
  82.     Line (X - extra, Y + ascent + descent)-Step(text_width + 2 * extra, 0)
  83.     CurrentY = CurrentY - TextHeight("X") / 2
  84.     CurrentX = CurrentX + 30 + TextWidth("Height")
  85.     Print ", Ascent + Descent"
  86.     ' Draw a line at the height.
  87.     hgt = ScaleY(text_metrics.tmHeight, vbPixels, ScaleMode)
  88.     Line (X - extra, Y + hgt)-Step(text_width + 2 * extra, 0)
  89.     CurrentY = CurrentY - TextHeight("X") / 2
  90.     CurrentX = CurrentX + 30
  91.     Print "Height"
  92. End Sub
  93. Private Sub Form_Load()
  94.     ' Make the text permanent.
  95.     AutoRedraw = True
  96.     ' Select a big font.
  97.     Font.Name = "Times New Roman"
  98.     Font.Size = 96
  99.     ' Draw the text.
  100.     BoxText 240, 240, "Mg"
  101. End Sub
  102.