frmfiledialogs.frm

程序设计了打开对话框和保存对话框.程序设计简明,代码完整.

VERSION 4.00
Begin VB.Form frmFileDialogs 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "32-Bit File Dialog APIs"
   ClientHeight    =   1755
   ClientLeft      =   1755
   ClientTop       =   2070
   ClientWidth     =   3435
   Height          =   2445
   Icon            =   "frmFileDialogs.frx":0000
   Left            =   1695
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1755
   ScaleWidth      =   3435
   Top             =   1440
   Width           =   3555
   Begin VB.Label Label2 
      Caption         =   "By David Warren MMC Software CompuServe: 72500,1406 or [e-mail]"
      ForeColor       =   &H00800000&
      Height          =   615
      Left            =   300
      TabIndex        =   1
      Top             =   1020
      Width           =   2775
   End
   Begin VB.Label Label1 
      Caption         =   "Sample in Visual Basic 4 (32-bit) demonstrating the use of GetOpenFileName and GetSaveFileName"
      ForeColor       =   &H00800000&
      Height          =   795
      Left            =   300
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileOpenDialog 
         Caption         =   "&Open..."
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuFileSaveAsDialog 
         Caption         =   "Save &as..."
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuSeparator 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExitApp 
         Caption         =   "E&xit"
         Shortcut        =   ^X
      End
   End
End
Attribute VB_Name = "frmFileDialogs"
Attribute VB_Creatable = False
Attribute VB_Exposed = False


Private Sub mnuFileExitApp_Click()

    On Error GoTo mnuFileExitApp_Click_Error
    
    Unload Me
    End
    
mnuFileExitApp_Click_Exit:
    Exit Sub
    
mnuFileExitApp_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileExitApp_Click"
    Resume mnuFileExitApp_Click_Exit
    
End Sub


Private Sub mnuFileOpenDialog_Click()

    On Error GoTo mnuFileOpenDialog_Click_Error
    Dim file As OPENFILENAME, sFile As String, sFileTitle As String, lResult As Long, iDelim As Integer
    
    file.lStructSize = Len(file)
    file.hwndOwner = Me.hWnd
    file.Flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
    'wildcard to display, returns with selected path\file
    file.lpstrFile = "*.exe" & String$(250, 0)
    file.nMaxFile = 255
    'returns with just file name
    file.lpstrFileTitle = String$(255, 0)
    file.nMaxFileTitle = 255
    'set the initial directory, otherwise uses current
    file.lpstrInitialDir = Environ$("WinDir")
    'file type filter
    file.lpstrFilter = "Programs" & Chr$(0) & "*.EXE;*.COM;*.BAT" & Chr$(0) & "MS Word Documents" & Chr$(0) & "*.DOC" & Chr$(0) & Chr$(0)
    file.nFilterIndex = 1
    'dialog title
    file.lpstrTitle = "Open"

    lResult = GetOpenFileName(file)
    If lResult <> 0 Then
        iDelim = InStr(file.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            sFileTitle = Left$(file.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(file.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            sFile = Left$(file.lpstrFile, iDelim - 1)
        End If
        'file.nFileOffset is the number of characters from the beginning of the
        '  full path to the start of the file name
        'file.nFileExtension is the number of characters from the beginning of the
        '  full path to the file's extention, including the (.)
        MsgBox "File Name is " & sFileTitle & Chr$(13) & Chr$(10) & "Full path and file is " & sFile, , "Open"
    End If

mnuFileOpenDialog_Click_Exit:
    Exit Sub
    
mnuFileOpenDialog_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileOpenDialog_Click"
    Resume mnuFileOpenDialog_Click_Exit
    
End Sub


Private Sub mnuFileSaveAsDialog_Click()

    On Error GoTo mnuFileSaveAsDialog_Click_Error
        Dim file As OPENFILENAME, sFile As String, sFileTitle As String, lResult As Long, iDelim As Integer
    
    file.lStructSize = Len(file)
    file.hwndOwner = Me.hWnd
    file.Flags = OFN_HIDEREADONLY + OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT
    'If you have a starting file name, put it here, padded with Chr$(0) to make
    'a buffer large enough for return
    file.lpstrFile = String$(255, 0)
    file.nMaxFile = 255
    'returns with just file name
    file.lpstrFileTitle = String$(255, 0)
    file.nMaxFileTitle = 255
    'set the initial directory, otherwise uses current
    file.lpstrInitialDir = Environ$("WinDir")
    'file type filter
    file.lpstrFilter = "Text Files" & Chr$(0) & "*.TXT" & Chr$(0) & Chr$(0)
    file.nFilterIndex = 1
    'dialog title
    file.lpstrTitle = "Save As..."
    'you can provide a default extension; appended if user types none
    file.lpstrDefExt = "TXT"
    
    lResult = GetSaveFileName(file)
    If lResult <> 0 Then
        'file.nFileOffset is the number of characters from the beginning of the
        '  full path to the start of the file name
        'file.nFileExtension is the number of characters from the beginning of the
        '  full path to the file's extention, including the (.)
        iDelim = InStr(file.lpstrFileTitle, Chr$(0))
        If iDelim > 0 Then
            sFileTitle = Left$(file.lpstrFileTitle, iDelim - 1)
        End If
        iDelim = InStr(file.lpstrFile, Chr$(0))
        If iDelim > 0 Then
            sFile = Left$(file.lpstrFile, iDelim - 1)
        End If
        MsgBox "File Name is " & sFileTitle & Chr$(13) & Chr$(10) & "Full path and file is " & sFile, , "Save As..."
    End If

mnuFileSaveAsDialog_Click_Exit:
    Exit Sub
    
mnuFileSaveAsDialog_Click_Error:
    MsgBox "Error: " & Format$(Err) & " " & Error$, , "mnuFileSaveAsDialog_Click"
    Resume mnuFileSaveAsDialog_Click_Exit
    
End Sub