cdlg.cls

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CDlg"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'   Module:         CDlg
'   Description:    The CDlg class is a drop-in replacement for the Microsoft
'                   Common Dialog Control. It performs the exact same functionality,
'                   with the exact same interface.
'                   The goal of this project was to create a drop-in replacement.
'                   As such, additional functionality (such as .chm help support,
'                   Page Setup dialog box, etc) that is not supported by the
'                   CommonDialog control, is not included in this project.
'   Date:           08/18/2000
'-------------------------------------------------------------------------------
'---------------------------------------------
'Constants
Private Const cdlCFInitToLogFontStruct = &H40
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
'---------------------------------------------
'Enumerations

Public Enum ColorConstants
    cdlCCRGBInit = 1
    cdlCCFullOpen = 2
    cdlCCPreventFullOpen = 4
    cdlCCHelpButton = 8
End Enum

Public Enum ErrorConstants
    cdlInvalidPropertyValue = 380
    cdlGetNotSupported = 394
    cdlSetNotSupported = 383
    cdlAlloc = 32752
    cdlCancel = 32755
    cdlDialogFailure = -32768
    cdlFindResFailure = 32761
    cdlHelp = 32751
    cdlInitialization = 32765
    cdlLoadResFailure = 32760
    cdlLoadStrFailure = 32762
    cdlLockResFailure = 32759
    cdlMemAllocFailure = 32758
    cdlMemLockFailure = 32757
    cdlNoFonts = 24574
    cdlBufferTooSmall = 20476
    cdlInvalidFileName = 20477
    cdlSubclassFailure = 20478
    cdlCreateICFailure = 28661
    cdlDndmMismatch = 28662
    cdlGetDevModeFail = 28666
    cdlInitFailure = 28665
    cdlLoadDrvFailure = 28667
    cdlNoDefaultPrn = 28663
    cdlNoDevices = 28664
    cdlParseFailure = 28669
    cdlPrinterCodes = 28671
    cdlPrinterNotFound = 28660
    cdlRetDefFailure = 28668
    cdlSetupFailure = 28670
    cdlNoTemplate = 32764
    cdlNoInstance = 32763
    cdlInvalidSafeModeProcCall = 680
End Enum

Public Enum FileOpenConstants
    cdlOFNReadOnly = 1
    cdlOFNOverwritePrompt = 2
    cdlOFNHideReadOnly = 4
    cdlOFNNoChangeDir = 8
    cdlOFNHelpButton = 16
    cdlOFNNoValidate = 256
    cdlOFNAllowMultiselect = 512
    cdlOFNExtensionDifferent = 1024
    cdlOFNPathMustExist = 2048
    cdlOFNFileMustExist = 4096
    cdlOFNCreatePrompt = 8192
    cdlOFNShareAware = 16384
    cdlOFNNoReadOnlyReturn = 32768
    cdlOFNNoLongNames = 262144
    cdlOFNExplorer = 524288
    cdlOFNNoDereferenceLinks = 1048576
    cdlOFNLongNames = 2097152
End Enum

Public Enum FontsConstants
    cdlCFScreenFonts = 1
    cdlCFPrinterFonts = 2
    cdlCFBoth = 3
    cdlCFHelpButton = 4
    cdlCFEffects = 256
    cdlCFApply = 512
    cdlCFANSIOnly = 1024
    cdlCFNoVectorFonts = 2048
    cdlCFNoSimulations = 4096
    cdlCFLimitSize = 8192
    cdlCFFixedPitchOnly = 16384
    cdlCFWYSIWYG = 32768
    cdlCFForceFontExist = 65536
    cdlCFScalableOnly = 131072
    cdlCFTTOnly = 262144
    cdlCFNoFaceSel = 524288
    cdlCFNoStyleSel = 1048576
    cdlCFNoSizeSel = 2097152
End Enum

Public Enum HelpConstants
    cdlHelpCommand = &H102
    cdlHelpContext = 1
    cdlHelpQuit = 2
    cdlHelpIndex = 3
    cdlHelpContents = 3
    cdlHelpHelpOnHelp = 4
    cdlHelpSetIndex = 5
    cdlHelpSetContents = 5
    cdlHelpContextPopup = 8
    cdlHelpForceFile = 9
    cdlHelpKey = 257
    cdlHelpCommandHelp = 258
    cdlHelpPartialKey = 261
End Enum

Public Enum PrinterConstants
    cdlPDAllPages = 0
    cdlPDCollate = 16
    cdlPDDisablePrintToFile = 524288
    cdlPDHidePrintToFile = 1048576
    cdlPDNoPageNums = 8
    cdlPDNoSelection = 4
    cdlPDNoWarning = 128
    cdlPDPageNums = 2
    cdlPDPrintSetup = 64
    cdlPDPrintToFile = 32
    cdlPDReturnDC = 256
    cdlPDReturnDefault = 1024
    cdlPDReturnIC = 512
    cdlPDSelection = 1
    cdlPDHelpButton = 2048
    cdlPDUseDevModeCopies = 262144
End Enum

Public Enum PrinterOrientationConstants
    cdlPortrait = 1
    cdlLandscape = 2
End Enum

Private Enum EFontType
    Simulated_FontType = &H8000&
    Printer_FontType = &H4000
    Screen_FontType = &H2000
    Bold_FontType = &H100
    Italic_FontType = &H200
    Regular_FontType = &H400
End Enum
'---------------------------------------------
'UDTs

