home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 5 / MasteringVisualBasic5.iso / ch_code / ch12 / bldfont / bldfont.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-02-20  |  9.3 KB  |  307 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Fonts"
  4.    ClientHeight    =   7305
  5.    ClientLeft      =   5400
  6.    ClientTop       =   3960
  7.    ClientWidth     =   7305
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   7305
  10.    ScaleWidth      =   7305
  11.    Begin VB.TextBox Text2 
  12.       Height          =   285
  13.       Index           =   1
  14.       Left            =   5400
  15.       TabIndex        =   22
  16.       Text            =   "255"
  17.       Top             =   4680
  18.       Width           =   855
  19.    End
  20.    Begin VB.Frame Frame4 
  21.       Caption         =   "Font Color"
  22.       Height          =   1455
  23.       Left            =   4800
  24.       TabIndex        =   17
  25.       Top             =   3960
  26.       Width           =   2295
  27.       Begin VB.TextBox Text2 
  28.          Height          =   285
  29.          Index           =   2
  30.          Left            =   600
  31.          TabIndex        =   23
  32.          Text            =   "0"
  33.          Top             =   1080
  34.          Width           =   855
  35.       End
  36.       Begin VB.TextBox Text2 
  37.          Height          =   285
  38.          Index           =   0
  39.          Left            =   600
  40.          TabIndex        =   21
  41.          Text            =   "0"
  42.          Top             =   360
  43.          Width           =   855
  44.       End
  45.       Begin VB.Label Label6 
  46.          Caption         =   "B:"
  47.          Height          =   255
  48.          Left            =   120
  49.          TabIndex        =   20
  50.          Top             =   1080
  51.          Width           =   375
  52.       End
  53.       Begin VB.Label Label5 
  54.          Caption         =   "G:"
  55.          Height          =   255
  56.          Left            =   120
  57.          TabIndex        =   19
  58.          Top             =   720
  59.          Width           =   255
  60.       End
  61.       Begin VB.Label Label4 
  62.          Caption         =   "R:"
  63.          Height          =   255
  64.          Left            =   120
  65.          TabIndex        =   18
  66.          Top             =   360
  67.          Width           =   375
  68.       End
  69.    End
  70.    Begin VB.TextBox Text1 
  71.       Height          =   285
  72.       Index           =   2
  73.       Left            =   1080
  74.       TabIndex        =   16
  75.       Text            =   "20"
  76.       Top             =   6720
  77.       Width           =   1335
  78.    End
  79.    Begin VB.TextBox Text1 
  80.       Height          =   285
  81.       Index           =   1
  82.       Left            =   1080
  83.       TabIndex        =   15
  84.       Text            =   "50"
  85.       Top             =   6360
  86.       Width           =   1335
  87.    End
  88.    Begin VB.Frame Frame3 
  89.       Caption         =   "Font Attributes"
  90.       Height          =   1455
  91.       Left            =   240
  92.       TabIndex        =   10
  93.       Top             =   5640
  94.       Width           =   2415
  95.       Begin VB.TextBox Text1 
  96.          Height          =   285
  97.          Index           =   0
  98.          Left            =   840
  99.          TabIndex        =   14
  100.          Text            =   "300"
  101.          Top             =   360
  102.          Width           =   1335
  103.       End
  104.       Begin VB.Label Label3 
  105.          Caption         =   "Width:"
  106.          Height          =   255
  107.          Left            =   120
  108.          TabIndex        =   13
  109.          Top             =   1080
  110.          Width           =   615
  111.       End
  112.       Begin VB.Label Label2 
  113.          Caption         =   "Height:"
  114.          Height          =   255
  115.          Left            =   120
  116.          TabIndex        =   12
  117.          Top             =   720
  118.          Width           =   615
  119.       End
  120.       Begin VB.Label Label1 
  121.          Caption         =   "Weight:"
  122.          Height          =   255
  123.          Left            =   120
  124.          TabIndex        =   11
  125.          Top             =   360
  126.          Width           =   735
  127.       End
  128.    End
  129.    Begin VB.Frame Frame2 
  130.       Caption         =   "Font Style"
  131.       Height          =   1455
  132.       Left            =   2640
  133.       TabIndex        =   6
  134.       Top             =   3960
  135.       Width           =   1935
  136.       Begin VB.CheckBox Check3 
  137.          Caption         =   "Strikeout"
  138.          Height          =   255
  139.          Left            =   120
  140.          TabIndex        =   9
  141.          Top             =   1080
  142.          Width           =   1215
  143.       End
  144.       Begin VB.CheckBox Check2 
  145.          Caption         =   "Underline"
  146.          Height          =   255
  147.          Left            =   120
  148.          TabIndex        =   8
  149.          Top             =   720
  150.          Width           =   1215
  151.       End
  152.       Begin VB.CheckBox Check1 
  153.          Caption         =   "Italic"
  154.          Height          =   255
  155.          Left            =   120
  156.          TabIndex        =   7
  157.          Top             =   360
  158.          Width           =   1215
  159.       End
  160.    End
  161.    Begin VB.Frame Frame1 
  162.       Caption         =   "Font Name"
  163.       Height          =   1455
  164.       Left            =   240
  165.       TabIndex        =   2
  166.       Top             =   3960
  167.       Width           =   2055
  168.       Begin VB.OptionButton Option3 
  169.          Caption         =   "Courier New"
  170.          Height          =   255
  171.          Left            =   120
  172.          TabIndex        =   5
  173.          Top             =   1080
  174.          Width           =   1695
  175.       End
  176.       Begin VB.OptionButton Option2 
  177.          Caption         =   "Times New Roman"
  178.          Height          =   195
  179.          Left            =   120
  180.          TabIndex        =   4
  181.          Top             =   720
  182.          Width           =   1695
  183.       End
  184.       Begin VB.OptionButton Option1 
  185.          Caption         =   "Arial"
  186.          Height          =   255
  187.          Left            =   120
  188.          TabIndex        =   3
  189.          Top             =   360
  190.          Value           =   -1  'True
  191.          Width           =   1815
  192.       End
  193.    End
  194.    Begin VB.PictureBox Picture1 
  195.       Height          =   3615
  196.       Left            =   240
  197.       ScaleHeight     =   3555
  198.       ScaleWidth      =   6795
  199.       TabIndex        =   1
  200.       Top             =   120
  201.       Width           =   6855
  202.    End
  203.    Begin VB.CommandButton Command1 
  204.       Caption         =   "Show Font"
  205.       Height          =   495
  206.       Left            =   4200
  207.       TabIndex        =   0
  208.       Top             =   6480
  209.       Width           =   1575
  210.    End
  211. Attribute VB_Name = "Form1"
  212. Attribute VB_GlobalNameSpace = False
  213. Attribute VB_Creatable = False
  214. Attribute VB_PredeclaredId = True
  215. Attribute VB_Exposed = False
  216. Option Explicit
  217. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, _
  218.     ByVal crColor As Long) As Long
  219. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  220. Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" _
  221.     (lpLogFont As LOGFONT) As Long
  222. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
  223.     ByVal hObject As Long) As Long
  224. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, _
  225.     ByVal x As Long, ByVal y As Long, ByVal lpString As String, _
  226.     ByVal nCount As Long) As Long
  227.       
  228. Private Type RECT
  229.         Left As Long
  230.         Top As Long
  231.         Right As Long
  232.         Bottom As Long
  233. End Type
  234. Private Type LOGFONT
  235.         lfHeight As Long
  236.         lfWidth As Long
  237.         lfEscapement As Long
  238.         lfOrientation As Long
  239.         lfWeight As Long
  240.         lfItalic As Byte
  241.         lfUnderline As Byte
  242.         lfStrikeOut As Byte
  243.         lfCharSet As Byte
  244.         lfOutPrecision As Byte
  245.         lfClipPrecision As Byte
  246.         lfQuality As Byte
  247.         lfPitchAndFamily As Byte
  248.         lfFaceName As String * 50
  249. End Type
  250. Dim myLogFont As LOGFONT
  251. Private Sub Check1_Click()
  252.     'Italics
  253.     myLogFont.lfItalic = Check1.Value
  254.                 
  255. End Sub
  256. Private Sub Check2_Click()
  257.     'Italics
  258.     myLogFont.lfUnderline = Check2.Value
  259.                 
  260. End Sub
  261. Private Sub Check3_Click()
  262.     'Italics
  263.     myLogFont.lfStrikeOut = Check3.Value
  264.                 
  265. End Sub
  266. Private Sub Command1_Click()
  267.     Dim newFont As Long
  268.     Dim oldFont As Long
  269.     Dim retValue As Long
  270.     Dim fontStr As String
  271.     'Set weight, height, width
  272.     myLogFont.lfWeight = Val(Text1(0).Text)
  273.     myLogFont.lfHeight = Val(Text1(1).Text)
  274.     myLogFont.lfWidth = Val(Text1(2).Text)
  275.     myLogFont.lfEscapement = 0
  276.     Picture1.Cls
  277.     'Set color
  278.     retValue = SetTextColor(Picture1.hdc, RGB(Val(Text2(0).Text), Val(Text2(1).Text), Val(Text2(2).Text)))
  279.     'Select font
  280.     newFont = CreateFontIndirect(myLogFont)
  281.     oldFont = SelectObject(Picture1.hdc, newFont)
  282.     'Print font
  283.     fontStr = "Blah Blah Blah"
  284.     retValue = TextOut(Picture1.hdc, 0, 0, fontStr, Len(fontStr))
  285.     'Select old font back into DC
  286.     newFont = SelectObject(Picture1.hdc, oldFont)
  287.     retValue = DeleteObject(newFont)
  288. End Sub
  289. Private Sub Form_Load()
  290.     Picture1.ScaleMode = 3
  291. End Sub
  292. Private Sub Option1_Click()
  293.     If Option1.Value = True Then
  294.         myLogFont.lfFaceName = "Arial" + Chr$(0)
  295.     End If
  296. End Sub
  297. Private Sub Option2_Click()
  298.     If Option2.Value = True Then
  299.         myLogFont.lfFaceName = "Times New Roman" + Chr$(0)
  300.     End If
  301. End Sub
  302. Private Sub Option3_Click()
  303.     If Option3.Value = True Then
  304.         myLogFont.lfFaceName = "Courier New" + Chr$(0)
  305.     End If
  306. End Sub
  307.