ccommondialog.cls

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

End Property
Public Property Get FontStrikethru() As Boolean
    'Return object's FontStrikethru property
    FontStrikethru = m_font.Strikethrough
End Property
Public Property Let FontStrikethru(ByVal vNewValue As Boolean)
    'Assign object's - property
    m_font.Strikethrough = vNewValue
End Property
Public Property Get FontUnderline() As Boolean
    'Return object's FontUnderline property
    FontUnderline = m_font.Underline
End Property
Public Property Let FontUnderline(ByVal vNewValue As Boolean)
    'Assign object's FontUnderline property
    m_font.Underline = vNewValue
End Property
Public Property Get Font() As StdFont
    Set Font = m_font
End Property
Public Property Let Font(sFont As StdFont)
    Set m_font = sFont
End Property
Public Property Get FontColor() As OLE_COLOR
    FontColor = m_oFontColor
End Property
Public Property Let FontColor(oColor As OLE_COLOR)
    m_oFontColor = oColor
End Property
Public Property Get FromPage() As Long
    'Return object's FromPAge property
    FromPage = m_lFromPage
End Property
Public Property Let FromPage(ByVal vNewValue As Long)
    'Assign object's FromPage property
    m_lFromPage = vNewValue
End Property
Public Property Get hWnd() As Long
    'Return object's hWnd property
    hWnd = m_lhWnd
End Property
Public Property Let hWnd(ByVal vNewValue As Long)
    'Assign object's hWnd property
    m_lhWnd = vNewValue
End Property
Public Property Get HelpCommand() As EShowHelpCommands
    'Return object's HelpCommand property
    HelpCommand = m_eHelpCommand
End Property
Public Property Let HelpCommand(ByVal vNewValue As EShowHelpCommands)
    'Assign object's HelpCommand property
    m_eHelpCommand = vNewValue
End Property
Public Property Get HelpContext() As String
    'Return object's HelpContext property
    HelpContext = m_sHelpContext
End Property
Public Property Let HelpContext(ByVal vNewValue As String)
    'Assign object's HelpContext property
    m_sHelpContext = vNewValue
End Property
Public Property Get HelpFile() As String
    'Return object's HelpFile property
    HelpFile = m_sHelpFile
End Property
Public Property Let HelpFile(ByVal vNewValue As String)
    'Assign object's HelpFile property
    m_sHelpFile = vNewValue
End Property
Public Property Get HelpKey() As String
    'Return object's HelpKey property
    HelpKey = m_sHelpKey
End Property
Public Property Let HelpKey(ByVal vNewValue As String)
    'Assign object's HelpKey property
    m_sHelpKey = vNewValue
End Property
Public Property Get InitDir() As String
    'Return object's InitDir property
    InitDir = m_sInitDir
End Property
Public Property Let InitDir(ByVal vNewValue As String)
    'Assign object's InitDir property
    m_sInitDir = vNewValue
End Property
Public Property Get Max() As Long
    'Return object's Max property
    Max = m_lMax
End Property
Public Property Let Max(ByVal vNewValue As Long)
    'Assign object's - property
    m_lMax = vNewValue
End Property
Public Property Get MaxFileSize() As Long
    'Return object's MaxFileSize property
    MaxFileSize = m_lMaxFileSize
End Property
Public Property Let MaxFileSize(ByVal vNewValue As Long)
    'Assign object's MaxFileSize property
    m_lMaxFileSize = vNewValue
End Property
Public Property Get Min() As Long
    'Return object's Min property
    Min = m_lMin
End Property
Public Property Let Min(ByVal vNewValue As Long)
    'Assign object's Min property
    m_lMin = vNewValue
End Property
Public Property Get Object() As Object
    'Return object's Object property
    Object = m_objObject
End Property
Public Property Let Object(ByVal vNewValue As Object)
    'Assign object's Object property
    Set m_objObject = vNewValue
End Property
Public Property Get PrinterDefault() As Integer
    'Return object's PrinterDefault property
    PrinterDefault = m_iPrinterDefault
End Property
Public Property Let PrinterDefault(ByVal vNewValue As Integer)
    'Assign object's PrinterDefault property
    m_iPrinterDefault = vNewValue
End Property
Public Property Get ToPage() As Long
    'Return object's ToPage property
    ToPage = m_lToPage
End Property
Public Property Let ToPage(ByVal vNewValue As Long)
    'Assign object's ToPage property
    m_lToPage = vNewValue
End Property
Public Property Get FileTitle() As String
    'return object's FileTitle property
    FileTitle = m_sFileTitle
End Property
Public Property Let FileTitle(ByVal vNewValue As String)
    'assign object's FileTitle property
    m_sFileTitle = vNewValue
End Property
Property Get CustomColor(ByVal i As Integer) As OLE_COLOR
    CustomColor = mCommonDialog.CustomColor(i)
