frmfile.frm

NOPAD的VB6原碼,寫的還蠻齊全的,請參考

    
    'get next available free filenumber
    FileNum = FreeFile
    
    'parse the next filename from the list then remove it from the list
    Filename = Trim$(GetNextFilename(FileList))
    FileList = RemoveNextFilename(FileList)
    
    'assign fully qualified path & file name to local var for manipulation
    If Right$(Dir1.Path, 1) = "\" Then
        TempFile = Dir1.Path & Filename
    Else
        TempFile = Dir1.Path & "\" & Filename
    End If
    
    'look for current instance of form containing Filename
    'if found, don't create new instance
    For x = 0 To Forms.Count - 1
        If Forms(x).Caption = TempFile Then
            MsgBox "The file " & Chr$(34) & UCase(TempFile) & Chr$(34) & " is currently opened.", 64, "FILE I/O ERROR"
                        
            'avoid default dialog if no file is opened
            Flag = True
            GoTo btnOKClickJump1
        End If
    Next x
    
    'instantiate new text form
    Set F = New frmText
    
    'open file
    Open TempFile For Input As FileNum
    
    'assign file contents to textbox on new form
    F.Text1 = Input(LOF(FileNum), FileNum)
    
    Close FileNum
    
    'remember the last file opened for the next time this dialog is needed
    Me.LastOpen = TempFile
    
    'assign values to form properties for Save As procedure
    F.Drive = Drive1.Drive
    F.Dir = Dir1.Path
    F.File = Filename
    
    'assign filename to the form's caption and show the form
    F.Caption = TempFile
        
    'show form
    F.Show
    
    'add file to Files() array
    frmMain.AddFile TempFile
    
    'init form's Changed property to False
    F.Changed = False
    
    'flag that at least one file was opened
    Flag = True
    
    'increment file counter by 1
    FileCount = FileCount + 1
    
    'make Progress indicator Visible
    If frmMain.Progress.Visible = False Then
        frmMain.Progress.Visible = True
    End If
    
    'assign FileCount to Progress indicators Value property
    frmMain.Progress.Value = FileCount

btnOKClickJump1:

'process windows calls (such as pressing stop button)
DoEvents
Wend

'turn Stop button off
frmMain.Toolbar.Buttons("Stop").Image = "StopOff"

'hide Progress indicator from view
frmMain.Progress.Visible = False

'if no files were opened the msg the user
If Flag = False Then
    MsgBox "You must first pick a file to open", 16, "FILE I/O ERROR"
    Exit Sub
End If

Exit Sub

'ERROR HANDLER 1
frmFilebtnOKClickError1:
If Err = 53 Then 'File not found
    MsgBox "The file you requested, " & Dir1.Path & Filename & " can not be found.  Please try again.", 16, "FILE I/O ERROR"
    Exit Sub
End If

If Err = 62 Then    'Input Past EOF (typical of Non-ASCII files)
    MsgBox "The file you request is not an ASCII and cannot be edited." & Chr$(13) & "Please try again.", 16, "FILE I/O ERROR"
    Exit Sub
End If

'if any other error occurs, msg the user
MsgBox "ERR =" & Str$(Err) & Chr$(13) & "ERROR = " & Error(Err), 16, "UNRECOVERABLE ERROR"
Resume Next

'---------------------------------------------------------------------------
'                             FILE SAVE AS SEQUENCE
'---------------------------------------------------------------------------
Case Is > 0

Dim File As String
Dim FullName As String
Dim Ext As String

Set F = frmMain.ActiveForm

'assign contents of Name1 to local var
File = Name1

'check for filename, if none msg user and exit
If File = "" Or Left$(File, 2) = "*." Then
    MsgBox "You must enter a filename to be saved.", 16, "FILE I/O ERROR"
    Exit Sub
End If

'check for existing extension on filename
Ext = GetExt(File)

'if extension not found, append currently selected definition in Type1
If Ext = "" Then

    'if Type1 is set to anything but All Files then append the selected
    'extension in Type1
    If Not GetExt(Type1.List(Type1.ListIndex)) = "*" Then
        File = File & "." & GetExt(Type1.List(Type1.ListIndex))
    End If

    'if Type1 is set to All Files, not extension will be appended since
    'no extension was provided for

End If

'assign fully qualified path & filename to local var
If Right$(Dir1.Path, 1) = "\" Then
    FullName = Dir1.Path & File
Else
    FullName = Dir1.Path & "\" & File
End If

'assign first free file number to local var
FileNum = FreeFile

'open file for output
Open FullName For Output As FileNum

'write contents of form to disk
Print #FileNum, F.Text1

'close file
Close FileNum

'remember the last file saved for the next time this dialog is needed
Me.LastSave = FullName
 
'assign values to form properties for Save As procedure
F.Drive = Drive1.Drive
F.Dir = Dir1.Path
F.File = File

