李大仁博客

VB仿Windows的记事本notepad的程序源代码

相信大家学VB如果连记事本这东西都不知道话就很郁闷了,CG今天接到Kivi的任务,做一个能看懂代码的记事本程序作为VB作业上交,据说还要上台讲,这老师真够难为人的,反正CG是有段时间没有见到了,源代码附上,如果大家有需要的话拿走,毕竟像初学者还是需要的。

简要说明:
记事本程序主要是要求在VB中使用Common Dialog Control控件的打开文件,打开字体,保存文件对话框的功能,实现文本的创建、修改、编辑、保存的功能,也是大家平时也使用的比较多的文本编辑器。


源代码地址:
http://www.lidaren.com/code/VBnotepad.zip

以下是部分参考代码:

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

Kivi加油!!

Exit mobile version