Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/fileopen/fileopen.frm

Visual Basic Form | 1995-05-08 | 11.3 KB | 343 lines

VERSION 2.00
Begin Form FileOpen
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3120
   ClientLeft      =   1560
   ClientTop       =   1770
   ClientWidth     =   5580
   Height          =   3525
   Icon            =   FILEOPEN.FRX:0000
   Left            =   1500
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3120
   ScaleWidth      =   5580
   Top             =   1425
   Width           =   5700
   Begin DriveListBox DriveDropDown
      Height          =   315
      Left            =   780
      TabIndex        =   9
      Top             =   2700
      Width           =   3555
   End
   Begin PictureBox FileOpenIcon
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   4725
      Picture         =   FILEOPEN.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   2115
      Width           =   495
   End
   Begin CommandButton NewButton
      Caption         =   "&None"
      Height          =   480
      Left            =   4440
      TabIndex        =   12
      Top             =   1305
      Width           =   1080
   End
   Begin DirListBox DirListBox
      Height          =   1605
      Left            =   2040
      TabIndex        =   7
      Top             =   1005
      Width           =   2295
   End
   Begin FileListBox FileListBox
      Height          =   1785
      Left            =   120
      TabIndex        =   4
      Top             =   825
      Width           =   1815
   End
   Begin CommandButton CancelButton
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   480
      Left            =   4440
      TabIndex        =   11
      Top             =   720
      Width           =   1080
   End
   Begin CommandButton OKButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   480
      Left            =   4440
      TabIndex        =   10
      Top             =   120
      Width           =   1080
   End
   Begin TextBox FileSpecBox
      Height          =   300
      Left            =   960
      TabIndex        =   2
      Text            =   "*.*"
      Top             =   120
      Width           =   3390
   End
   Begin Label DriveDropDownLabel
      Caption         =   "Dri&ves:"
      Height          =   225
      Left            =   120
      TabIndex        =   8
      Top             =   2745
      Width           =   615
   End
   Begin Label AboutLabel
      Caption         =   "About"
      Height          =   195
      Left            =   4710
      TabIndex        =   0
      Top             =   2610
      Width           =   555
   End
   Begin Label CurDirLabel
      Caption         =   "CurDirLabel"
      Height          =   225
      Left            =   2040
      TabIndex        =   6
      Top             =   750
      Width           =   2295
   End
   Begin Label DirListLabel
      Caption         =   "&Directories:"
      Height          =   225
      Left            =   2040
      TabIndex        =   5
      Top             =   510
      Width           =   975
   End
   Begin Label FileListLabel
      Caption         =   "Fi&les:"
      Height          =   225
      Left            =   120
      TabIndex        =   3
      Top             =   525
      Width           =   495
   End
   Begin Label FileSpecLabel
      Alignment       =   1  'Right Justify
      Caption         =   "&Filename:"
      Height          =   225
      Left            =   120
      TabIndex        =   1
      Top             =   150
      Width           =   825
   End
Sub AboutLabel_Click ()
    FileOpenIcon_Click
End Sub
Sub CancelButton_Click ()
    Unload FileOpen
End Sub
Sub Command1_Click ()
    FileOpen.Cursor = 11
End Sub
Sub DirListBox_Change ()
    FileListBox.Path = DirListBox.Path
    FileSpecBox.Text = FileListBox.Pattern
    ChDir DirListBox.Path
    CurDirLabel.Caption = LCase$(CurDir$)
End Sub
Sub DirListBox_Click ()
    FileSpecBox.Text = DirListBox.List(DirListBox.ListIndex)
End Sub
Sub DriveDropDown_Change ()
    On Error Resume Next
    Err = False
CheckDrive:
    NewDrive = Left$(DriveDropDown.Drive, 2)
    TestDrive$ = Dir$(NewDrive)
    If Err Then
        MsgBox "Drive not ready", 48, "FileOpen"
        DriveDropDown.Drive = OldDrive
        GoTo CheckDrive
    Else
        ChDrive DriveDropDown.Drive
        OldDrive = NewDrive
        DirListBox.Path = DriveDropDown.Drive
    End If
    On Error GoTo 0
