Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/NIVB_SRC/SELFILE.FRM

Visual Basic Form | 1993-06-02 | 9.7 KB | 280 lines

VERSION 2.00
Begin Form SelectFileForm
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Select File"
   ControlBox      =   0   'False
   FontBold        =   -1  'True
   FontItalic      =   0   'False
   FontName        =   "System"
   FontSize        =   9.75
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   4140
   Icon            =   0
   Left            =   1875
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3735
   ScaleWidth      =   5700
   Top             =   1320
   Width           =   5820
   Begin DriveListBox DriveBox
      Height          =   315
      Left            =   2895
      TabIndex        =   7
      Top             =   3135
      Width           =   2475
   End
   Begin CommandButton CancelButton
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   420
      Left            =   1560
      TabIndex        =   9
      Top             =   3120
      Width           =   1125
   End
   Begin CommandButton OKButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   420
      Left            =   240
      TabIndex        =   8
      Top             =   3120
      Width           =   1125
   End
   Begin DirListBox DirBox
      Height          =   1880
      Left            =   2910
      TabIndex        =   5
      Top             =   880
      Width           =   2460
   End
   Begin FileListBox FileListBox
      Height          =   1785
      Left            =   240
      TabIndex        =   2
      Top             =   840
      Width           =   2460
   End
   Begin TextBox FileNameBox
      Height          =   320
      Left            =   195
      TabIndex        =   1
      Text            =   "*.*"
      Top             =   400
      Width           =   2610
   End
   Begin Label Label3
      Caption         =   "Dri&ves:"
      Height          =   255
      Left            =   2835
      TabIndex        =   6
      Top             =   2850
      Width           =   765
   End
   Begin Label CurrDirLabel
      Caption         =   "---"
      Height          =   225
      Left            =   2880
      TabIndex        =   4
      Top             =   480
      Width           =   2445
   End
   Begin Label Label2
      Caption         =   "&Directories:"
      Height          =   240
      Left            =   2820
      TabIndex        =   3
      Top             =   150
      Width           =   1200
   End
   Begin Label Label1
      Caption         =   "File &Name:"
      Height          =   240
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   1200
   End
Dim LastChange As Integer   'remember what changed last
Sub CancelButton_Click ()
    Unload SelectFileForm
End Sub
Sub DirBox_Change ()
    ' propogate directory changes to other controls
    FileListBox.Path = DirBox.Path
    CurrDirLabel.Caption = DirBox.Path
    ChDir DirBox.Path
End Sub
Sub DirBox_Click ()
    LastChange = 2  'remember that the DirBox control changed
End Sub
Sub DriveBox_Change ()
    ' change the DirBox control path, it will
    ' pass the change on to the FileListBox control
    DirBox.Path = DriveBox.Drive
    ChDrive (DriveBox.Drive)
End Sub
Sub FileListBox_Click ()
    'echo the selected name in the Text box
    FileNameBox.Text = FileListBox.FileName
End Sub
Sub FileListBox_DblClick ()
    'we have a final selection from the File Save dialog
    FileNameBox.Text = FileListBox.FileName
    OKButton_Click
End Sub
Sub FileListBox_PathChange ()
    'Show the current search pattern in the FileNameBox control
    FileNameBox.Text = FileListBox.Pattern
    HighLightTextBox
End Sub
Sub FileListBox_PatternChange ()
    FileNameBox.Text = FileListBox.Pattern
    HighLightTextBox
End Sub
Sub FileNameBox_Change ()
    LastChange = 1
End Sub
Sub Form_Load ()
    If (currentForm = AFP_FORM) Then
        Unload AFPForm
    End If
    CurrDirLabel.Caption = DirBox.Path  'Show full path name in a label
    LastChange = 0                          'No controls have been modified
    DirBox.Height = FileListBox.Height      'Align Drives box to Files box
End Sub
Sub HighLightTextBox ()
    FileNameBox.SelStart = 0
    FileNameBox.SelLength = Len(FileNameBox.Text)
    FileNameBox.SetFocus
