home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / glm2demo.exe / %MAINDIR% / CommonDialog / Font.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-06-10  |  22.7 KB  |  663 lines
  1. VERSION 5.00
  2. Begin VB.Form FontForm 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Font example"
  5.    ClientHeight    =   6105
  6.    ClientLeft      =   45
  7.    ClientTop       =   345
  8.    ClientWidth     =   9615
  9.    FillStyle       =   0  'Solid
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   6105
  14.    ScaleWidth      =   9615
  15.    ShowInTaskbar   =   0   'False
  16.    Begin VB.CommandButton ShowFontBut 
  17.       Caption         =   "&Show Dialog!"
  18.       BeginProperty Font 
  19.          Name            =   "MS Sans Serif"
  20.          Size            =   13.5
  21.          Charset         =   0
  22.          Weight          =   700
  23.          Underline       =   0   'False
  24.          Italic          =   0   'False
  25.          Strikethrough   =   0   'False
  26.       EndProperty
  27.       Height          =   840
  28.       Left            =   6960
  29.       TabIndex        =   35
  30.       Top             =   240
  31.       Width           =   2535
  32.    End
  33.    Begin VB.ListBox List1 
  34.       Height          =   4155
  35.       ItemData        =   "Font.frx":0000
  36.       Left            =   4560
  37.       List            =   "Font.frx":0046
  38.       MultiSelect     =   1  'Simple
  39.       TabIndex        =   45
  40.       Top             =   360
  41.       Width           =   2295
  42.    End
  43.    Begin VB.Frame Frame4 
  44.       Caption         =   "OK and Cancel Button Options"
  45.       BeginProperty Font 
  46.          Name            =   "MS Sans Serif"
  47.          Size            =   8.25
  48.          Charset         =   0
  49.          Weight          =   700
  50.          Underline       =   0   'False
  51.          Italic          =   0   'False
  52.          Strikethrough   =   0   'False
  53.       EndProperty
  54.       Height          =   1485
  55.       Left            =   120
  56.       TabIndex        =   44
  57.       Top             =   120
  58.       Width           =   4215
  59.       Begin VB.CheckBox CustomCancelCaptionCheck 
  60.          Caption         =   "Change &Cancel Button Caption"
  61.          Height          =   285
  62.          Left            =   120
  63.          TabIndex        =   4
  64.          Top             =   990
  65.          Width           =   2865
  66.       End
  67.       Begin VB.TextBox CustomCancelCaptionText 
  68.          Height          =   345
  69.          Left            =   3060
  70.          TabIndex        =   5
  71.          Text            =   "E&xit"
  72.          Top             =   990
  73.          Width           =   945
  74.       End
  75.       Begin VB.TextBox CustomButtonCaptionText 
  76.          Height          =   345
  77.          Left            =   3060
  78.          TabIndex        =   3
  79.          Text            =   "&Select"
  80.          Top             =   570
  81.          Width           =   945
  82.       End
  83.       Begin VB.CheckBox CustomButtonCaptionCheck 
  84.          Caption         =   "Change &OK Button Caption"
  85.          Height          =   285
  86.          Left            =   120
  87.          TabIndex        =   2
  88.          Top             =   600
  89.          Width           =   2865
  90.       End
  91.       Begin VB.CheckBox HideCancelCheck 
  92.          Caption         =   "Hide Cancel B&utton"
  93.          Height          =   285
  94.          Left            =   120
  95.          TabIndex        =   0
  96.          Top             =   240
  97.          Width           =   1845
  98.       End
  99.       Begin VB.CheckBox CancelErrorCheck 
  100.          Caption         =   "&Raise Error On Cancel"
  101.          Height          =   285
  102.          Left            =   2130
  103.          TabIndex        =   1
  104.          Top             =   240
  105.          Width           =   1905
  106.       End
  107.    End
  108.    Begin VB.Frame Frame7 
  109.       Caption         =   "Results"
  110.       BeginProperty Font 
  111.          Name            =   "MS Sans Serif"
  112.          Size            =   13.5
  113.          Charset         =   0
  114.          Weight          =   700
  115.          Underline       =   0   'False
  116.          Italic          =   0   'False
  117.          Strikethrough   =   0   'False
  118.       EndProperty
  119.       Height          =   4545
  120.       Left            =   6960
  121.       TabIndex        =   38
  122.       Top             =   1200
  123.       Width           =   2535
  124.       Begin VB.TextBox SampleFontText 
  125.          Height          =   1305
  126.          Left            =   120
  127.          TabIndex        =   46
  128.          Text            =   "AaBbZzYy1234567890"
  129.          Top             =   3120
  130.          Width           =   2295
  131.       End
  132.       Begin VB.TextBox FontColorText 
  133.          Height          =   315
  134.          Left            =   1110
  135.          Locked          =   -1  'True
  136.          TabIndex        =   17
  137.          Text            =   "&H0"
  138.          Top             =   450
  139.          Width           =   885
  140.       End
  141.       Begin VB.TextBox FontStyleNameText 
  142.          Enabled         =   0   'False
  143.          Height          =   315
  144.          Left            =   1110
  145.          Locked          =   -1  'True
  146.          TabIndex        =   20
  147.          Top             =   1560
  148.          Width           =   1305
  149.       End
  150.       Begin VB.TextBox FontSizeText 
  151.          Enabled         =   0   'False
  152.          Height          =   315
  153.          Left            =   1110
  154.          Locked          =   -1  'True
  155.          TabIndex        =   19
  156.          Top             =   1200
  157.          Width           =   1305
  158.       End
  159.       Begin VB.TextBox FontNameText 
  160.          Enabled         =   0   'False
  161.          Height          =   315
  162.          Left            =   1110
  163.          Locked          =   -1  'True
  164.          TabIndex        =   18
  165.          Top             =   840
  166.          Width           =   1305
  167.       End
  168.       Begin VB.CheckBox BoldCheck 
  169.          Caption         =   "&Bold"
  170.          Height          =   255
  171.          Left            =   120
  172.          TabIndex        =   21
  173.          Top             =   2070
  174.          Width           =   705
  175.       End
  176.       Begin VB.CheckBox StrikeThruCheck 
  177.          Caption         =   "Strike&Thru"
  178.          Height          =   255
  179.          Left            =   1110
  180.          TabIndex        =   24
  181.          Top             =   2430
  182.          Width           =   1095
  183.       End
  184.       Begin VB.CheckBox UnderLineCheck 
  185.          Caption         =   "Under&line"
  186.          Height          =   255
  187.          Left            =   1110
  188.          TabIndex        =   23
  189.          Top             =   2070
  190.          Width           =   1095
  191.       End
  192.       Begin VB.CheckBox ItalicCheck 
  193.          Caption         =   "&Italic"
  194.          Height          =   255
  195.          Left            =   120
  196.          TabIndex        =   22
  197.          Top             =   2430
  198.          Width           =   705
  199.       End
  200.       Begin VB.PictureBox FontColorPic 
  201.          BackColor       =   &H00000000&
  202.          FillColor       =   &H00FFFFFF&
  203.          Height          =   315
  204.          Left            =   2040
  205.          ScaleHeight     =   255
  206.          ScaleWidth      =   315
  207.          TabIndex        =   40
  208.          Top             =   450
  209.          Width           =   375
  210.       End
  211.       Begin VB.Label Label9 
  212.          AutoSize        =   -1  'True
  213.          Caption         =   "Sample:"
  214.          BeginProperty Font 
  215.             Name            =   "MS Sans Serif"
  216.             Size            =   8.25
  217.             Charset         =   0
  218.             Weight          =   700
  219.             Underline       =   0   'False
  220.             Italic          =   0   'False
  221.             Strikethrough   =   0   'False
  222.          EndProperty
  223.          Height          =   195
  224.          Left            =   120
  225.          TabIndex        =   48
  226.          Top             =   2880
  227.          Width           =   690
  228.       End
  229.       Begin VB.Label Label20 
  230.          AutoSize        =   -1  'True
  231.          Caption         =   "Style Name"
  232.          Height          =   195
  233.          Left            =   120
  234.          TabIndex        =   43
  235.          Top             =   1620
  236.          Width           =   810
  237.       End
  238.       Begin VB.Label Label10 
  239.          AutoSize        =   -1  'True
  240.          Caption         =   "Size"
  241.          Height          =   195
  242.          Left            =   120
  243.          TabIndex        =   42
  244.          Top             =   1260
  245.          Width           =   300
  246.       End
  247.       Begin VB.Label Label5 
  248.          AutoSize        =   -1  'True
  249.          Caption         =   "Name"
  250.          Height          =   195
  251.          Left            =   120
  252.          TabIndex        =   41
  253.          Top             =   870
  254.          Width           =   420
  255.       End
  256.       Begin VB.Label Label3 
  257.          AutoSize        =   -1  'True
  258.          Caption         =   "Color Value"
  259.          Height          =   195
  260.          Left            =   120
  261.          TabIndex        =   39
  262.          Top             =   510
  263.          Width           =   810
  264.       End
  265.    End
  266.    Begin VB.Frame Frame6 
  267.       Caption         =   "Help Options"
  268.       BeginProperty Font 
  269.          Name            =   "MS Sans Serif"
  270.          Size            =   8.25
  271.          Charset         =   0
  272.          Weight          =   700
  273.          Underline       =   0   'False
  274.          Italic          =   0   'False
  275.          Strikethrough   =   0   'False
  276.       EndProperty
  277.       Height          =   1455
  278.       Index           =   1
  279.       Left            =   120
  280.       TabIndex        =   25
  281.       Top             =   4560
  282.       Width           =   6735
  283.       Begin VB.OptionButton HelpContextOpt 
  284.          Caption         =   "Help Co&ntext"
  285.          Height          =   255
  286.          Left            =   180
  287.          TabIndex        =   29
  288.          Top             =   660
  289.          Value           =   -1  'True
  290.          Width           =   1245
  291.       End
  292.       Begin VB.TextBox HelpFileText 
  293.          Height          =   315
  294.          Left            =   1410
  295.          TabIndex        =   27
  296.          Top             =   210
  297.          Width           =   4125
  298.       End
  299.       Begin VB.OptionButton HelpKeyOpt 
  300.          Caption         =   "Help &Key"
  301.          Height          =   255
  302.          Left            =   180
  303.          TabIndex        =   32
  304.          Top             =   1080
  305.          Width           =   1245
  306.       End
  307.       Begin VB.TextBox HelpContextNumberText 
  308.          Height          =   315
  309.          Left            =   2880
  310.          TabIndex        =   31
  311.          Top             =   630
  312.          Width           =   1005
  313.       End
  314.       Begin VB.TextBox HelpKeyText 
  315.          Height          =   315
  316.          Left            =   2880
  317.          TabIndex        =   34
  318.          Top             =   1050
  319.          Width           =   1005
  320.       End
  321.       Begin VB.CommandButton Browse 
  322.          Caption         =   "Bro&wse..."
  323.          Height          =   375
  324.          Left            =   5640
  325.          TabIndex        =   28
  326.          Top             =   200
  327.          Width           =   975
  328.       End
  329.       Begin VB.Label Label6 
  330.          Caption         =   "&Help File Name"
  331.          Height          =   255
  332.          Left            =   150
  333.          TabIndex        =   26
  334.          Top             =   270
  335.          Width           =   1155
  336.       End
  337.       Begin VB.Label Label7 
  338.          Caption         =   "Context Number"
  339.          Height          =   255
  340.          Left            =   1620
  341.          TabIndex        =   30
  342.          Top             =   690
  343.          Width           =   1155
  344.       End
  345.       Begin VB.Label Label8 
  346.          Caption         =   "Help Key Word"
  347.          Height          =   255
  348.          Left            =   1620
  349.          TabIndex        =   33
  350.          Top             =   1110
  351.          Width           =   1155
  352.       End
  353.    End
  354.    Begin VB.Frame Frame3 
  355.       Caption         =   "Dialog Box Position"
  356.       BeginProperty Font 
  357.          Name            =   "MS Sans Serif"
  358.          Size            =   8.25
  359.          Charset         =   0
  360.          Weight          =   700
  361.          Underline       =   0   'False
  362.          Italic          =   0   'False
  363.          Strikethrough   =   0   'False
  364.       EndProperty
  365.       Height          =   1455
  366.       Left            =   120
  367.       TabIndex        =   37
  368.       Top             =   1680
  369.       Width           =   4215
  370.       Begin VB.CheckBox SetDlgPosCheck 
  371.          Caption         =   "Set &Dialog Position"
  372.          Height          =   285
  373.          Left            =   120
  374.          TabIndex        =   6
  375.          Top             =   240
  376.          Width           =   1845
  377.       End
  378.       Begin VB.CheckBox SetDlgPosToScreenCheck 
  379.          Caption         =   "Set Dialog &Position Relative To Screen"
  380.          Height          =   285
  381.          Left            =   360
  382.          TabIndex        =   7
  383.          Top             =   630
  384.          Width           =   3075
  385.       End
  386.       Begin VB.TextBox XPosText 
  387.          Height          =   345
  388.          Left            =   1380
  389.          TabIndex        =   9
  390.          Text            =   "0"
  391.          Top             =   990
  392.          Width           =   555
  393.       End
  394.       Begin VB.TextBox YPosText 
  395.          Height          =   345
  396.          Left            =   2880
  397.          TabIndex        =   11
  398.          Text            =   "0"
  399.          Top             =   990
  400.          Width           =   555
  401.       End
  402.       Begin VB.Label Label1 
  403.          Caption         =   "&X Position"
  404.          Height          =   225
  405.          Left            =   540
  406.          TabIndex        =   8
  407.          Top             =   1050
  408.          Width           =   765
  409.       End
  410.       Begin VB.Label Label2 
  411.          Caption         =   "&Y Position"
  412.          Height          =   225
  413.          Left            =   2040
  414.          TabIndex        =   10
  415.          Top             =   1080
  416.          Width           =   735
  417.       End
  418.    End
  419.    Begin VB.Frame Frame2 
  420.       Caption         =   "Other Options"
  421.       BeginProperty Font 
  422.          Name            =   "MS Sans Serif"
  423.          Size            =   8.25
  424.          Charset         =   0
  425.          Weight          =   700
  426.          Underline       =   0   'False
  427.          Italic          =   0   'False
  428.          Strikethrough   =   0   'False
  429.       EndProperty
  430.       Height          =   1335
  431.       Index           =   0
  432.       Left            =   120
  433.       TabIndex        =   36
  434.       Top             =   3210
  435.       Width           =   4215
  436.       Begin VB.CheckBox RaiseEventCheck 
  437.          Caption         =   "Raise Callback &Event"
  438.          Height          =   285
  439.          Left            =   120
  440.          TabIndex        =   16
  441.          Top             =   960
  442.          Width           =   1875
  443.       End
  444.       Begin VB.CheckBox ChangeSampleCheck 
  445.          Caption         =   "Change ""Sample"" Text"
  446.          Height          =   285
  447.          Left            =   120
  448.          TabIndex        =   14
  449.          Top             =   630
  450.          Width           =   1965
  451.       End
  452.       Begin VB.TextBox SampleText 
  453.          Height          =   315
  454.          Left            =   2130
  455.          TabIndex        =   15
  456.          Text            =   "1234AaDd"
  457.          Top             =   630
  458.          Width           =   1965
  459.       End
  460.       Begin VB.TextBox FontCaptionText 
  461.          Height          =   315
  462.          Left            =   1590
  463.          TabIndex        =   13
  464.          Text            =   "Font"
  465.          Top             =   240
  466.          Width           =   2505
  467.       End
  468.       Begin VB.Label Label22 
  469.          Caption         =   "Di&alog Box Caption"
  470.          Height          =   255
  471.          Left            =   120
  472.          TabIndex        =   12
  473.          Top             =   270
  474.          Width           =   1455
  475.       End
  476.    End
  477.    Begin VB.Label Label4 
  478.       AutoSize        =   -1  'True
  479.       Caption         =   "Flags:"
  480.       BeginProperty Font 
  481.          Name            =   "MS Sans Serif"
  482.          Size            =   8.25
  483.          Charset         =   0
  484.          Weight          =   700
  485.          Underline       =   0   'False
  486.          Italic          =   0   'False
  487.          Strikethrough   =   0   'False
  488.       EndProperty
  489.       Height          =   195
  490.       Left            =   4560
  491.       TabIndex        =   47
  492.       Top             =   120
  493.       Width           =   525
  494.    End
  495. Attribute VB_Name = "FontForm"
  496. Attribute VB_GlobalNameSpace = False
  497. Attribute VB_Creatable = False
  498. Attribute VB_PredeclaredId = True
  499. Attribute VB_Exposed = False
  500. Option Explicit
  501. Dim WithEvents dwCmdDialog As dwFont
  502. Attribute dwCmdDialog.VB_VarHelpID = -1
  503. Private Sub Browse_Click()
  504. Dim dwCmdDialog As dwFileOpenSave
  505. Dim lres As Long
  506. Dim lstr As String
  507.     Set dwCmdDialog = New dwFileOpenSave
  508.     dwCmdDialog.DialogTitle = "Select Help File"
  509.     dwCmdDialog.Filter = "Help (*.hlp)|*.hlp|All Files (*.*)|*.*"
  510.     dwCmdDialog.DlgWindowOwner = Me.hWnd
  511.     dwCmdDialog.SetDialogPosition = True
  512.     dwCmdDialog.PosX = 50
  513.     dwCmdDialog.PosY = 50
  514.     dwCmdDialog.CustomOkButtonCaption = True
  515.     dwCmdDialog.OkButtonCaption = "Select"
  516.     dwCmdDialog.Flags = glmcdOFNEnableHook Or glmcdOFNLongNames Or glmcdOFNFileMustexist Or glmcdOFNNoChangeDir Or glmcdOFNHideReadOnly
  517.     If WindowsVersion <> 35 Then
  518.         dwCmdDialog.Flags = dwCmdDialog.Flags Or glmcdOFNExplorer
  519.     End If
  520.     lres = dwCmdDialog.ShowOpen
  521.     If lres = 1 Then
  522.         HelpFileText.Text = dwCmdDialog.filename
  523.     End If
  524.     Set dwCmdDialog = Nothing
  525. End Sub
  526. Private Sub Form_Load()
  527.     If SetDlgPosCheck.Value Then
  528.         SetDlgPosToScreenCheck.Enabled = True
  529.         XPosText.Enabled = True
  530.         YPosText.Enabled = True
  531.     Else
  532.         SetDlgPosToScreenCheck.Enabled = False
  533.         XPosText.Enabled = False
  534.         YPosText.Enabled = False
  535.     End If
  536.     ' Initialize list box
  537.     List1.Selected(0) = True    ' use screen fonts
  538.     List1.Selected(1) = True    ' use printer fonts
  539.     List1.Selected(2) = True    ' show help button
  540.     List1.Selected(3) = True    ' enable hook
  541.     List1.Selected(7) = True    ' use style
  542.     List1.Selected(8) = True    ' show effects
  543.     If HelpContextOpt.Value Then
  544.         HelpContextNumberText.Enabled = True
  545.         HelpKeyText.Enabled = False
  546.         HelpKeyText.Text = ""
  547.     Else
  548.         HelpKeyText.Enabled = True
  549.         HelpContextNumberText.Enabled = False
  550.         HelpContextNumberText.Text = ""
  551.     End If
  552. End Sub
  553. Private Sub HelpContextOpt_Click()
  554.     HelpContextNumberText.Enabled = True
  555.     HelpKeyText.Enabled = False
  556.     HelpKeyText.Text = ""
  557. End Sub
  558. Private Sub HelpKeyOpt_Click()
  559.     HelpKeyText.Enabled = True
  560.     HelpContextNumberText.Enabled = False
  561.     HelpContextNumberText.Text = ""
  562. End Sub
  563. Private Sub SetDlgPosCheck_Click()
  564.     If SetDlgPosCheck.Value Then
  565.         SetDlgPosToScreenCheck.Enabled = True
  566.         XPosText.Enabled = True
  567.         YPosText.Enabled = True
  568.     Else
  569.         SetDlgPosToScreenCheck.Enabled = False
  570.         XPosText.Enabled = False
  571.         YPosText.Enabled = False
  572.     End If
  573. End Sub
  574. Private Sub ShowFontBut_Click()
  575. Dim lres As Long
  576. Dim lstr As String, fcolor As String
  577.     Set dwCmdDialog = New dwFont
  578.     dwCmdDialog.DialogTitle = FontCaptionText.Text
  579.     '** Note, you can set the owner to 0, which would make the dialog
  580.     '** a child of the desktop. This makes it a psuedo-modeless dialog.
  581.     dwCmdDialog.DlgWindowOwner = Me.hWnd
  582.     dwCmdDialog.HideCancel = HideCancelCheck.Value
  583.     dwCmdDialog.SetDialogPosition = SetDlgPosCheck.Value
  584.     dwCmdDialog.SetDialogRelativeToScreen = SetDlgPosToScreenCheck.Value
  585.     dwCmdDialog.PosX = Val(XPosText.Text)
  586.     dwCmdDialog.PosY = Val(YPosText.Text)
  587.     dwCmdDialog.CustomOkButtonCaption = CustomButtonCaptionCheck.Value
  588.     dwCmdDialog.OkButtonCaption = CustomButtonCaptionText.Text
  589.     dwCmdDialog.CustomCancelButtonCaption = CustomCancelCaptionCheck.Value
  590.     dwCmdDialog.CancelButtonCaption = CustomCancelCaptionText.Text
  591.     dwCmdDialog.Flags = GetFontFlags()
  592.     dwCmdDialog.RaiseCallbackEvent = RaiseEventCheck.Value
  593.     dwCmdDialog.CancelError = CancelErrorCheck.Value
  594.     dwCmdDialog.CustomSampleText = ChangeSampleCheck.Value
  595.     dwCmdDialog.SampleText = SampleText.Text
  596.     dwCmdDialog.HelpFile = Trim$(HelpFileText.Text)
  597.     If dwCmdDialog.HelpFile <> "" Then
  598.         If HelpContextOpt.Value Then
  599.             dwCmdDialog.HelpCommand = glmcdHCContext
  600.             dwCmdDialog.HelpContext = Val(HelpContextNumberText.Text)
  601.         Else
  602.             dwCmdDialog.HelpCommand = glmcdHCKey
  603.             dwCmdDialog.HelpKey = HelpKeyText.Text
  604.         End If
  605.     End If
  606.     fcolor = Trim$(FontColorText.Text)
  607.     If Right$(fcolor, 1) <> "&" Then fcolor = fcolor & "&"
  608.     dwCmdDialog.Color = Val(fcolor)
  609.     dwCmdDialog.FontName = FontNameText.Text
  610.     dwCmdDialog.FontSize = Val(FontSizeText.Text)
  611.     dwCmdDialog.FontStyleName = FontStyleNameText.Text
  612.     dwCmdDialog.FontBold = BoldCheck.Value
  613.     dwCmdDialog.FontItalic = ItalicCheck.Value
  614.     dwCmdDialog.FontUnderline = UnderLineCheck.Value
  615.     dwCmdDialog.FontStrikethru = StrikeThruCheck.Value
  616.     On Error GoTo dlgerror
  617.     lres = dwCmdDialog.ShowFont
  618.     On Error GoTo 0
  619.     If lres = 1 Then
  620.         FontColorPic.BackColor = dwCmdDialog.Color
  621.         FontColorText.Text = "&H" & Hex$(dwCmdDialog.Color)
  622.         FontNameText.Text = dwCmdDialog.FontName
  623.         FontSizeText.Text = dwCmdDialog.FontSize
  624.         If dwCmdDialog.FontUnderline Then UnderLineCheck.Value = vbChecked Else UnderLineCheck.Value = vbUnchecked
  625.         If dwCmdDialog.FontStrikethru Then StrikeThruCheck.Value = vbChecked Else StrikeThruCheck.Value = vbUnchecked
  626.         If dwCmdDialog.FontBold Then BoldCheck.Value = vbChecked Else BoldCheck.Value = vbUnchecked
  627.         If dwCmdDialog.FontItalic Then ItalicCheck.Value = vbChecked Else ItalicCheck.Value = vbUnchecked
  628.         FontStyleNameText.Text = dwCmdDialog.FontStyleName
  629.         SampleFontText.ForeColor = dwCmdDialog.Color
  630.         
  631.         ' Used to avoid error caused by trying to set FontName to a
  632.         ' printer font.
  633.         On Error Resume Next
  634.         SampleFontText.FontName = dwCmdDialog.FontName
  635.         On Error GoTo 0
  636.         
  637.         SampleFontText.FontSize = dwCmdDialog.FontSize
  638.         SampleFontText.FontUnderline = dwCmdDialog.FontUnderline
  639.         SampleFontText.FontStrikethru = dwCmdDialog.FontStrikethru
  640.         SampleFontText.FontBold = dwCmdDialog.FontBold
  641.         SampleFontText.FontItalic = dwCmdDialog.FontItalic
  642.     End If
  643.        
  644.     Set dwCmdDialog = Nothing
  645.     Exit Sub
  646. dlgerror:
  647. Debug.Print Err.Description
  648.     MsgBox "Error &H" & Hex$(Err.Number) & " occurred, " & Err.Description, vbOKOnly, "Font dialog error"
  649.     Set dwCmdDialog = Nothing
  650.     Exit Sub
  651. End Sub
  652. Private Function GetFontFlags() As Long
  653. Dim lcount As Long, lindex As Long
  654. Dim flagvalue As Long
  655.     lindex = List1.ListCount
  656.     For lcount = 0 To lindex - 1 Step 1
  657.         If List1.Selected(lcount) Then
  658.             flagvalue = flagvalue + 2 ^ lcount
  659.         End If
  660.     Next
  661.     GetFontFlags = flagvalue
  662. End Function
  663.