Question

求用VB做一个记事本的简单程序

用VB做一个记事本的简单程序 有的发到我邮箱penglinhaha520@163.com 谢谢了

Answer 1

Dim fileno As Integer '定义文件号变量
Dim f_name As String '定义文件名变量
Dim s, s1 As String '定义字符串变量，用来读取文件内容

'定义过程openfile，用来实现打开文件的功能，供其他代码调用
'避免代码的重复编写
Sub openfile()
'利用对话框控件设置“打开”对话框中可以选择的文件类型
cd1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
'利用对话框控件设置“打开”对话框中默认的文件过滤器为1，
'即文本文件
cd1.FilterIndex = 1
cd1.ShowOpen '利用对话框控件显示“打开”对话框
f_name = cd1.FileName '保存打开的文件名
If f_name <> "" Then
fileno = FreeFile '用FreeFile函数产生一个新的文件号
'设置当前打开的文件操作为读出文件的内容
Open f_name For Input As #fileno
s1 = ""
Do Until EOF(fileno) '当文件还没有独到文件尾时
'每次读出文件完整的一行放到字符串“s”中
Line Input #fileno, s
'在“s”字符串后加上回车符，并与保存之前文件内容的字符串“s1”合并
s1 = s1 + s + vbCrLf
Loop
Text1.Text = s1 '在文本框Text1中显示打开的文件的内容
Close #fileno '关闭文件号所指向的文件
End If
End Sub

'定义一个过程savefile，用来实现保存文件的功能，
'供其他代码调用
Sub savefile()
'利用对话框控件设置“打开”对话框中可以选择的文件类型
cd1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
'利用对话框控件设置“打开”对话框中默认的文件过滤器为1，
'即文本文件
cd1.FilterIndex = 1
cd1.DefaultExt = txt '设置默认的扩展名是“txt”
'如果文件已存在，则显示一个信息框，
'询问用户是否覆盖已有的文件
cd1.Flags = cdlOFNOverwritePrompt
cd1.ShowSave '利用对话框控件显示“另存为”对话框
f_name = cd1.FileName
If f_name <> "" Then
fileno = FreeFile '用FreeFile函数产生一个新的文件号
'设置当前打开的文件操作为向文件写入内容
Open f_name For Output As #fileno
Print #fileno, Text1.Text '把文本框中的内容写入文件
Close #fileno '关闭文件号所指向的文件
End If
End Sub

Private Sub mnuaboat_Click()
cd1.HelpCommand = cdlHelpContents
cd1.HelpFile = "C:\Windows\Help\Notepad.HLP"
cd1.ShowHelp
End Sub

Private Sub mnucenter_Click()
mnucenter.Checked = Not mnucenter.Checked
If mnucenter.Checked = True Then
Text1.Alignment = 2
mnuright.Checked = False
mnuleft.Checked = False
Else
Text1.Alignment = 0
End If
End Sub

Private Sub mnucopy_Click()
Clipboard.Clear '清除当前剪贴板上的内容
'把文本框Text1中选中的内容拷贝到剪贴板上
Clipboard.SetText Text1.SelText
End Sub

Private Sub mnucut_Click()
Clipboard.Clear '清除当前剪贴板上的内容
'把文本框Text1中选中的内容拷贝到剪贴板上
Clipboard.SetText Text1.SelText
Text1.SelText = "" '清除文本框Text1中选中的内容
End Sub

Private Sub mnuedit_Click()
'当文本框Text1中有文字被选中时，剪切、复制子菜单项才有效
mnucut.Enabled = (Text1.SelLength > 0)
mnucopy.Enabled = (Text1.SelLength > 0)
End Sub

Private Sub mnuend_Click()
End
End Sub

Private Sub mnufont_Click()
cd1.Flags = &H1 Or &H100
cd1.FontName = Text1.FontName
cd1.ShowFont '显示“字体”对话框
'用“字体”对话框中选择的字体设置文本框中的字体
Text1.FontBold = cd1.FontBold
Text1.FontItalic = cd1.FontItalic
Text1.FontName = Text1.FontName
Text1.FontSize = cd1.FontSize
Text1.FontStrikethru = cd1.FontStrikethru
Text1.FontUnderline = cd1.FontUnderline
Text1.ForeColor = cd1.Color
End Sub

Private Sub mnuleft_Click()
mnuleft.Checked = Not mnuleft.Checked
If mnuleft.Checked = True Then
Text1.Alignment = 0
mnuright.Checked = False
mnucenter.Checked = False
Else
Text1.Alignment = 0
End If
End Sub

Private Sub mnunew_Click()
Text1.Text = ""
End Sub

Private Sub mnuopen_Click()
openfile
End Sub

Private Sub mnupaste_Click()
'把剪贴板上的内容复制到文本框中
Text1.SelText = Clipboard.GetText
End Sub

Private Sub mnuright_Click()
mnuright.Checked = Not mnuright.Checked
If mnuright.Checked = True Then
Text1.Alignment = 1
mnuleft.Checked = False
mnucenter.Checked = False
Else
Text1.Alignment = 0
End If
End Sub

Private Sub mnusave_Click()
savefile
End Sub