End Sub
Function IsFileName (FileSpec As String) As Integer
' This function accepts FileSpec, a string, as input, then
' checks to see if the string is a valid file path/expression.
' If FileSpec is valid, and specifies a new drive, pattern and/or
' directory, the directory and file list boxes are notified.
' If FileSpec contains a valid file name, the filename is placed
' in the form's text edit box and IsFileName() returns a value of
' TRUE.  If FileSpec does not contain a valid file name (ie, it
' contains directory name and/or a new file pattern and/or an
' invalid file/path expression), IsFileName() returns FALSE.
    Dim Index As Integer
    Dim OldDir As String
    Dim NewDir As String
    On Local Error Resume Next
    OldDir = CurDir$                    'Remember current directory
    FileSpec = LCase$(FileSpec)
    If Mid$(FileSpec, 2, 1) = ":" Then  'Does it specify new drive?
        ChDrive (FileSpec)
        DirBox.Path = CurDir$
        If Err Then
            MsgBox Error$(Err), 0, "Disk Error"
            ChDrive (OldDir)
            DirBox.Path = CurDir$
            IsFileName = False
            Exit Function
        Else FileSpec = Right$(FileSpec, Len(FileSpec) - 2)
        End If
    End If
    ChDir (FileSpec)
    If Err Then                     'Separate path/filename, try again
        While InStr(FileSpec, "\")      'Parse any directory info

            'NewDir gets text to the left of & including FileSpec's first "\"
            NewDir = NewDir + Left$(FileSpec, InStr(FileSpec, "\"))

            'FileSpec becomes the text to the right of the first "\"
            FileSpec = Right$(FileSpec, Len(FileSpec) - InStr(FileSpec, "\"))
        Wend

        If NewDir <> "" Then
            If Len(NewDir) > 1 Then NewDir = Left$(NewDir, Len(NewDir) - 1)'Remove ending "\"
            Err = 0
            ChDir (NewDir)
            If Err Then
                MsgBox "Invalid path: '" + NewDir + "'", 0, "Cardfile"
                IsFileName = False
            Else
                If ProcessFileSpec(FileSpec) Then
                    IsFileName = True
                Else
                    If (InStr(FileSpec, "*") = 0) And (InStr(FileSpec, "?") = 0) Then
                        ChDrive (OldDir)
                        ChDir (OldDir)
                    Else
                        DirBox.Path = CurDir$     'Update file controls
                    End If
                    IsFileName = False
                End If
            End If
        Else
            IsFileName = ProcessFileSpec(FileSpec)
        End If
    Else
        'User specified a new, valid dir; update the file controls
        DirBox.Path = FileSpec
    End If
End Function
Sub OKButton_Click ()
    Dim FileSpec As String
    Select Case LastChange
        Case 0 To 1             'Text box control was last changed
            LastChange = False
            FileSpec = FileNameBox.Text
            If IsFileName(FileSpec) Then
                HighLightTextBox
                SelectFileForm.Hide
                If (currentForm = AFP_FORM) Then
                    AFPInfoForm.Show
                Else
                    FileInfoForm.Show
                End If
            End If
        Case 2               'Directory list control was last changed
            LastChange = False
            DirBox.Path = DirBox.List(DirBox.ListIndex)
        End Select
End Sub
Function ProcessFileSpec (FileSpec As String) As Integer
' This function accepts a string which may be a directory name,
' a wildcard pattern, or a file name.  The function returns TRUE
' if the string is a valid filename, and FALSE if the string is
' either an invalid filename or a directory specification.  If the
' string specifies a directory, ProcessFileSpec() changes the
' current directory and updates the appropriate form controls.
    Dim MsgBoxResponse As Integer
    On Local Error Resume Next
    If FileSpec <> "" Then
        Err = 0
        ChDir (FileSpec)
        If Err Then     ' FileSpec is a filename or wildcard, not a dir
            'If InStr(FileSpec, ".") = False Then FileSpec = FileSpec + ".crd"
            If Len(FileSpec) > 12 Then
                MsgBox ("Filename too long: '" + FileSpec + "'")
                ProcessFileSpec = False
            Else
                'Did user specify a new wildcard pattern?
                If InStr(FileSpec, "*") Or InStr(FileSpec, "?") Then
                    FileListBox.Pattern = FileSpec
                    ProcessFileSpec = False
                Else
                    If FileSpec <> ".." Then
                        ' We're finished -- got a valid filename
                        FileNameBox.Text = FileSpec
                        ProcessFileSpec = True
                    End If
                End If
            End If
        Else   ' FileSpec was just a directory name
            ProcessFileSpec = False
        End If
    Else
        ' The user only specified a new drive (handled in IsFileName)
        ProcessFileSpec = False
    End If
End Function