End Sub
Sub FileListBox_Click ()
    FileSpecBox.Text = FileListBox.FileName
    PickFile = FileListBox.FileName
End Sub
Sub FileListBox_DblClick ()
    OkButton_Click
End Sub
Sub FileOpenIcon_Click ()
    MsgBox "Written by Eric Hall in MS VB 1.0" + CRLF + "Portions Copyright Microsoft", 64, "FileOpen"
End Sub
Sub FileSpecBox_Change ()
    PickFile = ""
End Sub
Sub Form_Load ()
    On Error Resume Next
    CRLF = Chr$(10) + Chr$(13)
    CommandLine$ = LTrim$(RTrim$(Command$))
    If CommandLine$ = "" Then GoTo NoParms
    Separator$ = ","
    CLPS1% = InStr(1, CommandLine$, Separator$)
    CLPS2% = InStr(CLPS1% + 1, CommandLine$, Separator$)
    DialogTitle = LTrim$(RTrim$(Mid$(CommandLine$, 1, CLPS1% - 1)))
    FileSpec = LCase$(LTrim$(RTrim$(Mid$(CommandLine$, CLPS1% + 1, CLPS2% - CLPS1% - 1))))
    Executable = LTrim$(RTrim$(Mid$(CommandLine$, CLPS2% + 1)))

    If CLPS1% = 0 Then GoTo NoParms
    If CLPS2% = 0 Then GoTo NoParms
    If DialogTitle = "" Then DialogTitle = "FileOpen" Else DialogTitle = "FileOpen - " + DialogTitle
    If FileSpec = "" Then FileSpec = "*.*"
    If Executable = "" Then GoTo NoParms
    If Err GoTo NoParms
    GoTo LoadForm
NoParms:
    CmdLineErr$ = "TRUE"
    Unload FileOpen
LoadForm:
    FileOpen.Caption = DialogTitle
    FileListBox.Pattern = FileSpec
    FileSpecBox.Text = FileListBox.Pattern
    FileSpecBox.SelStart = 0
    FileSpecBox.SelLength = Len(FileSpecBox.Text)
    CurDirLabel.Caption = LCase$(CurDir$)
    OldDrive = LCase$(Left$(DriveDropDown.Drive, 2))
    On Error GoTo 0
End Sub
Sub Form_Unload (Cancel As Integer)
    On Error Resume Next
    If CmdLineErr = "TRUE" Then
        MsgLine1$ = "There was a command line error!  The correct syntax is:" + CRLF
        MsgLine2$ = CRLF
        MsgLine3$ = "   1) Dialog title -- the default is FileOpen" + CRLF
        MsgLine4$ = "   2) File specification -- the default is *.*" + CRLF
        MsgLine5$ = "   3) Program to load -- You MUST specify this" + CRLF
        MsgLine6$ = CRLF
        MsgLine7$ = "Separate the 3 parameters with commas."
        MsgBox MsgLine1$ + MsgLine2$ + MsgLine3$ + MsgLine4$ + MsgLine5$ + MsgLine6$ + MsgLine7$, 48, "FileOpen"
    End If
End Sub
Sub NewButton_Click ()
    On Error Resume Next
    ChDrive Left$(DriveDropDown.Drive, 2)
    ChDir DirListBox.Path
    CommandLine = Executable
    StartAppStatus = Shell(CommandLine, 3)
        If Err Then
            MsgBox "Error loading Application!" + CRLF + RTrim$(Error$(Err)) + "!", 48, "FileOpen"
            CmdLineErr$ = "TRUE"
            Unload FileOpen
        Else
            Unload FileOpen
        End If
EXITNEWBUTTON:
    FileSpecBox.SetFocus
    FileSpecBox.SelStart = 0
    FileSpecBox.SelLength = Len(FileSpecBox.Text)
