home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples4 / ch11 / frmex11a.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  2.7 KB  |  79 lines
  1. VERSION 4.00
  2. Begin VB.Form frmEx11A 
  3.    Caption         =   "Chapter 11 Examples"
  4.    ClientHeight    =   2715
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1515
  7.    ClientWidth     =   4395
  8.    Height          =   3120
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   2715
  12.    ScaleWidth      =   4395
  13.    Top             =   1170
  14.    Width           =   4515
  15.    Begin VB.ListBox List1 
  16.       Height          =   1785
  17.       Left            =   120
  18.       TabIndex        =   2
  19.       Top             =   720
  20.       Width           =   2475
  21.    End
  22.    Begin VB.CommandButton cmdKerning 
  23.       Caption         =   "Kerning Pairs"
  24.       Height          =   435
  25.       Left            =   2700
  26.       TabIndex        =   1
  27.       Top             =   120
  28.       Width           =   1155
  29.    End
  30.    Begin VB.TextBox txtKern 
  31.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  32.          Name            =   "Arial"
  33.          Size            =   12
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   -1  'True
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   405
  41.       Left            =   120
  42.       TabIndex        =   0
  43.       Text            =   "Kerning for this font"
  44.       Top             =   120
  45.       Width           =   2475
  46.    End
  47. Attribute VB_Name = "frmEx11A"
  48. Attribute VB_Creatable = False
  49. Attribute VB_Exposed = False
  50. Option Explicit
  51. ' Copyright 
  52.  1997 by Desaware Inc. All Rights Reserved.
  53. Private Type KERNINGPAIR
  54.         wFirst As Integer
  55.         wSecond As Integer
  56.         iKernAmount As Long
  57. End Type
  58. Private Declare Function GetKerningPairs Lib "gdi32" Alias "GetKerningPairsA" (ByVal hdc As Long, ByVal cPairs As Long, lpkrnpair As KERNINGPAIR) As Long
  59. Private Declare Function GetKerningPairsBynum Lib "gdi32" Alias "GetKerningPairsA" (ByVal hdc As Long, ByVal cPairs As Long, ByVal lpkrnpair As Long) As Long
  60. Private Declare Function GetTextCharset Lib "gdi32" (ByVal hdc As Long) As Long
  61. Private Sub cmdKerning_Click()
  62.     Dim numpairs&
  63.     Dim dl&, x%
  64.     ' Cheap way to assign the text font to the form
  65.     ' then use the form device context.
  66.     frmEx11A.Font = txtKern.Font
  67.     ' Find out how many entries there are
  68.     numpairs = GetKerningPairsBynum(hdc, 0, 0)
  69.     ' Allocate the kerning pair structures
  70.     ReDim kp(numpairs) As KERNINGPAIR
  71.     dl = GetKerningPairs(hdc, numpairs, kp(1))
  72.     ' Display the results
  73.     For x = 1 To numpairs
  74.        list1.AddItem "Kerning " & Chr$(kp(x).wFirst) & " to " & Chr$(kp(x).wSecond) & " is " & kp(x).iKernAmount
  75.     Next x
  76. End Sub
  77. Private Sub Form_Load()
  78. End Sub
  79.