End Property
Property Let CustomColor(ByVal i As Integer, oValue As OLE_COLOR)
    mCommonDialog.CustomColor(i) = oValue
End Property
Public Sub ShowOpen()
Dim bFileMustExist As Boolean
Dim bMultiSelect As Boolean
Dim bReadOnly As Boolean
Dim bHideReadOnly As Boolean

   m_bFileDialog = True
   bFileMustExist = FlagSet(m_lFlags, OFN_FILEMUSTEXIST)
   bMultiSelect = FlagSet(m_lFlags, OFN_ALLOWMULTISELECT)
   bReadOnly = FlagSet(m_lFlags, OFN_READONLY)
   bHideReadOnly = FlagSet(m_lFlags, OFN_HIDEREADONLY)
    
   If FlagSet(m_lFlags, OFN_ENABLETEMPLATE) Then
      If m_lhInstance < 1 Then
         m_lFlags = m_lFlags Xor OFN_ENABLETEMPLATE
      End If
   End If
    
   If (m_lFilterIndex = 0) Then m_lFilterIndex = 1
   
   If Not (mCommonDialog.VBGetOpenFileName2( _
      m_sFileName, _
      m_sFileTitle, _
      bFileMustExist, bMultiSelect, bReadOnly, bHideReadOnly, _
      m_sFilter, m_lFilterIndex, _
      m_sInitDir, _
      m_sDialogTitle, _
      m_sDefaultExt, _
      m_lhWnd, _
      m_lFlags, _
      m_bHookDialog, _
      m_lhInstance, m_lTemplateName, _
      Me)) Then
        pCommonDialogError
   End If
   
End Sub
Public Sub ShowSave()
Dim bOverWritePrompt As Boolean
    
   m_bFileDialog = True
   bOverWritePrompt = FlagSet(m_lFlags, OFN_OVERWRITEPROMPT)
   If FlagSet(m_lFlags, OFN_ENABLETEMPLATE) Then
      If m_lhInstance < 1 Then
         m_lFlags = m_lFlags Xor OFN_ENABLETEMPLATE
      End If
   End If
   If Not (mCommonDialog.VBGetSaveFileName2( _
      m_sFileName, _
      m_sFileTitle, _
      bOverWritePrompt, _
      m_sFilter, m_lFilterIndex, _
      m_sInitDir, _
      m_sDialogTitle, _
      m_sDefaultExt, _
      m_lhWnd, _
      m_lFlags, _
      m_bHookDialog, _
      m_lhInstance, m_lTemplateName, _
      Me)) Then
         pCommonDialogError
   End If
   
End Sub
Public Sub ShowColor()
Dim bAnyColor As Boolean
Dim bFullOpen As Boolean
Dim bDisableFullOpen As Boolean
Dim lColor As Long

    m_bFileDialog = False
    lColor = TranslateColor(m_oColor)
    bAnyColor = FlagSet(m_lFlags, CC_AnyColor)
    bFullOpen = FlagSet(m_lFlags, CC_FullOpen)
    bDisableFullOpen = FlagSet(m_lFlags, CC_PreventFullOpen)
    If Not (mCommonDialog.VBChooseColor( _
            lColor, _
            bAnyColor, bFullOpen, bDisableFullOpen, _
            m_lhWnd, m_lFlags, _
            m_bHookDialog, _
            Me)) Then
        pCommonDialogError
    Else
        m_oColor = lColor
    End If
End Sub
Public Sub ShowFont()
    m_bFileDialog = False
    If Not (mCommonDialog.VBChooseFont( _
        m_font, _
        -1, _
        m_lhWnd, _
        m_oFontColor, _
        m_lMin, _
        m_lMax, _
        m_lFlags, _
        m_bHookDialog, _
        Me)) Then
        pCommonDialogError
    End If
End Sub
Public Sub ShowPrinter()
Dim bDisablePageNumbers As Boolean
Dim bShowPrintToFile As Boolean
Dim bPrintToFile As Boolean
Dim bDisablePrintToFile As Boolean
Dim bCollate As Boolean
Dim bPreventWarning As Boolean
Dim bDisableSelection As Boolean
Dim ePR As EPrintRange
Dim iCopies As Integer

    m_bFileDialog = False
    iCopies = m_lCopies
    bDisablePageNumbers = Not (FlagSet(m_lFlags, PD_PAGENUMS))
    bDisableSelection = FlagSet(m_lFlags, PD_NOSELECTION)
    bShowPrintToFile = Not (FlagSet(m_lFlags, PD_HIDEPRINTTOFILE))
    bDisablePrintToFile = FlagSet(m_lFlags, PD_DISABLEPRINTTOFILE)
    bPrintToFile = FlagSet(m_lFlags, PD_PRINTTOFILE)
    bCollate = FlagSet(m_lFlags, PD_COLLATE)
    bPreventWarning = FlagSet(m_lFlags, PD_NOWARNING)
    
    If (mCommonDialog.VBPrintDlg( _
        m_hDC, _
        ePR, _
        bDisablePageNumbers, _
        m_lFromPage, _
        m_lToPage, _
        bDisableSelection, _
        iCopies, _
        bShowPrintToFile, _
        bDisablePrintToFile, _
        bPrintToFile, _
        bCollate, _
        bPreventWarning, _
        m_lhWnd, _
        m_objObject, _
        m_lFlags, _
        m_bHookDialog, _
        Me)) Then
        ' Success
        m_lCopies = iCopies
    End If
