textedit.bas

VB6程序设计参考手册 -独立源码(学习的好东西)

Attribute VB_Name = "Module1"
    Dim ArrayNum As Integer     ' 历史文件的索引
    Public Filename As String   ' 打开的文件名
    
    Sub CloseFile(Filename As String)
        
        Dim F As Integer
        On Error GoTo CloseError
            
            If Dir(Filename) <> "" Then         ' 文件已存在，是否覆盖
                response = MsgBox("Overwrite existing file?", vbYesNo + vbQuestion + vbDefaultButton2)
                If response = vbNo Then Exit Sub
            End If
            F = FreeFile
            Open Filename For Output As F       ' 打开文件
            Print #F, frmEditor!txtEdit.Text    ' 写入
            Close F                             ' 关闭文件
            frmEditor.Caption = "记事本: " + Filename
            Exit Sub
CloseError:
            MsgBox "另存文件出错，请重试", 48
            Exit Sub
            
    End Sub
     
    Sub OpenFile(Filename As String)
        Dim F As Integer
        Dim FileStr As String
        
        If "记事本: " + Filename = frmEditor.Caption Then  ' 如果文件已经打开
            Exit Sub
        Else
            On Error GoTo errhandler
                F = FreeFile
                FileStr = ""
                Open Filename For Input As F         '打开指定文件
                Do While Not EOF(F)   ' 循环至文件尾。
                    FileStr = FileStr + Input(1, #1) ' 读入一个字符。
                Loop
                Close F                               '关闭文件
                frmEditor.txtEdit.Text = FileStr
                UpdateMenu
                frmEditor.Caption = "记事本: " + Filename
                Exit Sub
        End If
errhandler:
            MsgBox "打开文件出错，请重试", 48, "记事本"
            Close F
            Exit Sub
    End Sub
    
    Sub UpdateMenu()
        
        frmEditor.mnuFileArray(0).Visible = True
        ArrayNum = ArrayNum + 1
        ' 检查文件名是否已经在历史菜单中
        For i = 0 To ArrayNum - 1
            If frmEditor.mnuFileArray(i).Caption = Filename Then
                ArrayNum = ArrayNum - 1
                Exit Sub
            End If
        Next i
        
        ' 如果不在，则加入
        Load frmEditor.mnuFileArray(ArrayNum)               ' 创建一个菜单项
        frmEditor.mnuFileArray(ArrayNum).Caption = Filename ' 设置菜单内容
        frmEditor.mnuFileArray(ArrayNum).Visible = True     ' 使新菜单项可见
    End Sub
    
    Sub SaveFile(Filename As String)
        Dim F As Integer
        
        On Error GoTo CloseError
        '打开文件保存
        F = FreeFile
        Open Filename For Output As F
        Print #F, frmEditor.txtEdit.Text
        Close F
        Exit Sub
CloseError:
        MsgBox "保存文件出错，请重试", 48
        Exit Sub
        
    End Sub