carmy
路人甲
路人甲
  • 注册日期2003-12-06
  • 发帖数86
  • QQ109807460
  • 铜币394枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1732回复:1

通用对话框专辑之(二)

楼主#
更多 发布于:2004-02-10 19:52
通用对话框专辑之(二)


     使用API调用Winodws各种通用对话框(Common Diaglog)的方法:
1.选择目录/文件夹对话框
将以下代码置于一模块中
Option Explicit
' 调用方式:: string = BrowseForFolders(Hwnd,TitleOfDialog)
' 例如:String1 = BrowseForFolders(Hwnd, "Select target folder...")
Public Type BrowseInfo
     hwndOwner As Long
     pIDLRoot As Long
     pszDisplayName As Long
     lpszTitle As Long
     ulFlags As Long
     lpfnCallback As Long
     lParam As Long
     iImage As Long
End Type
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo
    '初始化变量
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With
    '调用 API
     lpIDList = SHBrowseForFolder(udtBI)
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
     End If
    '如果选择取消, sPath = ""
     BrowseForFolder = sPath
End Function
2.调用"映射网络驱动器"对话框
Private/Public Declare Function WNetConnectionDialog Lib "mpr.dll" _
(ByVal hwnd As Long, ByVal dwType As Long) As Long
x% = WNetConnectionDialog(Me.hwnd, 1)
3.调用"打开文件"对话框
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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
将以下代码置于某一事件中
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = Form1.hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = "Text Files (*.txt)" + Chr$(0) + "*.txt" + Chr$(0) + "Rich Text Files (*.rtf)" + Chr$(0) + "*.rtf" + Chr$(0)
        ofn.lpstrFile = Space$(254)
        ofn.nMaxFile = 255
        ofn.lpstrFileTitle = Space$(254)
        ofn.nMaxFileTitle = 255
        ofn.lpstrInitialDir = curdir
        ofn.lpstrTitle = "Our File Open Title"
        ofn.flags = 0
        Dim a
        a = GetOpenFileName(ofn)
        If (a) Then
                MsgBox "File to Open: " + Trim$(ofn.lpstrFile)
        Else
                MsgBox "Cancel was pressed"
        End If
4.调用"打印"对话框
Private Type PrintDlg
        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 Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long
'将以下代码置于某一事件中
    Dim tPrintDlg As PrintDlg
    tPrintDlg.lStructSize = Len(tPrintDlg)
    tPrintDlg.hwndOwner = Me.hwnd
    tPrintDlg.hdc = hdc
    tPrintDlg.flags = 0
    tPrintDlg.nFromPage = 0
    tPrintDlg.nToPage = 0
    tPrintDlg.nMinPage = 0
    tPrintDlg.nMaxPage = 0
    tPrintDlg.nCopies = 1
    tPrintDlg.hInstance = App.hInstance
    lpPrintTemplateName = "Print Page"
    Dim a
    a = PrintDlg(tPrintDlg)
    If a Then
            lFromPage = tPrintDlg.nFromPage
            lToPage = tPrintDlg.nToPage
            lMin = tPrintDlg.nMinPage
            lMax = tPrintDlg.nMaxPage
            lCopies = tPrintDlg.nCopies
   PrintMyPage 'Custom printing Subroutine    
    End If
  
      

喜欢0 评分0
huangzuowei1
路人甲
路人甲
  • 注册日期2003-12-22
  • 发帖数862
  • QQ102995869
  • 铜币2229枚
  • 威望0点
  • 贡献值0点
  • 银元0个
1楼#
发布于:2004-03-10 14:38
very doodle
举报 回复(0) 喜欢(0)     评分
游客

返回顶部