Option Explicit' ========================================================================== ' Class: GCommonDialog ' Filename: GCommonDialog.cls ' Author: Steve McMahon, based on original by Bruce McKinney ' Date: 24 May 1998 ' ========================================================================== ' ========================================================================== ' API declares: ' ========================================================================== Public Enum EErrorCommonDialog eeBaseCommonDialog = 13450 ' CommonDialog End EnumPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long Private Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree 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 GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As Long Private Declare Function GlobalSize 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" ( _ lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Private Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" ( _ lpvDest As Any, ByVal lpvSource As String, ByVal cbCopy As Long)Private Const MAX_PATH = 260 Private Const MAX_FILE = 260Private Type OPENFILENAME lStructSize As Long ' Filled with UDT size hWndOwner As Long ' Tied to Owner hInstance As Long ' Ignored (used only by templates) lpstrFilter As String ' Tied to Filter lpstrCustomFilter As String ' Ignored (exercise for reader) nMaxCustFilter As Long ' Ignored (exercise for reader) nFilterIndex As Long ' Tied to FilterIndex lpstrFile As String ' Tied to FileName nMaxFile As Long ' Handled internally lpstrFileTitle As String ' Tied to FileTitle nMaxFileTitle As Long ' Handled internally lpstrInitialDir As String ' Tied to InitDir lpstrTitle As String ' Tied to DlgTitle flags As Long ' Tied to Flags nFileOffset As Integer ' Ignored (exercise for reader) nFileExtension As Integer ' Ignored (exercise for reader) lpstrDefExt As String ' Tied to DefaultExt lCustData As Long ' Ignored (needed for hooks) lpfnHook As Long ' Ignored (good luck with hooks) lpTemplateName As Long ' Ignored (good luck with templates) End TypePrivate Declare Function GetOpenFileName Lib "COMDLG32" _ Alias "GetOpenFileNameA" (file As OPENFILENAME) As Long Private Declare Function GetSaveFileName Lib "COMDLG32" _ Alias "GetSaveFileNameA" (file As OPENFILENAME) As Long Private Declare Function GetFileTitle Lib "COMDLG32" _ Alias "GetFileTitleA" (ByVal szFile As String, _ ByVal szTitle As String, ByVal cbBuf As Long) As LongPublic Enum EOpenFile OFN_READONLY = &H1 OFN_OVERWRITEPROMPT = &H2 OFN_HIDEREADONLY = &H4 OFN_NOCHANGEDIR = &H8 OFN_SHOWHELP = &H10 OFN_ENABLEHOOK = &H20 OFN_ENABLETEMPLATE = &H40 OFN_ENABLETEMPLATEHANDLE = &H80 OFN_NOVALIDATE = &H100 OFN_ALLOWMULTISELECT = &H200 OFN_EXTENSIONDIFFERENT = &H400 OFN_PATHMUSTEXIST = &H800 OFN_FILEMUSTEXIST = &H1000 OFN_CREATEPROMPT = &H2000 OFN_SHAREAWARE = &H4000 OFN_NOREADONLYRETURN = &H8000 OFN_NOTESTFILECREATE = &H10000 OFN_NONETWORKBUTTON = &H20000 OFN_NOLONGNAMES = &H40000 OFN_EXPLORER = &H80000 OFN_NODEREFERENCELINKS = &H100000 OFN_LONGNAMES = &H200000 End EnumPrivate Type TCHOOSECOLOR lStructSize As Long hWndOwner As Long hInstance As Long rgbResult As Long lpCustColors As Long flags As Long lCustData As Long lpfnHook As Long lpTemplateName As Long End TypePrivate Declare Function ChooseColor Lib "COMDLG32.DLL" _ Alias "ChooseColorA" (Color As TCHOOSECOLOR) As Long
Public Enum EChooseColor CC_RGBInit = &H1 CC_FullOpen = &H2 CC_PreventFullOpen = &H4 CC_ColorShowHelp = &H8 ' Win95 only CC_SolidColor = &H80 CC_AnyColor = &H100 ' End Win95 only CC_ENABLEHOOK = &H10 CC_ENABLETEMPLATE = &H20 CC_EnableTemplateHandle = &H40 End Enum Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As LongPrivate Type TCHOOSEFONT lStructSize As Long ' Filled with UDT size hWndOwner As Long ' Caller's window handle hdc As Long ' Printer DC/IC or NULL lpLogFont As Long ' Pointer to LOGFONT iPointSize As Long ' 10 * size in points of font flags As Long ' Type flags rgbColors As Long ' Returned text color lCustData As Long ' Data passed to hook function lpfnHook As Long ' Pointer to hook function lpTemplateName As Long ' Custom template name hInstance As Long ' Instance handle for template lpszStyle As String ' Return style field nFontType As Integer ' Font type bits iAlign As Integer ' Filler nSizeMin As Long ' Minimum point size allowed nSizeMax As Long ' Maximum point size allowed End Type Private Declare Function ChooseFont Lib "COMDLG32" _ Alias "ChooseFontA" (chfont As TCHOOSEFONT) As LongPrivate Const LF_FACESIZE = 32 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(LF_FACESIZE) As Byte End TypePublic Enum EChooseFont CF_ScreenFonts = &H1 CF_PrinterFonts = &H2 CF_BOTH = &H3 CF_FontShowHelp = &H4 CF_UseStyle = &H80 CF_EFFECTS = &H100 CF_AnsiOnly = &H400 CF_NoVectorFonts = &H800 CF_NoOemFonts = CF_NoVectorFonts CF_NoSimulations = &H1000 CF_LimitSize = &H2000 CF_FixedPitchOnly = &H4000 CF_WYSIWYG = &H8000 ' Must also have ScreenFonts And PrinterFonts CF_ForceFontExist = &H10000 CF_ScalableOnly = &H20000 CF_TTOnly = &H40000 CF_NoFaceSel = &H80000 CF_NoStyleSel = &H100000 CF_NoSizeSel = &H200000 ' Win95 only CF_SelectScript = &H400000 CF_NoScriptSel = &H800000 CF_NoVertFonts = &H1000000 CF_InitToLogFontStruct = &H40 CF_Apply = &H200 CF_EnableHook = &H8 CF_EnableTemplate = &H10 CF_EnableTemplateHandle = &H20 CF_FontNotSupported = &H238 End Enum' These are extra nFontType bits that are added to what is returned to the ' EnumFonts callback routinePublic Enum EFontType Simulated_FontType = &H8000 Printer_FontType = &H4000 Screen_FontType = &H2000 Bold_FontType = &H100 Italic_FontType = &H200 Regular_FontType = &H400 End EnumPrivate Type TPRINTDLG 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 Long lpSetupTemplateName As Long hPrintTemplate As Long hSetupTemplate As Long End Type' DEVMODE collation selections Private Const DMCOLLATE_FALSE = 0 Private Const DMCOLLATE_TRUE = 1Private Declare Function PrintDlg Lib "COMDLG32.DLL" _ Alias "PrintDlgA" (prtdlg As TPRINTDLG) As IntegerPublic Enum EPrintDialog PD_ALLPAGES = &H0 PD_SELECTION = &H1 PD_PAGENUMS = &H2 PD_NOSELECTION = &H4 PD_NOPAGENUMS = &H8 PD_COLLATE = &H10 PD_PRINTTOFILE = &H20 PD_PRINTSETUP = &H40 PD_NOWARNING = &H80 PD_RETURNDC = &H100 PD_RETURNIC = &H200 PD_RETURNDEFAULT = &H400 PD_SHOWHELP = &H800 PD_ENABLEPRINTHOOK = &H1000 PD_ENABLESETUPHOOK = &H2000 PD_ENABLEPRINTTEMPLATE = &H4000 PD_ENABLESETUPTEMPLATE = &H8000 PD_ENABLEPRINTTEMPLATEHANDLE = &H10000 PD_ENABLESETUPTEMPLATEHANDLE = &H20000 PD_USEDEVMODECOPIES = &H40000 PD_USEDEVMODECOPIESANDCOLLATE = &H40000 PD_DISABLEPRINTTOFILE = &H80000 PD_HIDEPRINTTOFILE = &H100000 PD_NONETWORKBUTTON = &H200000 End EnumPrivate Type DEVNAMES wDriverOffset As Integer wDeviceOffset As Integer wOutputOffset As Integer wDefault As Integer End TypePrivate Const CCHDEVICENAME = 32 Private Const CCHFORMNAME = 32 Private Type DevMode dmDeviceName As String * CCHDEVICENAME dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * CCHFORMNAME dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long End Type' New Win95 Page Setup dialogs are up to you Private Type POINTL 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 TPAGESETUPDLG lStructSize As Long hWndOwner As Long hDevMode As Long hDevNames As Long flags As Long ptPaperSize As POINTL rtMinMargin As RECT rtMargin As RECT hInstance As Long lCustData As Long lpfnPageSetupHook As Long lpfnPagePaintHook As Long lpPageSetupTemplateName As Long hPageSetupTemplate As Long End Type
Public cdlg As New GCommonDialog Dim sFile As String On Error GoTo ehFileOpen If cdlg.VBGetOpenFileName(sFile, "Office Document", True, False, False, False, "Word File(*.Doc)|*.Doc|RichText Files (*.rtf)|*.rtf|All Files (*.*)|*.*", , "", "´ò¿ªÎļþ...", "Îļþ", Me.hwnd) Then With Rtf.ActiveDocument.Application .Selection.InsertFile FileName:=sFile, ConfirmConversions:=False '.Selection.Collapse Direction:=wdCollapseEnd End With End If ehFileOpen: Exit Sub
' Class: GCommonDialog
' Filename: GCommonDialog.cls
' Author: Steve McMahon, based on original by Bruce McKinney
' Date: 24 May 1998
' ==========================================================================
' ==========================================================================
' API declares:
' ==========================================================================
Public Enum EErrorCommonDialog
eeBaseCommonDialog = 13450 ' CommonDialog
End EnumPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree 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 GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As Long
Private Declare Function GlobalSize 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" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, ByVal lpvSource As String, ByVal cbCopy As Long)Private Const MAX_PATH = 260
Private Const MAX_FILE = 260Private Type OPENFILENAME
lStructSize As Long ' Filled with UDT size
hWndOwner As Long ' Tied to Owner
hInstance As Long ' Ignored (used only by templates)
lpstrFilter As String ' Tied to Filter
lpstrCustomFilter As String ' Ignored (exercise for reader)
nMaxCustFilter As Long ' Ignored (exercise for reader)
nFilterIndex As Long ' Tied to FilterIndex
lpstrFile As String ' Tied to FileName
nMaxFile As Long ' Handled internally
lpstrFileTitle As String ' Tied to FileTitle
nMaxFileTitle As Long ' Handled internally
lpstrInitialDir As String ' Tied to InitDir
lpstrTitle As String ' Tied to DlgTitle
flags As Long ' Tied to Flags
nFileOffset As Integer ' Ignored (exercise for reader)
nFileExtension As Integer ' Ignored (exercise for reader)
lpstrDefExt As String ' Tied to DefaultExt
lCustData As Long ' Ignored (needed for hooks)
lpfnHook As Long ' Ignored (good luck with hooks)
lpTemplateName As Long ' Ignored (good luck with templates)
End TypePrivate Declare Function GetOpenFileName Lib "COMDLG32" _
Alias "GetOpenFileNameA" (file As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32" _
Alias "GetSaveFileNameA" (file As OPENFILENAME) As Long
Private Declare Function GetFileTitle Lib "COMDLG32" _
Alias "GetFileTitleA" (ByVal szFile As String, _
ByVal szTitle As String, ByVal cbBuf As Long) As LongPublic Enum EOpenFile
OFN_READONLY = &H1
OFN_OVERWRITEPROMPT = &H2
OFN_HIDEREADONLY = &H4
OFN_NOCHANGEDIR = &H8
OFN_SHOWHELP = &H10
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_NOVALIDATE = &H100
OFN_ALLOWMULTISELECT = &H200
OFN_EXTENSIONDIFFERENT = &H400
OFN_PATHMUSTEXIST = &H800
OFN_FILEMUSTEXIST = &H1000
OFN_CREATEPROMPT = &H2000
OFN_SHAREAWARE = &H4000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NONETWORKBUTTON = &H20000
OFN_NOLONGNAMES = &H40000
OFN_EXPLORER = &H80000
OFN_NODEREFERENCELINKS = &H100000
OFN_LONGNAMES = &H200000
End EnumPrivate Type TCHOOSECOLOR
lStructSize As Long
hWndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As Long
End TypePrivate Declare Function ChooseColor Lib "COMDLG32.DLL" _
Alias "ChooseColorA" (Color As TCHOOSECOLOR) As Long
Public Enum EChooseColor
CC_RGBInit = &H1
CC_FullOpen = &H2
CC_PreventFullOpen = &H4
CC_ColorShowHelp = &H8
' Win95 only
CC_SolidColor = &H80
CC_AnyColor = &H100
' End Win95 only
CC_ENABLEHOOK = &H10
CC_ENABLETEMPLATE = &H20
CC_EnableTemplateHandle = &H40
End Enum
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As LongPrivate Type TCHOOSEFONT
lStructSize As Long ' Filled with UDT size
hWndOwner As Long ' Caller's window handle
hdc As Long ' Printer DC/IC or NULL
lpLogFont As Long ' Pointer to LOGFONT
iPointSize As Long ' 10 * size in points of font
flags As Long ' Type flags
rgbColors As Long ' Returned text color
lCustData As Long ' Data passed to hook function
lpfnHook As Long ' Pointer to hook function
lpTemplateName As Long ' Custom template name
hInstance As Long ' Instance handle for template
lpszStyle As String ' Return style field
nFontType As Integer ' Font type bits
iAlign As Integer ' Filler
nSizeMin As Long ' Minimum point size allowed
nSizeMax As Long ' Maximum point size allowed
End Type
Private Declare Function ChooseFont Lib "COMDLG32" _
Alias "ChooseFontA" (chfont As TCHOOSEFONT) As LongPrivate Const LF_FACESIZE = 32
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(LF_FACESIZE) As Byte
End TypePublic Enum EChooseFont
CF_ScreenFonts = &H1
CF_PrinterFonts = &H2
CF_BOTH = &H3
CF_FontShowHelp = &H4
CF_UseStyle = &H80
CF_EFFECTS = &H100
CF_AnsiOnly = &H400
CF_NoVectorFonts = &H800
CF_NoOemFonts = CF_NoVectorFonts
CF_NoSimulations = &H1000
CF_LimitSize = &H2000
CF_FixedPitchOnly = &H4000
CF_WYSIWYG = &H8000 ' Must also have ScreenFonts And PrinterFonts
CF_ForceFontExist = &H10000
CF_ScalableOnly = &H20000
CF_TTOnly = &H40000
CF_NoFaceSel = &H80000
CF_NoStyleSel = &H100000
CF_NoSizeSel = &H200000
' Win95 only
CF_SelectScript = &H400000
CF_NoScriptSel = &H800000
CF_NoVertFonts = &H1000000 CF_InitToLogFontStruct = &H40
CF_Apply = &H200
CF_EnableHook = &H8
CF_EnableTemplate = &H10
CF_EnableTemplateHandle = &H20
CF_FontNotSupported = &H238
End Enum' These are extra nFontType bits that are added to what is returned to the
' EnumFonts callback routinePublic Enum EFontType
Simulated_FontType = &H8000
Printer_FontType = &H4000
Screen_FontType = &H2000
Bold_FontType = &H100
Italic_FontType = &H200
Regular_FontType = &H400
End EnumPrivate Type TPRINTDLG
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 Long
lpSetupTemplateName As Long
hPrintTemplate As Long
hSetupTemplate As Long
End Type' DEVMODE collation selections
Private Const DMCOLLATE_FALSE = 0
Private Const DMCOLLATE_TRUE = 1Private Declare Function PrintDlg Lib "COMDLG32.DLL" _
Alias "PrintDlgA" (prtdlg As TPRINTDLG) As IntegerPublic Enum EPrintDialog
PD_ALLPAGES = &H0
PD_SELECTION = &H1
PD_PAGENUMS = &H2
PD_NOSELECTION = &H4
PD_NOPAGENUMS = &H8
PD_COLLATE = &H10
PD_PRINTTOFILE = &H20
PD_PRINTSETUP = &H40
PD_NOWARNING = &H80
PD_RETURNDC = &H100
PD_RETURNIC = &H200
PD_RETURNDEFAULT = &H400
PD_SHOWHELP = &H800
PD_ENABLEPRINTHOOK = &H1000
PD_ENABLESETUPHOOK = &H2000
PD_ENABLEPRINTTEMPLATE = &H4000
PD_ENABLESETUPTEMPLATE = &H8000
PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
PD_ENABLESETUPTEMPLATEHANDLE = &H20000
PD_USEDEVMODECOPIES = &H40000
PD_USEDEVMODECOPIESANDCOLLATE = &H40000
PD_DISABLEPRINTTOFILE = &H80000
PD_HIDEPRINTTOFILE = &H100000
PD_NONETWORKBUTTON = &H200000
End EnumPrivate Type DEVNAMES
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
End TypePrivate Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Type DevMode
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type' New Win95 Page Setup dialogs are up to you
Private Type POINTL
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 TPAGESETUPDLG
lStructSize As Long
hWndOwner As Long
hDevMode As Long
hDevNames As Long
flags As Long
ptPaperSize As POINTL
rtMinMargin As RECT
rtMargin As RECT
hInstance As Long
lCustData As Long
lpfnPageSetupHook As Long
lpfnPagePaintHook As Long
lpPageSetupTemplateName As Long
hPageSetupTemplate As Long
End Type
On Error GoTo ehFileOpen
If cdlg.VBGetOpenFileName(sFile, "Office Document", True, False, False, False, "Word File(*.Doc)|*.Doc|RichText Files (*.rtf)|*.rtf|All Files (*.*)|*.*", , "", "´ò¿ªÎļþ...", "Îļþ", Me.hwnd) Then
With Rtf.ActiveDocument.Application
.Selection.InsertFile FileName:=sFile, ConfirmConversions:=False
'.Selection.Collapse Direction:=wdCollapseEnd
End With
End If
ehFileOpen:
Exit Sub