SampleCommon

Option Explicit

Public vColor
Public vScreenFont, vScreenFontSize
Public intOption As Integer
Const ErrCancel = 32755

'1: choose printer

Public Sub ChoosePrinter()
'

On Error GoTo ChoosePrinter_FAIL
'

With Me.CommonDialog1
.CancelError = True
.Flags = 64
'see the Help on Flags Properties (Print Dialog)

.ShowPrinter
.PrinterDefault = False
End With
Exit Sub
'

ChoosePrinter_FAIL:
If Err = ErrCancel Then Exit Sub Else Resume

End Sub

'2: choose font

Public Sub ChooseFont()
'

On Error GoTo ChooseFont_FAIL
'

With Me.CommonDialog1
.CancelError = True
.Flags = cdlCFScreenFonts
'see the Help on Flags Properties (Font Dialog)

.ShowFont
End With
'

vScreenFont = CommonDialog1.FontName
vScreenFontSize = CommonDialog1.FontSize
Call ChangeFont(Me)
Exit Sub
'

ChooseFont_FAIL:
If Err = ErrCancel Then Exit Sub Else Resume

End Sub

Public Sub ChangeFont(X As Form)
'

Dim Control
'

For Each Control In X.Controls
If TypeOf Control Is Label Or _
TypeOf Control Is TextBox Or _
TypeOf Control Is CommandButton Or _
TypeOf Control Is ComboBox Or _
TypeOf Control Is ListBox Or _
TypeOf Control Is CheckBox Or _
TypeOf Control Is OptionButton Then

Control.Font = vScreenFont
Control.FontSize = vScreenFontSize
End If
Next Control
'

End Sub
'3: choose color

Public Sub ChooseColor()
'

On Error GoTo ChooseColer_FAIL
'

With Me.CommonDialog1
.CancelError = True
.Flags = &H1& Or &H4&
'see the Help on Flags Properties (Color Dialog)

.ShowColor
End With
'

vColor = CommonDialog1.Color
Call ChangeColor(Me)
Exit Sub
'

ChooseColer_FAIL:
If Err = ErrCancel Then Exit Sub Else Resume

End Sub

Public Sub ChangeColor(X As Form)
'

Dim Control
'

X.BackColor = vColor
For Each Control In X.Controls
If TypeOf Control Is Label Or _
TypeOf Control Is TextBox Or _
TypeOf Control Is CommandButton Or _
TypeOf Control Is ComboBox Or _
TypeOf Control Is ListBox Or _
TypeOf Control Is CheckBox Then

Control.BackColor = vColor
End If
Next Control
'

End Sub
Public Sub FileCommonDialog(Index As Integer)
'

Dim nFile%
Dim vDummy$
'

On Error GoTo FileCommonDialog_FAIL
'

Select Case Index
Case 0 'open
With CommonDialog1
.CancelError = True
.Flags = cdlOFNCreatePrompt
.Action = 1
End With
Screen.MousePointer = vbHourglass
nFile% = FreeFile
Open CommonDialog1.filename For Input As #nFile
Do While Not EOF(nFile)
Line Input #nFile, vDummy
Text1.Text = Text1.Text & vDummy & vbCrLf
Loop
Close #nFile
Screen.MousePointer = vbNormal
Me.Command1.Caption = "&Save"
Case 1 'save as
With CommonDialog1
.CancelError = True
.Flags = cdlOFNPathMustExist & cdlOFNOverwritePrompt
.Action = 2
End With
Screen.MousePointer = vbHourglass
nFile% = FreeFile
Open CommonDialog1.filename For Output As #nFile
Print #nFile, Text1.Text
Close #nFile
Screen.MousePointer = vbNormal
'

With Me
.Command1.Caption = "&Go"
.Text1.Text = ""
.Option1(0).Value = True
End With
End Select
Exit Sub
'

FileCommonDialog_FAIL:
If Err = ErrCancel Then Exit Sub Else Resume
'

End Sub

Private Sub Command1_Click()
'

Select Case Me.Command1.Caption
Case "&Go"
Select Case intOption
Case 0
Call ChoosePrinter
Case 1
Call FileCommonDialog(0)
Case 2
Call ChooseColor
Case 3
Call ChooseFont
End Select
Case "&Save"
Call FileCommonDialog(1)
End Select
'

End Sub

Private Sub Form_Load()
'

With Me
.Caption = "CommonDialog Example"
.Command1.Caption = "&Go"
.Text1.Text = ""
.Option1(0).Value = True
End With
'

End Sub

Private Sub Option1_Click(Index As Integer)
'

intOption = Index
'

End Sub