大家在写程序的时候,难免会用到WINDOWS的通用对话框,如打开、保存、字体、颜色、打印等。这些通用对话框在外部控件里可以加载,不过打包的时候还要带上控件,所以会很麻烦,并且会加大安装程序的大小。笔者通过实践,总结出了通过API实现这些对话框的方法,写出来与大家分享。
崔占民
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
只要在工程中把这前面介绍的类文件加进去就可以使用了,不用外部的控件,安装的时候也省了一些控件,结省了空间!! 
|