'add file to Files() array
frmMain.AddFile FullName

'assign filename to the form's caption and show the form
F.Caption = FullName
F.Show

'add file to Files() array
 frmMain.AddFile F.Caption
 
'init form's Changed property to False
F.Changed = False

Exit Sub

'-------------------------------------------------------------------------

End Select
 
End Sub

Private Sub Dir1_Change()

File1.Path = Dir1.Path

End Sub

Private Sub Drive1_Change()

Dir1.Path = Drive1.Drive

End Sub


Private Sub File1_Click()

Dim MultiFile As Integer

'SEQUENCE FOR FILE OPEN
'add all selected filenames to Name1
If Me.Action = 0 Then
    For x = 0 To File1.ListCount - 1
        If File1.Selected(x) = True Then
            If MultiFile = False Then
                MultiFile = True
                Name1 = File1.List(x)
            Else
                'delimit with a comma and a space
                Name1 = Name1 & ", " & File1.List(x)
            End If
        End If
    Next x
End If

'the sequence for File Save As occurs in the mouse up event

End Sub


Private Sub File1_DblClick()

btnOK_Click

End Sub



Private Sub File1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

'SEQUENCE FOR FILE SAVE AS
If Me.Action > 0 Then
    Name1 = File1.List(File1.ListIndex)

    'deselect all items except the current listindex
    'in case the user accidently selected more than one file
    For x = 0 To File1.ListCount - 1
        If Not x = File1.ListIndex Then
            File1.Selected(x) = False
        End If
    Next x
End If

End Sub

Private Sub Form_Load()

InitFlag = True
Init
InitFlag = False

End Sub


Private Sub Name1_GotFocus()

btnOK.Default = False
Name1.SelStart = 0
Name1.SelLength = Len(Name1)

End Sub


Private Sub Name1_KeyDown(KeyCode As Integer, Shift As Integer)

Dim Del1 As Integer

If KeyCode = vbKeyReturn Then
    
    'verify the text in Name1 is not a Filelist
    If InStr(Name1, ", ") > 0 Then
        btnOK_Click
        Exit Sub
    End If
    
    'verify the text in Name1 is not a filename
    If Dir$(Name1) = Name1 Then
        btnOK_Click
        Exit Sub
    End If
    
    'verify the text in Name1 is a directory
    If Not Dir$(Name1, 16) = "" Then
        If Right$(Name1, 1) = ":" Then
            Name1 = Name1 & "\"
        End If
        
        'if Name1 is not a wildcard (it must be a directory)
        If Not Left$(Name1, 1) = "*" Then
            Drive1.Drive = Left$(Name1, 1)
            Dir1.Path = Name1
            File1.Path = Name1
            Type1_Click
            Name1.SetFocus
            Exit Sub
        End If
    End If

    'verify the text in Name1 is a recognized wildcard
    If Left$(Name1, 2) = "*." And Len(Name1) > 2 Then
        File1.Pattern = Name1
        Select Case Name1
        Case "*.htm", "*.html"
            Type1.ListIndex = 1
        Case "*.txt"
            Type1.ListIndex = 2
        Case Is <> "htm", Is <> "html", Is <> "txt"
            Type1.ListIndex = 0
        End Select
        Name1.SetFocus
        Exit Sub
    End If

    'verify the text is the name of a file to be saved
    If Action > 0 Then
        btnOK_Click
        Exit Sub
    End If
    
    'if none of the above applied, msg user file can't be found
    MsgBox "The filename or path you entered " & Name1 & " could not be found.  Please try again.", 16, "FILE I/O ERROR"

    Name1.SetFocus
    
End If

End Sub

Private Sub Name1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
    KeyAscii = 0
End If

End Sub

Private Sub Name1_LostFocus()

btnOK.Default = True

End Sub


Private Sub Type1_Click()

Dim Ext As String

'assign chosen extension to local var
Ext = GetExt(Type1.List(Type1.ListIndex))

'If no extension provided, default to All Files
If Ext = "" Then
    Ext = "*.*"
End If

'assign new extension to form's DefaultExt property
If Ext = "*.*" Then
    Me.DefaultExt = ""
Else
    Me.DefaultExt = Ext
End If

'assign appropriate extension to file box's pattern property
File1.Pattern = "*." & Ext

'update the name1 field for the filename
Name1 = ""
If Name1 = "" Then  'If there is no entry in the Name field
    Name1 = "*." & Ext 'then simply use the extension for the name
Else
    NameExt = GetExt(Name1)
    If NameExt = "" Then    'if there is an entry in the name field but it doesn't have an extension
        Name1 = Name1 & "*." & Ext  'then add the extension to the filename
    Else
        Name1 = SwapExt(Name1, Ext)    'swap the existing extension with the new extension
    End If
End If

End Sub