分享
 
 
 

用API实现WINDOWS下的通用对话框!

王朝system·作者佚名  2007-08-29
窄屏简体版  字體: |||超大  

大家在写程序的时候,难免会用到WINDOWS的通用对话框,如打开、保存、字体、颜色、打印等。这些通用对话框在外部控件里可以加载,不过打包的时候还要带上控件,所以会很麻烦,并且会加大安装程序的大小。笔者通过实践,总结出了通过API实现这些对话框的方法,写出来与大家分享。

崔占民

EMAIL:CUIZM@163.COM

定义一个类模块,方法:工程->添加类模块。代码如下:

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

只要在工程中把这前面介绍的类文件加进去就可以使用了,不用外部的控件,安装的时候也省了一些控件,结省了空间!!

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有