End Sub
Public Sub ShowHelp()
    'run winhelp.exe with the specified help file
    Dim sHelpFileBuff As String
    Dim lData As Long
    Dim lR As Long
    
    On Error GoTo ShowHelpError
    
    m_bFileDialog = False
    '***    prepare the buffers and parameters for the API function
    'sHelpFile is a null terminated string
    sHelpFileBuff = m_sHelpFile & Chr$(0)
    
    'sData is dependent on lHelpCommand
    Select Case m_eHelpCommand
    Case HELP_CONTEXT, HELP_CONTEXTPOPUP, HELP_SETCONTENTS, HELP_SETINDEX
        ' lData should be an unsigned long integer pointing to the context identifier
        
    Case HELP_COMMAND, HELP_PARTIALKEY
        ' lData is an address of a string
        
    Case HELP_CONTENTS, HELP_FORCEFILE, HELP_HELPONHELP, HELP_INDEX, HELP_QUIT
        ' lData is not required
        lData = 0
    Case HELP_SETWINPOS, HELP_MULTIKEY
        ' lData should point to a structure.  Can't call here - use separate functions to perform
        Err.Raise eeBaseCommonDialog + &HFF, App.EXEName, "Invalid WinHelp Command Passed to ShowHelp function."
    End Select
    
    '***    call the API function
    lR = WinHelp(m_lhWnd, m_sHelpFile, m_eHelpCommand, lData)    ' - Store to APIReturn property
    If (lR <> 0) Then
        ' Success
    Else
        Err.Raise LastApiError, App.EXEName & ".cCommonDialog", ApiError(LastApiError)
    End If
        
Exit Sub

ShowHelpError:
    Err.Raise Err.Number, App.EXEName & ".cCommonDialog"
    Exit Sub

End Sub
Public Property Get HookDialog() As Boolean
    HookDialog = m_bHookDialog
End Property
Public Property Let HookDialog(ByVal bHook As Boolean)
    m_bHookDialog = bHook
End Property
Private Function ApiError(ByVal e As Long) As String
    Dim s As String, c As Long
    s = String(256, 0)
    c = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or _
                      FORMAT_MESSAGE_IGNORE_INSERTS, _
                      0, e, 0&, s, Len(s), ByVal 0)
    If c Then ApiError = Left$(s, c)
End Function

Private Function LastApiError() As String
    LastApiError = ApiError(Err.LastDllError)
End Function
Private Function FlagSet(ByVal lWord As Long, ByVal lFlagValue As Long)
    FlagSet = ((lWord And lFlagValue) = lFlagValue)
End Function
Private Function TranslateColor(ByVal clr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(clr, hPal, TranslateColor) Then
        TranslateColor = -1
    End If
End Function
Private Sub pCommonDialogError()
    ' We have an error:
    If (mCommonDialog.APIReturn = 0) Then
        ' Cancelled:
        If (m_bCancelError) Then
            ' Note if your code stops here, that is because your error
            ' options in VB are "Break in Class Module".  Change your
            ' error option to "Break on Unhandled Errors" to see how
            ' this works at runtime.
            Err.Raise 20001, App.EXEName & ".cCommonDialog", "User selected cancel."
        End If
    Else
        Err.Raise eeBaseCommonDialog Or mCommonDialog.ExtendedError, App.EXEName & ".cCommonDialog"
    End If
End Sub
Private Sub Class_Initialize()
    m_lFilterIndex = 1
End Sub

Private Sub Class_Terminate()
    Set mCommonDialog = Nothing
End Sub

Public Property Get hInstance() As Long
    hInstance = m_lhInstance
End Property

Public Property Let hInstance(ByVal lNewValue As Long)
    m_lhInstance = lNewValue
End Property

Public Sub cdLoadLibrary(DllName As String)
    m_lhInstance = LoadLibrary(DllName)
End Sub

Public Sub cdFreeLibrary()
    If m_lhInstance > 0 Then FreeLibrary m_lhInstance
End Sub

Public Property Get TemplateName() As Long
    TemplateName = m_lTemplateName
End Property

Public Property Let TemplateName(ByVal lNewValue As Long)
    m_lTemplateName = lNewValue
End Property