Private Sub Command1_Click()
On Error GoTo FontError
'CommonDialog1.Flags = 1
CommonDialog1.Flags = 1 + 256 + 65536
CommonDialog1.FontName = "Monotype Corsiva"
CommonDialog1.ShowFont
Label1.FontBold = CommonDialog1.FontBold
Label1.FontItalic = CommonDialog1.FontItalic
Label1.FontSize = CommonDialog1.FontSize
Label1.ForeColor = CommonDialog1.Color
Label1.Font = CommonDialog1.FontName
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
Text1.FontSize = CommonDialog1.FontSize
Text1.ForeColor = CommonDialog1.Color
Text1.Font = CommonDialog1.FontName
FontError:
If Err.Number = 32755 Then
MsgBox "Operation aborted by the user"
ElseIf Err.Number = 24574 Then
MsgBox "Please check one of the following flags: " & Chr$(10) & "cdlCFScreenFonts" & Chr$(10) & "cdlCFPrinterFonts" & Chr$(13) & "cdlCFBoth"
End If
End Sub
Private Sub Command2_Click()
CommonDialog1.ShowColor
Shape1.BorderColor = CommonDialog1.Color
End Sub
Private Sub Command3_Click()
On Error GoTo FileOpenError
If Text1.Text = "" Then
CommonDialog1.ShowOpen
Else: CommonDialog1.FileName = Text1.Text
CommonDialog1.ShowOpen
End If
'DefExt.Text = CommonDialog1.DefaultExt
'Filter.Text = CommonDialog1.Filter
'FilterIdx.Text = CommonDialog1.FilterIndex
'InitialDir.Text = CommonDialog1.InitDir
Label1.Caption = CommonDialog1.FileTitle
Text1.Text = CommonDialog1.FileName
FileOpenError:
If Err.Number = 32755 Then
MsgBox "Operation aborted by the user"
End If
If InStr(Label1.Caption, ".jpg") > 0 Then
Image1.Picture = LoadPicture(Text1.Text)
End If
End Sub