Private Type OPENFILENAME
    nStructSize       As Long
    hWndOwner         As Long
    hInstance         As Long
    sFilter           As String
    sCustomFilter     As String
    nMaxCustFilter    As Long
    nFilterIndex      As Long
    sFile             As String
    nMaxFile          As Long
    sFileTitle        As String
    nMaxTitle         As Long
    sInitialDir       As String
    sDialogTitle      As String
    Flags             As Long
    nFileOffset       As Integer
    nFileExtension    As Integer
    sDefFileExt       As String
    nCustData         As Long
    fnHook            As Long
    sTemplateName     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(32) As Byte
End Type

Private Type TCHOOSEFONT
    lStructSize As Long
    hWndOwner As Long
    hdc As Long
    lpLogFont As Long
    iPointSize As Long
    Flags As Long
    rgbColors As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As Long
    hInstance As Long
    lpszStyle As String
    nFontType As Integer
    iAlign As Integer
    nSizeMin As Long
    nSizeMax As Long
End Type

Private 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 String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type

Private Type CHOOSECOLORS
    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 Type

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
'---------------------------------------------
'API Declarations
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 ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLORS) As Long
Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As TCHOOSEFONT) As Long
Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As TPRINTDLG) As Long
Private Declare Function CommDlgExtendedError Lib "COMDLG32" () 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 Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
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)
'---------------------------------------------
'Working variables
Private OFN As OPENFILENAME
Private alCustom(0 To 15) As Long, fNotFirst As Boolean
Private m_dvmode As DevMode
Private piAction As Integer

'---------------------------------------------
'Public variables (Properties)
Public FileName As String
Attribute FileName.VB_VarDescription = "Returns/sets the path and filename of a selected file"
Public FileTitle As String
Attribute FileTitle.VB_VarDescription = "Returns the filename of a selected file."
Public DialogTitle As String
Attribute DialogTitle.VB_VarDescription = "Sets the string displayed in the title bar of the dialog box."
Public Filter As String
Attribute Filter.VB_VarDescription = "Returns/sets the filters that are displayed in the Type list box of a dialog box."
Public DefaultExt As String
Attribute DefaultExt.VB_VarDescription = "Returns/sets the default filename extension for the dialog box."
Public InitDir As String
Attribute InitDir.VB_VarDescription = "Returns/sets the initial file directory."
Public Color As OLE_COLOR
Attribute Color.VB_VarDescription = "Returns/sets the selected color"
Public Flags As Long
Attribute Flags.VB_VarDescription = "Sets the options for the dialog box."
Public FontName As String
Attribute FontName.VB_VarDescription = "Returns/sets the name of the selected font."
Public FontBold As Boolean
Attribute FontBold.VB_VarDescription = "Returns/sets bold font styles"
Public FontItalic As Boolean
Attribute FontItalic.VB_VarDescription = "Returns/sets italic font styles."
Public FontStrikeThru As Boolean
Attribute FontStrikeThru.VB_VarDescription = "Returns/sets strikethrough font styles."
Public FontUnderLine As Boolean
Attribute FontUnderLine.VB_VarDescription = "Returns/sets underline font styles."
Public FromPage As Integer
Attribute FromPage.VB_VarDescription = "Returns/sets the value for the first page to be printed."
Public ToPage As Integer
Attribute ToPage.VB_VarDescription = "Returns/sets the value for the last page to be printed."
Public Min As Integer
Attribute Min.VB_VarDescription = "Sets the minimum font size (Font dialog), or the minimum print range (Print dialog)."
Public Max As Integer
Attribute Max.VB_VarDescription = "Sets the maximum font size (Font dialog), or the maximum print range (Print dialog)."
Public Copies As Integer
Attribute Copies.VB_VarDescription = "Returns/sets the number of copies to be printed."
Public CancelError As Boolean
Attribute CancelError.VB_VarDescription = "Indicates whether an error is generated when the user chooses the Cancel button."
Public HelpFile As String
Attribute HelpFile.VB_VarDescription = "Returns/sets the name of the help file associated with the project."
Public HelpCommand As Integer
Attribute HelpCommand.VB_VarDescription = "Returns/sets the type of online help requested."
Public HelpKey As String
Attribute HelpKey.VB_VarDescription = "Returns/sets the keyword that identifies the requested help topic."
Public PrinterDefault As Boolean
Attribute PrinterDefault.VB_VarDescription = "Determines if the user selections in the Print dialog box are used to change the default printer settings."
Public FilterIndex As Integer
Attribute FilterIndex.VB_VarDescription = "Returns/sets a default filter for an Open or a Save As dialog box."
Public HelpContext As Long
Attribute HelpContext.VB_VarDescription = "Returns/sets the context ID of the requested help topic."
Public FontSize As Single
Attribute FontSize.VB_VarDescription = "Returns/sets the size (in points) of the selected font."
Private Const MaxFileSize As Integer = 256
Public Orientation As PrinterOrientationConstants
Attribute Orientation.VB_VarDescription = "Returns/sets printer paper orientation."

'---------------------------------------------
'Properties

Public Property Get Action() As Integer 'Returns/sets the type of dialog box to be displayed.
Attribute Action.VB_Description = "Returns/sets the type of dialog box to be displayed."
    Action = piAction
End Property

Public Property Let Action(RHS As Integer)  'Returns/sets the type of dialog box to be displayed.
    piAction = 0

    Select Case RHS

        Case 1  'Open
            ShowOpen

        Case 2  'Save
            ShowSave

        Case 3  'Color
            ShowColor

        Case 4  'Font