epcmdlg.ctl

多功能文档编辑器源代码,用VC++开发,适合编程人员参考使用。

VERSION 5.00
Begin VB.UserControl ceCmDlg 
   ClientHeight    =   1545
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2880
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   1545
   ScaleWidth      =   2880
   ToolboxBitmap   =   "epCmDlg.ctx":0000
   Begin VB.Image imgLogo 
      Height          =   480
      Left            =   960
      Picture         =   "epCmDlg.ctx":0312
      Stretch         =   -1  'True
      Top             =   480
      Width           =   480
   End
End
Attribute VB_Name = "ceCmDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False


Option Explicit

' Win32 Declarations for the Common Dialog
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 CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PageSetupDlg) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long

' Win32 Declarations for the ShowFont function
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 Const LF_FACESIZE = 32
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

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 CHOOSEFONT
    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 String
    hInstance As Long
    lpszStyle As String
    nFontType As Integer
    MISSING_ALIGNMENT As Integer
    nSizeMin As Long
    nSizeMax As Long
End Type

Private Type ChooseColor
    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 String
End Type

Private Type PRINTDLG_TYPE
    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 DEVNAMES_TYPE
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    extra As String * 100
End Type

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

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 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

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

' Constants for the common dialog
Private Const OFN_ALLOWMULTISELECT = &H200  'Allow multi select (Open Dialog)
Private Const OFN_EXPLORER = &H80000        'Set windows style explorer
Private Const OFN_FILEMUSTEXIST = &H1000    'File must exist
Private Const OFN_HIDEREADONLY = &H4        'Hide read-only check box (Open Dialog)
Private Const OFN_OVERWRITEPROMPT = &H2     'Promt beafore overwritning file (Save Dialog)
Private Const OFN_PATHMUSTEXIST = &H800     'Path must exist
Private Const CF_PRINTERFONTS = &H2
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_EFFECTS = &H100&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const DEFAULT_CHARSET = 1
Private Const DEFAULT_PITCH = 0
Private Const DEFAULT_QUALITY = 0
Private Const FW_BOLD = 700
Private Const FF_ROMAN = 16      '  Variable stroke width, serifed.
Private Const FW_NORMAL = 400
Private Const CLIP_DEFAULT_PRECIS = 0
Private Const OUT_DEFAULT_PRECIS = 0
Private Const REGULAR_FONTTYPE = &H400
Private Const DM_DUPLEX = &H1000&
Private Const DM_ORIENTATION = &H1&

' Constants for the GlobalAllocate
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40

Private Const MAX_PATH = 260 'Constant for maximum path

Public cFileName As Collection   'Filename collection
Public cFileTitle As Collection  'Filetitle collection

' Default Property Values:
Const m_def_CancelError = 0
Const m_def_Filename = ""
Const m_def_DialogTitle = ""
Const m_def_InitialDir = ""
Const m_def_Filter = ""
Const m_def_FilterIndex = 1
Const m_def_MultiSelect = 0
Const m_def_FontName = "Arial"
Const m_def_FontSize = 10
Const m_def_FontColor = 0
Const m_def_FontBold = 0
Const m_def_FontItalic = 0
Const m_def_FontUnderline = 0
Const m_def_FontStrikeThru = 0

' Property Variables:
Dim m_CancelError As Boolean
Dim m_Filename As String
Dim m_DialogTitle As String
Dim m_InitialDir As String
Dim m_Filter As String
Dim m_FilterIndex As Integer
Dim m_MultiSelect As Boolean
Dim m_FontName As String
Dim m_FontSize As Integer
Dim m_FontColor As Long
Dim m_FontBold As Boolean
Dim m_FontItalic As Boolean
Dim m_FontUnderline As Boolean
Dim m_FontStrikeThru As Boolean

'***** CANCEL ERROR
Public Property Get CancelError() As Boolean
    CancelError = m_CancelError
End Property
Public Property Let CancelError(ByVal New_CancelError As Boolean)
    m_CancelError = New_CancelError
    PropertyChanged "CancelError"
End Property
'***** MULTI SELECT
Public Property Get MultiSelect() As Boolean
    MultiSelect = m_MultiSelect
