李大仁博客

Dim Changed As Boolean   '是否被修改
Dim IsSave As Boolean   '是否已经保存
Dim FileName As String  '文件名称
Dim TxtBefore As String '修改前文本，用于撤销操作
 
'窗体加载
Private Sub Form_Load()
    Clipboard.Clear
End Sub
 
'窗体关闭
Private Sub Form_Unload(Cancel As Integer)
     '与退出按钮的事件处理方法相同
    If Changed = True Then
        result = MsgBox("您正要关闭编辑窗口，是否保存您的修改？", vbYesNoCancel, "确定") '提示是否保存
        If result = vbYes Then
            MenuStripSave_Click   '直接调用保存事件的方法
        ElseIf result = vbNo Then
            Unload Me '卸载窗体
        End If
    Else
        Unload Me
    End If
End Sub
 
'关于
Private Sub MenuStripAbout_Click()
    MsgBox "Powered By CG", vbOKOnly, "关于"
End Sub
'选择全部文本
Private Sub MenuStripSelectAll_Click()
    RTBox.SelStart = 0 '从文本开始处开始
    RTBox.SelLength = Len(RTBox.Text)   '选择长度 = 文本最大长度
End Sub
'撤销
Private Sub MenuStripUndo_Click()
    RTBox.Text = TxtBefore  '恢复文本
End Sub
'文本框文本变化
Private Sub RTBox_Change()
    Changed = True  '发生Change事件
    If FileName = "" Then   '如果文件名是空 未命名
        FileName = "未命名"
        Me.Caption = FileName   '修改标题
    End If
    If InStr(Me.Caption, "*") = 0 Then
        Me.Caption = FileName + "*" '标记星号
    End If
End Sub
'窗体调整大小
Private Sub Form_Resize()
    RTBox.Width = Form1.Width - 40  '修改文本框的大小
    RTBox.Height = Form1.Height - 40
End Sub
'复制
Private Sub MenuStripCopy_Click()
    Clipboard.Clear     '清楚剪切板
    Clipboard.SetText RTBox.SelText
End Sub
'剪切
Private Sub MenuStripCut_Click()
    Clipboard.Clear
    Clipboard.SetText RTBox.SelText
    RTBox.SelText = "" '复制后删除所选文本
End Sub
'删除
Private Sub MenuStripDelete_Click()
    RTBox.SelText = ""  '直接删除文本
End Sub
'退出
Private Sub MenuStripExit_Click()
    If Changed = True Then
        result = MsgBox("您正要关闭编辑窗口，是否保存您的修改？", vbYesNoCancel, "确定")    '确认
        If result = vbYes Then
            MenuStripSave_Click '调用保存事件的代码
        ElseIf result = vbNo Then
            Unload Me
        End If
    Else
        Unload Me   '如果没有修改那就直接卸载窗体
    End If
End Sub
'字体对话框
Private Sub MenuStripFont_Click()
    ComDiag.Flags = 1
    ComDiag.ShowFont    '显示字体对话框
    RTBox.Font.Bold = ComDiag.FontBold  '字体属性赋值
    RTBox.Font.Italic = ComDiag.FontItalic
    RTBox.Font.Name = ComDiag.FontName
    RTBox.Font.Size = ComDiag.FontSize
    RTBox.Font.Strikethrough = ComDiag.FontStrikethru
    RTBox.Font.Underline = ComDiag.FontUnderline
End Sub
'新建
Private Sub MenuStripNew_Click()
    Dim result As Integer   '定义一个int用于获取对话框结果
    If Changed = True Then
        result = MsgBox("您正要新建一个编辑窗口，是否保存您的修改？", vbYesNoCancel, "确定")
        If result = vbYes Then
            MenuStripSave_Click
        End If
    Else
        FileName = "未命名"
        Me.Caption = FileName
        RTBox.Text = "" '清空文本框
    End If
End Sub
'打开
Private Sub MenuStripOpen_Click()
    ComDiag.Filter = "*.*"
    ComDiag.ShowOpen
    If ComDiag.FileName <> "" Then      '如果选择了文件
        FileName = ComDiag.FileName
        RTBox.Text = ""
        RTBox.LoadFile FileName
        Me.Caption = FileName   '修改标题
    End If
End Sub
 
'粘贴
Private Sub MenuStripPaste_Click()
    RTBox.SelText = Clipboard.GetText   '粘贴剪贴板的内容
End Sub
 
'保存
Private Sub MenuStripSave_Click()
    Dim result As Integer
    If IsSave = True Then
        RTBox.SaveFile FileName, rtfText   '如果已经保存过，直接保存结果
             If InStr(Me.Caption, "*") <> 0 Then    '标题中有* ？
                    Me.Caption = Replace(Me.Caption, "*", "")   '替换
             End If
    Else
        ComDiag.Filter = "*.*"
        ComDiag.DialogTitle = "保存" + FileName
        ComDiag.ShowSave   '保存对话框
         If FileName <> "" Then
            FileName = ComDiag.FileName
            RTBox.SaveFile FileName, rtfText    '保存结果TEXT格式
            IsSave = True   '已经保存
            Me.Caption = FileName
             If InStr(Me.Caption, "*") <> 0 Then
                    Me.Caption = Replace(Me.Caption, "*", "")   '清除星号
             End If
        End If
    End If
 
End Sub
'另存为
Private Sub MenuStripSaveAs_Click()
    ComDiag.Filter = "*.*"
    ComDiag.DialogTitle = "另存为..."
    ComDiag.ShowSave
    If FileName <> "" Then
            FileName = ComDiag.FileName
            RTBox.SaveFile FileName, rtfText
            IsSave = True
            Me.Caption = FileName
                If InStr(Me.Caption, "*") <> 0 Then
                    Me.Caption = Replace(Me.Caption, "*", "")
            End If
    End If
End Sub