相信大家学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加油!!