End Property
Public Property Let MultiSelect(ByVal New_MultiSelect As Boolean)
    m_MultiSelect = New_MultiSelect
    PropertyChanged "MultiSelect"
End Property
'***** DEFAULT FILENAME
Public Property Get DefaultFilename() As String
Attribute DefaultFilename.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    DefaultFilename = m_Filename
End Property
Public Property Let DefaultFilename(ByVal New_Filename As String)
    m_Filename = New_Filename
    PropertyChanged "DefaultFilename"
End Property
'***** DIALOG TITLE
Public Property Get DialogTitle() As String
Attribute DialogTitle.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    DialogTitle = m_DialogTitle
End Property
Public Property Let DialogTitle(ByVal New_DialogTitle As String)
    m_DialogTitle = New_DialogTitle
    PropertyChanged "DialogTitle"
End Property
'***** INITIAL DIRECTORY
Public Property Get InitialDir() As String
    InitialDir = m_InitialDir
End Property
Public Property Let InitialDir(ByVal New_InitialDir As String)
    m_InitialDir = New_InitialDir
    PropertyChanged "InitialDir"
End Property
'***** FILTER
Public Property Get Filter() As String
    Filter = m_Filter
End Property
Public Property Let Filter(ByVal New_Filter As String)
    m_Filter = New_Filter
    PropertyChanged "Filter"
End Property
'***** FILTER INDEX
Public Property Get FilterIndex() As Integer
    FilterIndex = m_FilterIndex
End Property
Public Property Let FilterIndex(ByVal New_FilterIndex As Integer)
    m_FilterIndex = New_FilterIndex
    PropertyChanged "FilterIndex"
End Property
'***** FONT NAME
Public Property Get FontName() As String
    FontName = m_FontName
End Property
Public Property Let FontName(ByVal New_FontName As String)
    m_FontName = New_FontName
End Property
'***** FONT SIZE
Public Property Get FontSize() As Integer
    FontSize = m_FontSize
End Property
Public Property Let FontSize(ByVal New_FontSize As Integer)
    m_FontSize = New_FontSize
End Property
'***** FONT COLOR
Public Property Get FontColor() As Long
    FontColor = m_FontColor
End Property
Public Property Let FontColor(ByVal New_FontColor As Long)
    m_FontColor = New_FontColor
End Property
'***** FONT BOLD
Public Property Get FontBold() As Boolean
    FontBold = m_FontBold
End Property
Public Property Let FontBold(ByVal New_FontBold As Boolean)
    m_FontBold = New_FontBold
End Property
'***** FONT ITALIC
Public Property Get FontItalic() As Boolean
    FontItalic = m_FontItalic
End Property
Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
    m_FontItalic = New_FontItalic
End Property
'***** FONT UNDERLINE
Public Property Get FontUnderline() As Boolean
    FontUnderline = m_FontUnderline
End Property
Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
    m_FontUnderline = New_FontUnderline
End Property
'***** FONT STRIKETHRU
Public Property Get FontStrikeThru() As Boolean
    FontStrikeThru = m_FontStrikeThru
End Property
Public Property Let FontStrikeThru(ByVal New_FontStrikeThru As Boolean)
    m_FontStrikeThru = New_FontStrikeThru
End Property

Private Sub UserControl_Initialize()
    UserControl_Resize
End Sub
' Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    m_CancelError = m_def_CancelError
    m_Filename = m_def_Filename
    m_DialogTitle = m_def_DialogTitle
    m_InitialDir = m_def_InitialDir
    m_Filter = m_def_Filter
    m_FilterIndex = m_def_FilterIndex
    m_MultiSelect = m_def_MultiSelect
    m_FontName = m_def_FontName
    m_FontSize = m_def_FontSize
    m_FontColor = m_def_FontColor
    m_FontBold = m_def_FontBold
    m_FontItalic = m_def_FontItalic
    m_FontUnderline = m_def_FontUnderline
    m_FontStrikeThru = m_def_FontStrikeThru
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    m_CancelError = PropBag.ReadProperty("CancelError", m_def_CancelError)
    m_Filename = PropBag.ReadProperty("DefaultFilename", m_def_Filename)