VB设计记事本
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" Begin VB.Form frmNotepad
Caption = "记事本"
ClientHeight = 4335
ClientLeft = 165
ClientTop = 450
ClientWidth = 6255
Icon = "frmNotepad.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4335
ScaleWidth = 6255
StartUpPosition = 2 '屏幕中心
Begin https://www.wendangku.net/doc/4e15724080.html,monDialog CommonDialog1
Left = 5280
Top = 120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Color = 16777215
DefaultExt = "TXT"
DialogTitle = "文件"
Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
Flags = 259
FontName = "宋体"
FontSize = 10
InitDir = "c:\"
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 1320
MaxLength = 32768
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 960
Width = 3135
End
Begin VB.Menu File
Caption = "文件(&F)"
Begin VB.Menu New
Caption = "新建(&N)"
Shortcut = ^N
End
Begin VB.Menu Open
Caption = "打开(&O)..."
Shortcut = ^O
End
Begin VB.Menu Close
Caption = "关闭(&C)"
End
Begin VB.Menu sep0
Caption = "-"
End
Begin VB.Menu save
Caption = "保存(&S)"
Shortcut = ^S
End
Begin VB.Menu saveas
Caption = "另存为(&A)..."
End
Begin VB.Menu Sep1
Caption = "-"
End
Begin VB.Menu print
Caption = "打印(&P)..."
Shortcut = ^P
End
Begin VB.Menu sep
Caption = "-"
End
Begin VB.Menu Exit
Caption = "退出(&X)"
End
End
Begin VB.Menu Edit
Caption = "编辑(&E)"
Begin VB.Menu Cut
Caption = "剪切(&T)"
Shortcut = ^X
End
Begin VB.Menu Copy
Caption = "复制(&C)"
Shortcut = ^C
End
Begin VB.Menu Paste
Caption = "粘贴(&P)"
Shortcut = ^V
End
Begin VB.Menu Delete
Caption = "删除(&L)"
Shortcut = {DEL}
End
Begin VB.Menu sep2
Caption = "-"
End
Begin VB.Menu find
Caption = "查找(&F)..."
Shortcut = ^F
End
Begin VB.Menu findNext
Caption = "查找下一个(&N)"
Enabled = 0 'False
Shortcut = {F3}
End
Begin VB.Menu sep3
Caption = "-"
End
Begin VB.Menu selectAll
Caption = "全选(&A)"
Shortcut = ^A
End
Begin VB.Menu DataTime
Caption = "日期/时间"
Shortcut = {F5}
End
End
Begin VB.Menu Frmat
Caption = "格式(&Q)"
Begin VB.Menu Font
Caption = "字体(&F)..."
End
Begin VB.Menu Sep4
Caption = "-"
End
Begin VB.Menu BackColor
Caption = "背景色"
End
End
End
Attribute VB_Name = "frmNotepad"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim findpos As Integer '继续查找文本的起始位置
Dim findstr As String '需要查找的字符串
Dim TextChanged As Boolean '文件修改标志
Dim FileName As String '文件名
Private Sub Form_Load()
frmNotepad.Caption = "未定标题-" & "记事本"
End Sub
Private Sub Form_Resize() '修改文本框大小
Text1.Move ScaleTop, ScaleLeft, ScaleWidth, ScaleHeight End Sub
Private Sub BackColor_Click()
CommonDialog1.ShowColor
Text1.BackColor = CommonDialog1.Color
End Sub
Private Sub Font_Click()
CommonDialog1.ShowFont
With Text1
.FontName = CommonDialog1.FontName
.FontSize = CommonDialog1.FontSize
.FontBold = CommonDialog1.FontBold
.ForeColor = CommonDialog1.Color
.FontItalic = CommonDialog1.FontItalic
.FontUnderline = CommonDialog1.FontUnderline
.FontStrikethru = CommonDialog1.FontStrikethru
End With
End Sub
Private Sub Copy_Click()
Clipboard.SetText Text1.SelText '复制文本到剪贴板
End Sub
Private Sub Cut_Click()
Clipboard.SetText Text1.SelText '复制文本到剪贴板
Text1.SelText = "" '清选择的文本
TextChanged = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim answer As Integer
If TextChanged Then
answer = MsgBox(FileName & "文件的文字已经改变。" & Chr(13) & "想保存文件吗?", vbYesNoCancel Or vbExclamation, "记事本")
End If
If answer = 6 Then '用户选择保存文件
Save_Click
ElseIf answer = 2 Then '用户选择取消操作
Cancel = 1
End If
'Text1 = "" '使程序更快退出
End Sub
Private Sub Paste_Click()
Text1.SelText = Clipboard.GetText '复制剪贴板上的内容
TextChanged = True
End Sub
Private Sub Delete_Click()
Text1.SelText = "" '清除选择的文本
TextChanged = True
End Sub
Private Sub Edit_Click()
'当程序显示“编辑”子菜单前,触发该程序
If Text1.SelLength > 0 Then
Cut.Enabled = True
Copy.Enabled = True
Delete.Enabled = True
Else
Cut.Enabled = False
Copy.Enabled = False
Delete.Enabled = False
End If
If Len(Clipboard.GetText()) > 0 Then '剪贴板中有文本数据Paste.Enabled = True
Else '没有可粘贴的文本Paste.Enabled = False
End If
End Sub
Private Sub Find_Click()
findstr = InputBox("请输入要查找的字符:", "查找", Text1.SelText)
If Len(findstr) > 0 Then
findpos = InStr(Text1.Text, findstr)
Text1.SelStart = findpos - 1
Text1.SelLength = Len(findstr)
findpos = findpos + Len(findstr)
findNext.Enabled = True '允许“找下一个...”操作End If
End Sub
Private Sub findNext_Click()
If findpos <> 0 Then
findpos = InStr(findpos, Text1.Text, findstr)
If findpos <> 0 Then
Text1.SelStart = findpos - 1
Text1.SelLength = Len(findstr)
findpos = findpos + Len(findstr)
Else
MsgBox "已达到文档的结尾部分,搜索结束。", _
vbOKOnly Or vbInformation, "查找完毕"
Exit Sub
End If
End If
End Sub
Private Sub selectAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub DataTime_Click()
Text1.SelText = Now
TextChanged = True
End Sub
Private Sub New_Click()
FileName = ""
Text1 = ""
frmNotepad.Caption = "未定标题-" & "记事本"
End Sub
Private Sub Open_Click()
Dim FileNum As Integer
Dim FileText As String
Dim TextTemp As String
Dim FileSize As Long
Dim MaxLen As Long
Dim answer As Integer
MaxLen = 65536 '文件最大长度
If TextChanged Then
answer = MsgBox(FileName & "文件的文字已经改变。" & Chr(13) & "想保存文件吗?", vbYesNoCancel Or vbExclamation, "记事本")
End If
If answer = 6 Then '用户选择保存文件
Save_Click
ElseIf answer = 2 Then '用户选择取消操作
Exit Sub
End If
CommonDialog1.ShowOpen '显示"打开文件"对话框
If Len(CommonDialog1.FileName) > 0 Then
FileName = CommonDialog1.FileName '保存文件名
FileSize = FileLen(FileName) '获得文件长度
If FileSize > MaxLen Then
'文件超长
MsgBox "该文件太大,不能显示。", vbCritical Or vbOKOnly, "记事本"
Exit Sub
End If
frmNotepad.Caption = FileName & "-" & "记事本"
FileNum = FreeFile() '获得可用文件号
Open FileName For Input As FileNum '以顺序输入方式打开文件
Do Until EOF(FileNum) And Len(FileText) < MaxLen '读必须文本小于64K Line Input #FileNum, TextTemp '读一行文字
FileText = FileText + TextTemp + Chr(13) + Chr(10) '加入回车换行符Loop
Close FileNum
Text1.Text = FileText '显示文本
FileText = "" '释放内存
TextTemp = ""
End If
TextChanged = False
End Sub
Private Sub Close_Click()
Dim answer As Integer
If TextChanged Then
answer = MsgBox(FileName & "文件的文字已经改变。" & Chr(13) & "想保存文件吗?", vbYesNoCancel Or vbExclamation, "记事本")
End If
If answer = 6 Then '用户选择保存文件
Save_Click
ElseIf answer = 2 Then '用户选择取消操作
Exit Sub
End If
Text1.Text = ""
FileName = ""
frmNotepad.Caption = "未定标题-" & "记事本"
End Sub
Private Sub print_Click()
CommonDialog1.CancelError = True
On Error GoTo aaa
CommonDialog1.ShowPrinter '显示打印对话框
Printer.FontSize = Text1.FontSize
Printer.Print Text1.Text
Printer.EndDoc
aaa: '忽略打印操作Text1.SetFocus
Exit Sub
End Sub
Private Sub Save_Click()
Dim FileNum As Integer
FileNum = FreeFile() '获得可用文件号
If frmNotepad.Caption = "未定标题-" & "记事本" Then
CommonDialog1.ShowSave '显示保存对话框
If Len(CommonDialog1.FileName) > 0 Then
FileName = CommonDialog1.FileName
Open FileName For Output As FileNum
Print #FileNum, Text1.Text
Close FileNum
frmNotepad.Caption = FileName & "-" & "记事本"
End If
End If
If frmNotepad.Caption <> "未定标题-" & "记事本" Then
Open FileName For Output As FileNum
Print #FileNum, Text1.Text
Close FileNum
End If
End Sub
Private Sub saveas_Click()
Dim FileNum As Integer
FileNum = FreeFile()
CommonDialog1.ShowSave '显示保存对话框If Len(CommonDialog1.FileName) > 0 Then
FileName = CommonDialog1.FileName
Open FileName For Output As FileNum
Print #FileNum, Text1.Text
Close FileNum
frmNotepad.Caption = FileName & "-" & "记事本"
End If
End Sub
Private Sub Exit_Click()
Unload Me
End Sub
Private Sub Text1_Change() TextChanged = True End Sub