Private Sub mnutoolbar_Click()
Toolbar1.Visible = Not Toolbar1.Visible
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case Is = 1
Text1.Text = ""
Case Is = 2
openfile
Case Is = 3
savefile
Case Is = 5
Text1.FontBold = Not Text1.FontBold
Case Is = 6
Text1.FontItalic = Not Text1.FontItalic
Case Is = 7
Text1.FontUnderline = Not Text1.FontUnderline
Case Is = 9
mnucut_Click
Case Is = 10
mnucopy_Click
Case Is = 11
mnupaste_Click
Case Is = 13
mnuleft_Click
Case Is = 14
mnucenter_Click
Case Is = 15
mnuright_Click
End Select
End Sub

窗体设计和源代码都发你邮箱了，简易文本编辑器还是比较简单的，以后还是自己编写吧

Answer 2

Option Explicit
Dim t As Boolean
Dim saveNot As Boolean

Private Sub about_Click()
MsgBox "VB记事本 ", vbOKOnly, "关于"
End Sub

Private Sub all_Click()
Clipboard.Clear
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub copy_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText
End Sub

Private Sub delete_Click()
Text1.SelText = ""
End Sub

Private Sub exit_Click()
Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim f As Integer
If t Then
f = MsgBox("文件即将退出，需要保存吗？", vbYesNo + vbExclamation + vbDefaultButton2, "提示")
If f = 6 Then
Call save_Click
Else
End
End If
Else
End
End If
End Sub

Private Sub jianqie_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText
Text1.SelText = ""
End Sub

Private Sub numnew_Click()
Dim x As Integer
If saveNot Then
x = MsgBox("文件已更改 是否保存更改", vbYesNoCancel + vbExclamation, "记事本")
If x = 6 Then
save_Click
ElseIf x = 7 Then
Text1.Text = ""
Else
Text1.SetFocus
End If
Else
Text1.Text = ""
End If
End Sub

Private Sub open_Click()
Dim iname As String, s As String
CommonDialog1.Filter = "*.txt(文本文件)|*.txt"
CommonDialog1.ShowOpen
iname = CommonDialog1.FileName
Open iname For Input As #11
Do While Not EOF(11)
s = s & Input(1, 11)
Loop
Text1.Text = s
Close 11
End Sub

Private Sub save_Click()
Dim oname As String, n As String, s As String
CommonDialog1.Filter = "*.txt(文本文件)|*.txt"
CommonDialog1.ShowSave
oname = CommonDialog1.FileName
Open oname For Output As #12
s = Text1.Text
Print #12, s
Close 12
t = False
End Sub

Private Sub Text1_Change()
t = True
End Sub

Private Sub zhantie_Click()
Text1.SelText = Clipboard.GetText()
End Sub

Private Sub ziti_Click()
CommonDialog1.Flags = 1
CommonDialog1.ShowFont
Text1.FontBold = CommonDialog1.FontBold
Text1.FontSize = CommonDialog1.FontSize
Text1.FontName = CommonDialog1.FontName
End Sub

Answer 3

2楼的代码不错，想得很周到
1楼的代码有几处小问题：

1.
Private Sub all_Click()
'Clipboard.Clear '这里可以不用清空剪切板
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

2.
Private Sub numnew_Click()
Dim x As Integer
If t Then '除了在这过程用到saveNot变量，其他地方没用到。
x = MsgBox("文件已更改 是否保存更改", vbYesNoCancel + vbExclamation, "记事本")

3.
Private Sub open_Click()
Dim iname As String, s As String, fnum As Integer
On Error Resume Next '----------
CommonDialog1.CancelError = True '-----------
CommonDialog1.Filter = "*.txt(文本文件)|*.txt"
CommonDialog1.ShowOpen
iname = CommonDialog1.FileName
If Err Then Exit Sub '当用户取消时，iname=""。为防止出错，加个判断。
fnum=FreeFile '-----------
Open iname For Input As #fnum '-------
Do While Not EOF(fnum) '------
s = s & Input(1, fnum) '------
Loop
Text1.Text = s
Close fnum '------

4.
Private Sub save_Click()
Dim oname As String, n As String, s As String, fnum As Integer
On Error Resume Next '----------
CommonDialog1.CancelError = True '-----------
CommonDialog1.Filter = "*.txt(文本文件)|*.txt"
CommonDialog1.ShowSave
oname = CommonDialog1.FileName
If Err Then Exit Sub '原因同上
fnum=FreeFile
Open oname For Output As #fnum '----
s = Text1.Text
Print #fnum, s '-----
Close fnum '-------
t = False
End Sub

5.
'当文本框被清空时，不需要作保存的提示
Private Sub Text1_Change()
If Text1="" Then
t=False
Else
t=True
End If
End Sub

6.
Private Sub ziti_Click()
On Error Resume Next '----------
CommonDialog1.CancelError = True '-----------
CommonDialog1.Flags = 1
CommonDialog1.ShowFont
If Err Then Exit Sub '---------
Text1.FontBold = CommonDialog1.FontBold
Text1.FontSize = CommonDialog1.FontSize
Text1.FontName = CommonDialog1.FontName
End Sub