大家在写程序的时候，难免会用到ＷＩＮＤＯＷＳ的通用对话框，如打开、保存、字体、颜色、打印等。这些通用对话框在外部控件里可以加载，不过打包的时候还要带上控件，所以会很麻烦，并且会加大安装程序的大小。笔者通过实践，总结出了通过ＡＰＩ实现这些对话框的方法，写出来与大家分享。
崔占民
EMAIL:[email protected]
定义一个类模块，方法：工程－>添加类模块。代码如下：
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type PRINTDLG
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
Flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As String
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 31
End Type
Private Type CHOOSEFONT
lStructSize As Long
hwndOwner As Long ' caller's window handle
hdc As Long ' printer DC/IC or NULL
lpLogFont As Long
iPointSize As Long ' 10 * size in points of selected font
Flags As Long ' enum. type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle of.EXE that
' contains cust. dlg. template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the EnumFonts
' call back with the extra FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type
Private Type FINDREPLACE
lStructSize As Long ' size of this struct 0x20
hwndOwner As Long ' handle to owner's window
hInstance As Long ' instance handle of.EXE that
' contains cust. dlg. template
Flags As Long ' one or more of the FR_??
lpstrFindWhat As String ' ptr. to search string
lpstrReplaceWith As String ' ptr. to replace string
wFindWhatLen As Integer ' size of find buffer
wReplaceWithLen As Integer ' size of replace buffer
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook fn. or NULL
lpTemplateName As String ' custom template name
End Type
Private Type PAGESETUPDLG
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
Flags As Long
ptPaperSize As POINTAPI
rtMinMargin As RECT
rtMargin As RECT
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As String
hPageSetupTemplate As Long
End Type
Public Enum FileFlags
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EXPLORER = &H80000 ' new look commdlg
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000 ' force long names for 3.x modules
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
PD_ALLPAGES = &H0
PD_COLLATE = &H10
PD_DISABLEPRINTTOFILE = &H80000
PD_ENABLEPRINTHOOK = &H1000
PD_ENABLEPRINTTEMPLATE = &H4000
PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
PD_ENABLESETUPHOOK = &H2000
PD_ENABLESETUPTEMPLATE = &H8000
PD_ENABLESETUPTEMPLATEHANDLE = &H20000
PD_HIDEPRINTTOFILE = &H100000
PD_NONETWORKBUTTON = &H200000
PD_NOPAGENUMS = &H8
PD_NOSELECTION = &H4
PD_NOWARNING = &H80
PD_PAGENUMS = &H2
PD_PRINTSETUP = &H40
PD_PRINTTOFILE = &H20
PD_RETURNDC = &H100
PD_RETURNDEFAULT = &H400
PD_RETURNIC = &H200
PD_SELECTION = &H1
PD_SHOWHELP = &H800
PD_USEDEVMODECOPIES = &H40000
PD_USEDEVMODECOPIESANDCOLLATE = &H40000
End Enum
Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) As Long
Private Declare Function ChooseColorDialog Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA " (pFindreplace As FINDREPLACE) As Long
Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Function ReplaceText Lib "comdlg32.dll" Alias "ReplaceTextA" (pFindreplace As FINDREPLACE) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
' FileOpen 类成员变量 =====================================================
Private m_lngHwnd As Long
Private m_lngInstance As Long
Private m_strFileName As String
Private m_strFileTitle As String
Private m_strInitDir As String
Private m_strDialogTitle As String
Private m_strFilter As String
Private m_lngFlags As Long
' Print 类成员变量 =====================================================
Private m_lngCopies As Long
Private m_lngFromPage As Long
Private m_lngToPage As Long
Private m_lngMaxPage As Long
Private m_lngMinPage As Long
' Print 类成员变量 =====================================================
Private m_lngColor As Long
' Font 类成员变量 =====================================================
Private m_strFontName As String
Private m_lngFontColor As Long
Private m_lngFontSize As Long
Private m_lngCharSet As Long
Private m_bolItalic As Boolean
Private m_bolStrikeOut As Boolean
Private m_bolUnderline As Boolean
Private m_bolBlob As Boolean
' PageSetup 类成员变量 =====================================================
Private m_lngPaperWidth As Long
Private m_lngPaperHeight As Long
Private m_lngMarginLeft As Long
Private m_lngMarginTop As Long
Private m_lngMarginRight As Long
Private m_lngMarginBottom As Long
' FileOpen 类实现 =========================================================
Public Function ShowOpen() As Boolean
Dim fName As String, sName As String, OfName As OPENFILENAME
OfName.lStructSize = Len(OfName)
OfName.hwndOwner = m_lngHwnd
OfName.hInstance = m_lngInstance
OfName.lpstrInitialDir = m_strInitDir
OfName.lpstrFilter = m_strFilter
OfName.lpstrFile = Space(255) & Chr(0)
OfName.nMaxFile = 256
OfName.lpstrFileTitle = Space(255) & Chr(0)
OfName.nMaxFileTitle = 256
OfName.lpstrTitle = m_strDialogTitle
OfName.Flags = m_lngFlags
If GetOpenFileName(OfName) Then
m_strFileName = OfName.lpstrFile
m_strFileTitle = OfName.lpstrFileTitle
ShowOpen = True
Else
ShowOpen = False
End If
End Function
Public Property Get Filter() As String
Filter = m_strFilter
End Property
Public Property Let Filter(ByVal vNewValue As String)
m_strFilter = Replace(vNewValue, "|", Chr(0)) & Chr(0)
End Property
Public Property Get Flags() As FileFlags
Flags = m_lngFlags
End Property
Public Property Let Flags(ByVal vNewValue As FileFlags)
m_lngFlags = vNewValue
End Property
Public Property Get DialogTitle() As String
DialogTitle = m_strDialogTitle
End Property
Public Property Let DialogTitle(ByVal vNewValue As String)
m_strDialogTitle = vNewValue
End Property
Public Property Get InitDir() As String
InitDir = m_strInitDir
End Property
Public Property Let InitDir(ByVal vNewValue As String)
m_strInitDir = vNewValue
End Property
Public Property Get FileTitle() As String
FileTitle = m_strFileTitle
End Property
Public Property Let FileTitle(ByVal vNewValue As String)
m_strFileTitle = vNewValue
End Property
Public Property Get FileName() As String
FileName = m_strFileName
End Property
Public Property Let FileName(ByVal vNewValue As String)
m_strFileName = vNewValue
End Property
Public Property Get Hwnd() As Long
Hwnd = m_lngHwnd
End Property
Public Property Let Hwnd(ByVal vNewValue As Long)
m_lngHwnd = vNewValue
End Property
Public Property Get Instance() As Long
Instance = m_lngInstance
End Property
Public Property Let Instance(ByVal vNewValue As Long)
m_lngInstance = vNewValue
End Property
' FileSave 类实现 =========================================================
Public Function ShowSave() As Boolean
Dim fName As String, sName As String, OfName As OPENFILENAME
OfName.lStructSize = Len(OfName)
OfName.hwndOwner = m_lngHwnd
OfName.hInstance = m_lngInstance
OfName.lpstrInitialDir = m_strInitDir
OfName.lpstrFilter = m_strFilter
OfName.lpstrFile = Space(255) & Chr(0)
OfName.nMaxFile = 256
OfName.lpstrFileTitle = Space(255) & Chr(0)
OfName.nMaxFileTitle = 256
OfName.lpstrTitle = m_strDialogTitle
OfName.Flags = m_lngFlags
If GetSaveFileName(OfName) Then
m_strFileName = OfName.lpstrFile
m_strFileTitle = OfName.lpstrFileTitle
ShowSave = True
Else
ShowSave = False
End If
End Function
' Print 类实现 =========================================================
Public Function ShowPrint() As Boolean
Dim PrtDlg As PRINTDLG
PrtDlg.lStructSize = Len(PrtDlg)
PrtDlg.hwndOwner = m_lngHwnd
PrtDlg.hInstance = m_lngInstance
PrtDlg.nCopies = m_lngCopies
PrtDlg.nFromPage = m_lngFromPage
PrtDlg.nMaxPage = m_lngMaxPage
PrtDlg.nMinPage = m_lngMinPage
PrtDlg.nToPage = m_lngToPage
PrtDlg.Flags = m_lngFlags
If PrintDialog(PrtDlg) Then
m_lngCopies = PrtDlg.nCopies
m_lngFromPage = PrtDlg.nFromPage
m_lngMaxPage = PrtDlg.nMaxPage
m_lngMinPage = PrtDlg.nMinPage
m_lngToPage = PrtDlg.nToPage
ShowPrint = True
Else
ShowPrint = False
End If
End Function
Public Property Get Copies() As Long
Copies = m_lngCopies
End Property
Public Property Let Copies(ByVal vNewValue As Long)
m_lngCopies = vNewValue
End Property
Public Property Get FromPage() As Long
FromPage = m_lngFromPage
End Property
Public Property Let FromPage(ByVal vNewValue As Long)
m_lngFromPage = vNewValue
End Property
Public Property Get ToPage() As Long
ToPage = m_lngToPage
End Property
Public Property Let ToPage(ByVal vNewValue As Long)
m_lngToPage = vNewValue
End Property
Public Property Get MaxPage() As Long
MaxPage = m_lngMaxPage
End Property
Public Property Let MaxPage(ByVal vNewValue As Long)
m_lngMaxPage = vNewValue
End Property
Public Property Get MinPage() As Long
MinPage = m_lngMinPage
End Property
Public Property Let MinPage(ByVal vNewValue As Long)
m_lngMinPage = vNewValue
End Property
' ChooseColorDialog 类实现 =========================================================
Public Function ShowColor() As Boolean
Dim i As Integer
Dim ClrDlg As CHOOSECOLOR, CustomColors() As Byte
ReDim CustomColors(0 To 63) As Byte
For i = LBound(CustomColors) To UBound(CustomColors)
CustomColors(i) = 0
Next i
ClrDlg.lStructSize = Len(ClrDlg)
ClrDlg.hwndOwner = m_lngHwnd
ClrDlg.hInstance = m_lngInstance
ClrDlg.lpCustColors = StrConv(CustomColors, vbUnicode)
If ChooseColorDialog(ClrDlg) Then
m_lngColor = ClrDlg.rgbResult
CustomColors = StrConv(ClrDlg.lpCustColors, vbFromUnicode)
ShowColor = True
Else
ShowColor = False
End If
End Function
Public Property Get Color() As Long
Color = m_lngColor
End Property
Public Property Let Color(ByVal vNewValue As Long)
m_lngColor = vNewValue
End Property
' Font 类实现 =========================================================
Public Function ShowFont() As Boolean
Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
Dim FontName As String, retval As Long
lfont.lfHeight = 0 ' determine default height
lfont.lfWidth = 0 ' determine default width
lfont.lfEscapement = 0 ' angle between baseline and escapement vector
lfont.lfOrientation = 0 ' angle between baseline and orientation vector
lfont.lfWeight = FW_NORMAL ' normal weight I.e. Not bold
lfont.lfCharSet = DEFAULT_CHARSET ' use default character set
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS ' default precision mapping
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS ' default clipping precision
lfont.lfQuality = DEFAULT_QUALITY ' default quality setting
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN ' default pitch, proportional with serifs
lfont.lfFaceName = "Times New Roman" & vbNullChar ' string must be null-terminated
' Create the memory block which will act as the LOGFONT structure buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
pMem = GlobalLock(hMem) ' lock and get pointer
CopyMemory ByVal pMem, lfont, Len(lfont) ' copy structure's contents into block
' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
cf.lStructSize = Len(cf) ' size of structure
cf.hwndOwner = m_lngHwnd ' window Form1 is opening this dialog box
cf.hdc = Printer.hdc ' device context of default printer (using VB's mechanism)
cf.lpLogFont = pMem ' pointer to LOGFONT memory block buffer
cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)
cf.Flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0) ' black
cf.nFontType = REGULAR_FONTTYPE ' regular font type I.e. Not bold or anything
cf.nSizeMin = 1 ' minimum point size
cf.nSizeMax = 72 ' maximum point size
' Now, call the function. If successful, copy the LOGFONT structure back into the structure
' and then print out the attributes we mentioned earlier that the user selected.
If CHOOSEFONT(cf) Then ' success
CopyMemory lfont, ByVal pMem, Len(lfont) ' copy memory back
' Now make the fixed-length string holding the font name into a "normal" string.
m_strFontName = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
m_lngFontColor = cf.rgbColors
m_lngFontSize = cf.iPointSize / 10
m_lngCharSet = lfont.lfCharSet
m_bolItalic = lfont.lfItalic = 255
m_bolStrikeOut = lfont.lfStrikeOut = 1
m_bolUnderline = lfont.lfUnderline = 1
m_bolBlob = lfont.lfWeight >= 700
ShowFont = True
Else
ShowFont = False
End If
' Deallocate the memory block we created earlier. Note that this must
' be done whether the function succeeded or not.
retval = GlobalUnlock(hMem) ' destroy pointer, unlock block
retval = GlobalFree(hMem) ' free the allocated memory
End Function
Public Property Get FontName() As String
FontName = m_strFontName
End Property
Public Property Let FontName(ByVal vNewValue As String)
m_strFontName = vNewValue
End Property
Public Property Get FontColor() As Long
FontColor = m_lngFontColor
End Property
Public Property Let FontColor(ByVal vNewValue As Long)
m_lngFontColor = vNewValue
End Property
Public Property Get FontSize() As Long
FontSize = m_lngFontSize
End Property
Public Property Let FontSize(ByVal vNewValue As Long)
m_lngFontSize = vNewValue
End Property
Public Property Get CharSet() As Long
CharSet = m_lngCharSet
End Property
Public Property Let CharSet(ByVal vNewValue As Long)
m_lngCharSet = vNewValue
End Property
Public Property Get Italic() As Boolean
Italic = m_bolItalic
End Property
Public Property Let Italic(ByVal vNewValue As Boolean)
m_bolItalic = vNewValue
End Property
Public Property Get StrikeOut() As Boolean
StrikeOut = m_bolStrikeOut
End Property
Public Property Let StrikeOut(ByVal vNewValue As Boolean)
m_bolStrikeOut = vNewValue
End Property
Public Property Get Underline() As Boolean
Underline = m_bolUnderline
End Property
Public Property Let Underline(ByVal vNewValue As Boolean)
m_bolUnderline = vNewValue
End Property
Public Property Get FontBlob() As Boolean
FontBlob = m_bolBlob
End Property
Public Property Let FontBlob(ByVal vNewValue As Boolean)
m_bolBlob = vNewValue
End Property
' Find 类实现 =========================================================
Public Function ShowFind() As Boolean
Dim lFind As FINDREPLACE
lFind.lStructSize = Len(lFind)
lFind.hwndOwner = m_lngHwnd
lFind.hInstance = m_lngInstance
lFind.wFindWhatLen = 255
' If FindText(lFind) Then
' ShowFind = True
' Else
' ShowFind = False
' End If
End Function
' Replace 类实现 =========================================================
Public Function ShowReplace() As Boolean
Dim lFind As FINDREPLACE
lFind.lStructSize = Len(lFind)
lFind.hwndOwner = m_lngHwnd
lFind.hInstance = m_lngInstance
lFind.wFindWhatLen = 255
If ReplaceText(lFind) Then
ShowReplace = True
Else
ShowReplace = False
End If
End Function
' Replace 类实现 =========================================================
Public Function ShowPageSetup() As Boolean
Dim lPageSetup As PAGESETUPDLG
lPageSetup.lStructSize = Len(lPageSetup)
lPageSetup.hwndOwner = m_lngHwnd
lPageSetup.hInstance = m_lngInstance
If PAGESETUPDLG(lPageSetup) Then
m_lngPaperWidth = lPageSetup.ptPaperSize.x
m_lngPaperHeight = lPageSetup.ptPaperSize.y
m_lngMarginLeft = lPageSetup.rtMargin.Left
m_lngMarginTop = lPageSetup.rtMargin.Top
m_lngMarginRight = lPageSetup.rtMargin.Right
m_lngMarginBottom = lPageSetup.rtMargin.Bottom
ShowPageSetup = True
Else
ShowPageSetup = False
End If
End Function
Public Property Get PaperWidth() As Long
PaperWidth = m_lngPaperWidth
End Property
Public Property Let PaperWidth(ByVal vNewValue As Long)
m_lngPaperWidth = vNewValue
End Property
Public Property Get PaperHeight() As Long
PaperHeight = m_lngPaperHeight
End Property
Public Property Let PaperHeight(ByVal vNewValue As Long)
m_lngPaperHeight = vNewValue
End Property
Public Property Get MarginLeft() As Long
MarginLeft = m_lngMarginLeft
End Property
Public Property Let MarginLeft(ByVal vNewValue As Long)
m_lngMarginLeft = vNewValue
End Property
Public Property Get MarginTop() As Long
MarginTop = m_lngMarginTop
End Property
Public Property Let MarginTop(ByVal vNewValue As Long)
m_lngMarginTop = vNewValue
End Property
Public Property Get MarginRight() As Long
MarginRight = m_lngMarginRight
End Property
Public Property Let MarginRight(ByVal vNewValue As Long)
m_lngMarginRight = vNewValue
End Property
Public Property Get MarginBottom() As Long
MarginBottom = m_lngMarginBottom
End Property
Public Property Let MarginBottom(ByVal vNewValue As Long)
m_lngMarginBottom = vNewValue
End Property
在窗口中添加六个按钮，分别用来实现调用这几个通用对话框，代码如下：
Option Explicit
Dim dlg As CDialog
Private Sub Command1_Click()
dlg.Hwnd = Hwnd
dlg.Filter = "WORD文档|*.doc;*.html"
dlg.Flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER + OFN_PATHMUSTEXIST
dlg.InitDir = "D:\"
dlg.DialogTitle = "(昱豪)打开文件..."
If dlg.ShowOpen Then
MsgBox dlg.FileName
MsgBox dlg.FileTitle
End If
End Sub
Private Sub Command2_Click()
dlg.Hwnd = Hwnd
dlg.Filter = "WORD文档|*.doc;*.html"
dlg.Flags = OFN_ALLOWMULTISELECT + OFN_EXPLORER + OFN_PATHMUSTEXIST
dlg.InitDir = "D:\"
dlg.DialogTitle = "(昱豪)保存文件..."
If dlg.ShowSave Then
MsgBox dlg.FileName
MsgBox dlg.FileTitle
End If
End Sub
Private Sub Command3_Click()
dlg.Hwnd = Hwnd
dlg.Flags = PD_SELECTION + PD_USEDEVMODECOPIES
If dlg.ShowPrint Then
MsgBox "Copies:" & dlg.Copies & vbCrLf & _
"FromPage:" & dlg.FromPage & vbCrLf & _
"ToPage:" & dlg.ToPage & vbCrLf & _
"MaxPage:" & dlg.MaxPage & vbCrLf & _
"MinPage:" & dlg.MinPage
End If
End Sub
Private Sub Command4_Click()
dlg.Hwnd = Hwnd
If dlg.ShowColor Then
BackColor = dlg.Color
End If
End Sub
Private Sub Command5_Click()
dlg.Hwnd = Hwnd
If dlg.ShowFont Then
MsgBox "FontName:" & dlg.FontName & vbCrLf & _
"FontColor:" & dlg.FontColor & vbCrLf & _
"FontSize:" & dlg.FontSize & vbCrLf & _
"CharSet:" & dlg.CharSet & vbCrLf & _
"Italic:" & dlg.Italic & vbCrLf & _
"StrikeOut:" & dlg.StrikeOut & vbCrLf & _
"Underline:" & dlg.Underline & vbCrLf & _
"Blob:" & dlg.FontBlob
End If
End Sub
Private Sub Command6_Click()
dlg.Hwnd = Hwnd
If dlg.ShowFind Then
End If
End Sub
Private Sub Command7_Click()
dlg.Hwnd = Hwnd
If dlg.ShowPageSetup Then
MsgBox "PageWeight:" & dlg.PaperWidth & vbCrLf & _
"PageHeight:" & dlg.PaperHeight & vbCrLf & _
"MarginLeft:" & dlg.MarginLeft & vbCrLf & _
"MarginTop:" & dlg.MarginTop & vbCrLf & _
"MarginRight:" & dlg.MarginRight & vbCrLf & _
"MarginBottom:" & dlg.MarginBottom
End If
End Sub
Private Sub Command8_Click()
dlg.Hwnd = Hwnd
If dlg.ShowReplace Then
End If
End Sub
Private Sub Form_Load()
Set dlg = New CDialog
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set dlg = Nothing
End Sub
只要在工程中把这前面介绍的类文件加进去就可以使用了，不用外部的控件，安装的时候也省了一些控件，结省了空间！！
本文地址：http://com.8s8s.com/it/it44061.htm