fileopensave.bas

一个简单的记事本的VB程序。 和系统自带的差不多功能

Attribute VB_Name = "FileOpenSave"
Public FormHeight As Long
Public FileEdit As Boolean '是否修改
Public FileName As String
Public Undo(20) As String '存放可撤消的数据
Public FileOpenYN As Boolean '是否是打开的文档
Public MsgColor As Long

Sub Main()
If Command <> "" Then
    Dim n As Long
    n = InStr(1, Command, """")
    If n <> 0 Then
        FileName = Mid(Command, 2, Len(Command) - 2)
    Else
        FileName = Command
    End If
    'MsgBox command
    Call FileOpen(True)
End If
FrmMain.Show
End Sub
Sub FileOpen(Optional 是否显示对话框 As Boolean)
On Error GoTo err1
If 是否显示对话框 <> True Then
    FrmMain.File.ShowOpen
    If Trim(FrmMain.File.FileName) = "" Then Exit Sub
    If Err.Number = 32755 Or FrmMain.File.FileName = "" Then Exit Sub
   FileName = FrmMain.File.FileName
    
End If
    Dim FileAttr As Long
    FileAttr = GetAttr(FileName)
    If FileAttr Mod 2 = 1 Then
        If MsgBox("你所指定的文件 " & FileName & " 属性为只读,不能对其进行编辑,是否去除文件的只读属性?", vbYesNo + vbDefaultButton2 + 32) = vbYes Then
            SetAttr FileName, vbNormal
          
        End If
    End If
    Open FileName For Input As #1
    ShowMsg "正在打开文件..."
    DoEvents
    Dim str As String
    Dim temp As String
    Do Until EOF(1)
        Line Input #1, temp
        str = str & temp & vbNewLine
    Loop
    Close #1
    FrmMain.Text1.Text = str
    ShowMsg "已经成功打开了文件"
    FileOpenYN = True
    FileEdit = False
    Call FrmMainRefresh


Exit Sub
err1:
MsgBox Err.Description, 16, "错误 " & Err.Number
End Sub
Sub FileNew()
FrmMain.Text1.Text = ""
FileEdit = False
FileOpenYN = False
Call FrmMainRefresh
ShowMsg "已经新建了一个空白文档"
End Sub
Sub FileSave(Optional 是否是另存为 As Boolean)
On Error GoTo err1
If FileOpenYN = False Or 是否是另存为 = True Then
    FrmMain.File.DialogTitle = "请输入欲保存的文件名及位置"
    FrmMain.File.ShowSave
    If FrmMain.File.FileName = "" Then
        Exit Sub
    End If
    FileName = FrmMain.File.FileName

  
End If

Open FileName For Output As #1
Print #1, FrmMain.Text1.Text
Close #1
ShowMsg "已经保存完文档"


FileEdit = False
Call FrmMainRefresh
Exit Sub
err1:
MsgBox Err.Description, 16, "发生未知错误 " & Err.Number
End Sub

Sub FrmMainRefresh()
Dim temp As Long
Dim TempName As String
temp = 1
Dim n As Long
For n = 1 To Len(FileName)
    temp = InStr(temp + 1, FileName, "\")
    If temp <> 0 Then
        TempName = Mid(FileName, temp + 1)
    Else
        Exit For
    End If
Next n
If FileName = "" Then TempName = "无标题"
FrmMain.Caption = TempName & " - 记事本"
End Sub
Sub ShowMsg(msg As String, Optional 不显示动画 As Boolean)
MsgColor = FrmMain.Label1.BackColor
FrmMain.Label1.Caption = msg
If 不显示动画 <> True Then
    FrmMain.Timer1.Enabled = True
End If
End Sub