为什么要用API,用COMMONDIALOG不就可以吗?

解决方案 »

  1.   

    用api就可以不用公共对话框控件啊。
      

  2.   

    ' 回复人:wjq(b_wind) (2001-3-10 23:27:00)  得0分
    '建议用WinAPI
    'This project needs 6 command buttonsOption Explicit
    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 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
    Const LF_FACESIZE = 32
    Const CCHDEVICENAME = 32
    Const CCHFORMNAME = 32
    Const GMEM_MOVEABLE = &H2
    Const GMEM_ZEROINIT = &H40
    Const DM_DUPLEX = &H1000&
    Const DM_ORIENTATION = &H1&
    Const PD_PRINTSETUP = &H40
    Const PD_DISABLEPRINTTOFILE = &H80000
    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 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 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          '  ptr. To a LOGFONT struct
            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 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
      

  3.   

    Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
    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_TYPE) As Long
    Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
    Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy 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 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
    Dim OFName As OPENFILENAME
    Dim CustomColors() As Byte
    Private Sub Command1_Click()
        Dim sFile As String
        sFile = ShowOpen
        If sFile <> "" Then
            MsgBox "You chose this file: " + sFile
        Else
            MsgBox "You pressed cancel"
        End If
    End Sub
    Private Sub Command2_Click()
        Dim sFile As String
        sFile = ShowSave
        If sFile <> "" Then
            MsgBox "You chose this file: " + sFile
        Else
            MsgBox "You pressed cancel"
        End If
    End Sub
    Private Sub Command3_Click()
        Dim NewColor As Long
        NewColor = ShowColor
        If NewColor <> -1 Then
            Me.BackColor = NewColor
        Else
            MsgBox "You chose cancel"
        End If
    End Sub
    Private Sub Command4_Click()
        MsgBox ShowFont
    End Sub
    Private Sub Command5_Click()
        ShowPrinter Me
    End Sub
    Private Sub Command6_Click()
        ShowPageSetupDlg
    End Sub
    Private Sub Form_Load()
        'KPD-Team 1998
        'URL: http://www.allapi.net/
        'E-Mail: [email protected]
        'Redim the variables to store the cutstom colors
        ReDim CustomColors(0 To 16 * 4 - 1) As Byte
        Dim I As Integer
        For I = LBound(CustomColors) To UBound(CustomColors)
            CustomColors(I) = 0
        Next I
        'Set the captions
        Command1.Caption = "ShowOpen"
        Command2.Caption = "ShowSave"
        Command3.Caption = "ShowColor"
        Command4.Caption = "ShowFont"
        Command5.Caption = "ShowPrinter"
        Command6.Caption = "ShowPageSetupDlg"
    End Sub
    Private Function ShowColor() As Long
        Dim cc As CHOOSECOLOR
        Dim Custcolor(16) As Long
        Dim lReturn As Long    'set the structure size
        cc.lStructSize = Len(cc)
        'Set the owner
        cc.hwndOwner = Me.hWnd
        'set the application's instance
        cc.hInstance = App.hInstance
        'set the custom colors (converted to Unicode)
        cc.lpCustColors = StrConv(CustomColors, vbUnicode)
        'no extra flags
        cc.flags = 0    'Show the 'Select Color'-dialog
        If CHOOSECOLOR(cc) <> 0 Then
            ShowColor = cc.rgbResult
            CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
        Else
            ShowColor = -1
        End If
    End Function
    Private Function ShowOpen() As String
        'Set the structure size
        OFName.lStructSize = Len(OFName)
        'Set the owner window
        OFName.hwndOwner = Me.hWnd
        'Set the application's instance
        OFName.hInstance = App.hInstance
        'Set the filet
        OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
        'Create a buffer
        OFName.lpstrFile = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFile = 255
        'Create a buffer
        OFName.lpstrFileTitle = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFileTitle = 255
        'Set the initial directory
        OFName.lpstrInitialDir = "C:\"
        'Set the dialog title
        OFName.lpstrTitle = "Open File - KPD-Team 1998"
        'no extra flags
        OFName.flags = 0    'Show the 'Open File'-dialog
        If GetOpenFileName(OFName) Then
            ShowOpen = Trim$(OFName.lpstrFile)
        Else
            ShowOpen = ""
        End If
    End Function
    Private Function ShowFont() As String
        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 = Form1.hWnd  ' 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 = 10  ' 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.
        retval = CHOOSEFONT(cf)  ' open the dialog box
        If retval <> 0 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.
            ShowFont = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
            Debug.Print  ' end the line
        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
      

  4.   

    Private Function ShowSave() As String
        'Set the structure size
        OFName.lStructSize = Len(OFName)
        'Set the owner window
        OFName.hwndOwner = Me.hWnd
        'Set the application's instance
        OFName.hInstance = App.hInstance
        'Set the filet
        OFName.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
        'Create a buffer
        OFName.lpstrFile = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFile = 255
        'Create a buffer
        OFName.lpstrFileTitle = Space$(254)
        'Set the maximum number of chars
        OFName.nMaxFileTitle = 255
        'Set the initial directory
        OFName.lpstrInitialDir = "C:\"
        'Set the dialog title
        OFName.lpstrTitle = "Save File - KPD-Team 1998"
        'no extra flags
        OFName.flags = 0    'Show the 'Save File'-dialog
        If GetSaveFileName(OFName) Then
            ShowSave = Trim$(OFName.lpstrFile)
        Else
            ShowSave = ""
        End If
    End Function
    Private Function ShowPageSetupDlg() As Long
        Dim m_PSD As PAGESETUPDLG
        'Set the structure size
        m_PSD.lStructSize = Len(m_PSD)
        'Set the owner window
        m_PSD.hwndOwner = Me.hWnd
        'Set the application instance
        m_PSD.hInstance = App.hInstance
        'no extra flags
        m_PSD.flags = 0    'Show the pagesetup dialog
        If PAGESETUPDLG(m_PSD) Then
            ShowPageSetupDlg = 0
        Else
            ShowPageSetupDlg = -1
        End If
    End Function
    Public Sub ShowPrinter(frmOwner As Form, Optional PrintFlags As Long)
        '-> Code by Donald Grover
        Dim PrintDlg As PRINTDLG_TYPE
        Dim DevMode As DEVMODE_TYPE
        Dim DevName As DEVNAMES_TYPE    Dim lpDevMode As Long, lpDevName As Long
        Dim bReturn As Integer
        Dim objPrinter As Printer, NewPrinterName As String    ' Use PrintDialog to get the handle to a memory
        ' block with a DevMode and DevName structures    PrintDlg.lStructSize = Len(PrintDlg)
        PrintDlg.hwndOwner = frmOwner.hWnd    PrintDlg.flags = PrintFlags
        On Error Resume Next
        'Set the current orientation and duplex setting
        DevMode.dmDeviceName = Printer.DeviceName
        DevMode.dmSize = Len(DevMode)
        DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
        DevMode.dmPaperWidth = Printer.Width
        DevMode.dmOrientation = Printer.Orientation
        DevMode.dmPaperSize = Printer.PaperSize
        DevMode.dmDuplex = Printer.Duplex
        On Error GoTo 0    'Allocate memory for the initialization hDevMode structure
        'and copy the settings gathered above into this memory
        PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
        lpDevMode = GlobalLock(PrintDlg.hDevMode)
        If lpDevMode > 0 Then
            CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
            bReturn = GlobalUnlock(PrintDlg.hDevMode)
        End If    'Set the current driver, device, and port name strings
        With DevName
            .wDriverOffset = 8
            .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
            .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
            .wDefault = 0
        End With    With Printer
            DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Ch
    r (0)
        End With    'Allocate memory for the initial hDevName structure
        'and copy the settings gathered above into this memory
        PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        If lpDevName > 0 Then
            CopyMemory ByVal lpDevName, DevName, Len(DevName)
            bReturn = GlobalUnlock(lpDevName)
        End If    'Call the print dialog up and let the user make changes
        If PrintDialog(PrintDlg) <> 0 Then        'First get the DevName structure.
            lpDevName = GlobalLock(PrintDlg.hDevNames)
            CopyMemory DevName, ByVal lpDevName, 45
            bReturn = GlobalUnlock(lpDevName)
            GlobalFree PrintDlg.hDevNames        'Next get the DevMode structure and set the printer
            'properties appropriately
            lpDevMode = GlobalLock(PrintDlg.hDevMode)
            CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
            bReturn = GlobalUnlock(PrintDlg.hDevMode)
            GlobalFree PrintDlg.hDevMode
            NewPrinterName = UCase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
            If Printer.DeviceName <> NewPrinterName Then
                For Each objPrinter In Printers
                    If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                        Set Printer = objPrinter
                        'set printer toolbar name at this point
                    End If
                Next
            End If        On Error Resume Next
            'Set printer object properties according to selections made
            'by user
            Printer.Copies = DevMode.dmCopies
            Printer.Duplex = DevMode.dmDuplex
            Printer.Orientation = DevMode.dmOrientation
            Printer.PaperSize = DevMode.dmPaperSize
            Printer.PrintQuality = DevMode.dmPrintQuality
            Printer.ColorMode = DevMode.dmColor
            Printer.PaperBin = DevMode.dmDefaultSource
            On Error GoTo 0
        End If
    End Sub
    '以上的代码支持ComDlg的几乎所有方法
      

  5.   

    太长
    hehe
    我放到
    http://pie.51.net/a.htm
      

  6.   

    Private  Declare  Function  CHOOSECOLOR  Lib  "comdlg32.dll"  Alias  "ChooseColorA"  (pChoosecolor  As  CHOOSECOLOR)  As  Long 
    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_TYPE)  As  Long 
    Private  Declare  Function  PAGESETUPDLG  Lib  "comdlg32.dll"  Alias  "PageSetupDlgA"  (pPagesetupdlg  As  PAGESETUPDLG)  As  Long 
    Private  Declare  Function  CHOOSEFONT  Lib  "comdlg32.dll"  Alias  "ChooseFontA"  (pChoosefont  As  CHOOSEFONT)  As  Long 
      

  7.   

    Option Explicit
    '对话框
    Public Declare Function GetOpenFileName _
            Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
            (pOpenfilename As OPENFILENAME) As Long
    Public Declare Function GetSaveFileName _
            Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
            (pOpenfilename As OPENFILENAME) As Long
    Public Declare Function SHBrowseForFolder _
            Lib "shell32.dll" Alias "SHBrowseForFolderA" _
            (lpBrowseInfo As BROWSEINFO) As Long
    Public Declare Function SHGetPathFromIDList _
            Lib "shell32.dll" _
            (ByVal pidl As Long, _
            pszPath As String) As Long
    Public Declare Function CHOOSECOLOR _
            Lib "comdlg32.dll" Alias "ChooseColorA" _
            (pChoosecolor As CHOOSECOLOR) As LongPublic 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 TypePublic Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlage As Long
        lpfn As Long
        lparam As Long
        iImage As Long
    End TypePrivate 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 TypePublic Const OFN_HIDEREADONLY = &H4 '隐藏只读打开
    Public Const OFN_READONLY = &H1 '只读打开为选中
    Public Const OFN_OVERWRITEPROMPT = &H2 '覆盖时提示
    Public Const OFN_ALLOWMULTISELECT = &H200 '多个选中
    Public Const OFN_EXPLORER = &H80000 '资源管理器Public Function ShowOpen(MehWnd As Long, _
            FileOpen As String, _
            Optional Title As String = "打开:", _
            Optional Filter As String = vbNullChar + vbNullChar, _
            Optional FilterIndex As Long = 0, _
            Optional StartDir As String = vbNullChar, _
            Optional flags As Long = OFN_HIDEREADONLY) As Long
        Dim OpenFN As OPENFILENAME
        Dim Rc As Long
        
        With OpenFN
            .hwndOwner = MehWnd
            .hInstance = App.hInstance
            .lpstrTitle = Title
            .lpstrFilter = Filter
            .nFilterIndex = FilterIndex
            .lpstrInitialDir = StartDir
            .lpstrFile = String$(256, 0)
            .nMaxFile = 255
            .lpstrFileTitle = .lpstrFile
            .nMaxFileTitle = 255
            .flags = flags
            .lStructSize = Len(OpenFN)
            
        End With
        
        Rc = GetOpenFileName(OpenFN)
        
        If Rc Then
            FileOpen = Left$(OpenFN.lpstrFile, OpenFN.nMaxFile)
            ShowOpen = True
            
        Else
            ShowOpen = False
            
        End If
        
    End FunctionPublic Function ShowSave(MehWnd As Long, _
            FileSave As String, _
            Optional Title As String = "保存:", _
            Optional Filter As String = vbNullChar + vbNullChar, _
            Optional FilterIndex As Long = 0, _
            Optional StartDir As String = vbNullChar, _
            Optional flags As Long = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT) As Long
        Dim SaveFN As OPENFILENAME
        Dim Rc As Long
        
        With SaveFN
            .hwndOwner = MehWnd
            .hInstance = App.hInstance
            .lpstrTitle = Title
            .lpstrFilter = Filter
            .nFilterIndex = FilterIndex
            .lpstrInitialDir = StartDir
            .lpstrFile = FileSave + String$(255, Chr$(0))
            .nMaxFile = Len(.lpstrFile)
            .lpstrFileTitle = .lpstrFile
            .nMaxFileTitle = 255
            .flags = flags
            .lStructSize = Len(SaveFN)
            
        End With
        
        Rc = GetSaveFileName(SaveFN)
        
        If Rc Then
            FileSave = Left$(SaveFN.lpstrFile, SaveFN.nMaxFile)
            ShowSave = True
            
        Else
            ShowSave = False
            
        End If
        
    End FunctionPublic Function ShowDir(MehWnd As Long, _
            DirPath As String, _
            Optional Title As String = "请选择文件夹:", _
            Optional flage As Long = &H1, _
            Optional DirID As Long) As Long
        Dim BI As BROWSEINFO
        Dim TempID As Long
        Dim TempStr As String
        
        TempStr = String$(255, Chr$(0))
        With BI
            .hOwner = MehWnd
            .pidlRoot = 0
            .lpszTitle = Title + Chr$(0)
            .ulFlage = flage
            
        End With
        
        TempID = SHBrowseForFolder(BI)
        DirID = TempID
        
        If SHGetPathFromIDList(ByVal TempID, ByVal TempStr) Then
            DirPath = Left$(TempStr, InStr(TempStr, Chr$(0)) - 1)
            ShowDir = -1
            
        Else
            ShowDir = 0
            
        End If
        
    End FunctionPublic Function ShowColor(MehWnd As Long, _
            GetColour As Long, _
            Optional flags As Long = 0)
        Dim CC As CHOOSECOLOR
        Dim Rc As Long
        Dim CustC() As Byte
        
        With CC
            .hwndOwner = MehWnd
            .hInstance = App.hInstance
            .lpCustColors = StrConv(CustC, vbUnicode)
            .rgbResult = GetColour
            .flags = flags
            .lStructSize = Len(CC)
            
        End With
        
        Rc = CHOOSECOLOR(CC)
        
        If Rc Then
            GetColour = CC.rgbResult
            ShowColor = -1
            
        Else
            ShowColor = 0
            
        End If
        
    End Function