End Sub
Sub OkButton_Click ()
    On Error Resume Next
    Err = False
    FileSpec = LCase$(LTrim$(RTrim$(FileSpecBox.Text)))
    Screen.MousePointer = 11
RunFileSpec:
    Rem *** If user selects a file from FileListBox, load it and run.
    If RTrim$(PickFile) <> "" Then
        CommandLine = Executable + " " + PickFile
        StartAppStatus = Shell(CommandLine, 3)
        If Err Then
            MsgBox "Error loading application!" + CRLF + RTrim$(Error$(Err)) + "!", 48, "FileOpen"
            CmdLineErr = "TRUE"
            Unload FileOpen
        Else
            CmdLineErr = "FALSE"
            Unload FileOpen
        End If
    Rem *** If the user typed a full valid filename, go ahead and grab it
    Else
        TestFileSpec = Dir$(Left$(FileSpec, 2))
        If Err Then
            MsgBox "Drive not ready", 48, "FileOpen"
            GoTo ExitOKButton
        End If
        PickFile = LCase$(Dir$(FileSpec))
        If Len(PickFile) > 0 And PickFile = Right$(FileSpec, Len(PickFile)) Then
            GoTo RunFileSpec
        Else
            If InStr(FileSpec, ".") = 0 Then
                FilePattern = Mid$(FileListBox.Pattern, InStr(FileListBox.Pattern, "."))
                TestFileSpec = LCase$(FileSpec + FilePattern)
                PickFile = LCase$(Dir$(FileSpec + FilePattern))
                If PickFile = "" Then GoTo PrepFileSpec
                If InStr(TestFileSpec, PickFile) > 0 Then
                    FileSpec = FileSpec + FilePattern
                    PickFile = FileSpec
                    GoTo RunFileSpec
                End If
            End If
            PickFile = ""
            Err = False
            GoTo PrepFileSpec
        End If
    End If
PrepFileSpec:
    Rem *** Here we have to remove the trailing backslash if the user
    Rem *** put it in.  Follows windows standard now...
    If Right$(FileSpec, 1) = "\" Then
        If Len(FileSpec) <> InStr(FileSpec, "\") Then
            FileSpec = Left$(FileSpec, Len(FileSpec) - 1)
        End If
    End If
    Rem *** Update the Filename property of the listbox so we can
    Rem *** trigger the drive/path/pattern properties
    FileListBox.FileName = FileSpec
    If Err Then
        Select Case Err
            Case 380
                Rem *** Trap for empty floppy drive...
                MsgBox "Drive not ready", 48, "FileOpen"
                GoTo ExitOKButton
            Case 76
                Rem *** Trap for invalid pathname...
                MsgBox "Directory does not exist", 48, "FileOpen"
                GoTo ExitOKButton
            Case 53
                Rem *** Trap for attempt at filename...
                MsgBox "File does not exist", 48, "FileOpen"
            Case Else
                Rem *** Trap for other errors...
                MsgBox "Error number " + Str$(Err) + CRLF + Error$(Err), 48, "FileOpen"
        End Select
    End If
    NewDrive = Left$(FileListBox.Path, 2)
    NewPath = FileListBox.Path
ProcessFileSpec:
    Rem *** Get the new drive, compare it to the old drive, and
    Rem *** change drives, if necessary...
    If UCase$(NewDrive) <> UCase$(OldDrive) Then
        DriveDropDown.Drive = NewDrive
        OldDrive = NewDrive
        ChDrive NewDrive
    End If
    Rem *** Get the new path, and change to the new directory,
    Rem *** if necessary...
    If UCase$(NewPath) <> UCase$(CurDir$) Then
        DirListBox.Path = NewPath
        ChDir NewPath
    End If
ExitOKButton:
    FileSpecBox.Text = FileListBox.Pattern
    FileSpecBox.SetFocus
    FileSpecBox.SelStart = 0
    FileSpecBox.SelLength = Len(FileSpecBox.Text)
    Screen.MousePointer = 0
    On Error GoTo 0
End Sub