📄 form1.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form FrmMain
ClientHeight = 4485
ClientLeft = 165
ClientTop = 555
ClientWidth = 6810
Icon = "Form1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 4485
ScaleWidth = 6810
StartUpPosition = 2 '屏幕中心
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 300
Left = 1260
Top = 2400
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 200
Left = 675
Top = 2370
End
Begin MSComDlg.CommonDialog File
Left = 120
Top = 2340
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DefaultExt = "*.txt"
DialogTitle = "请选择欲打开的文件"
Filter = "记事本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
End
Begin VB.TextBox Text1
Height = 1230
Left = 690
MultiLine = -1 'True
OLEDropMode = 1 'Manual
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 405
Width = 2040
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Height = 1485
Left = 105
TabIndex = 3
Top = 165
Width = 450
End
Begin VB.Label Label2
Caption = "第 1 行,第 0 列"
Height = 240
Left = 825
TabIndex = 2
Top = 1845
Width = 2280
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "记事本"
Height = 240
Left = 45
TabIndex = 1
Top = 1830
Width = 1050
End
Begin VB.Menu MenFile
Caption = "文件(&F)"
Begin VB.Menu MenNew
Caption = "新建(&N)"
Shortcut = ^N
End
Begin VB.Menu MenOpen
Caption = "打开(&O)..."
Shortcut = ^O
End
Begin VB.Menu MenSave
Caption = "保存(&S)"
Shortcut = ^S
End
Begin VB.Menu MenSaveAs
Caption = "另存为(&A)..."
End
Begin VB.Menu MenFileAttr
Caption = "文件属性(&F)..."
Shortcut = ^{F1}
End
Begin VB.Menu MenFileP1
Caption = "-"
End
Begin VB.Menu MenFileB
Caption = "最近打开项(&B)"
Enabled = 0 'False
Index = 0
End
Begin VB.Menu MenFileP2
Caption = "-"
End
Begin VB.Menu MenPage
Caption = "页面设置(&U)..."
End
Begin VB.Menu MenPrint
Caption = "打印(&P)..."
Shortcut = ^P
End
Begin VB.Menu MenFileP3
Caption = "-"
End
Begin VB.Menu MenQuit
Caption = "退出(&Q)"
End
End
Begin VB.Menu MenEdit
Caption = "编辑(&E)"
Begin VB.Menu MenEditZ
Caption = "撤消(&Z)"
Enabled = 0 'False
Shortcut = ^Z
End
Begin VB.Menu MenEditP1
Caption = "-"
End
Begin VB.Menu MenEditX
Caption = "剪切(&X)"
Shortcut = ^X
End
Begin VB.Menu MenCopy
Caption = "复制(&C)"
Shortcut = ^C
End
Begin VB.Menu MenEditV
Caption = "粘贴(&V)"
Shortcut = ^V
End
Begin VB.Menu MenDel
Caption = "删除(&D)"
Shortcut = {DEL}
End
Begin VB.Menu MenCls
Caption = "清空剪贴板(&C)"
End
Begin VB.Menu MenEditP2
Caption = "-"
End
Begin VB.Menu MenFind
Caption = "查找(&F)..."
Shortcut = ^F
End
Begin VB.Menu MenFindNext
Caption = "查找下一个(&N)"
Enabled = 0 'False
Shortcut = {F3}
End
Begin VB.Menu MenEditT
Caption = "替换(&T)..."
Shortcut = ^H
End
Begin VB.Menu MenGoTo
Caption = "转到(&G)..."
Enabled = 0 'False
Shortcut = ^G
End
Begin VB.Menu MenEditP3
Caption = "-"
End
Begin VB.Menu MenAll
Caption = "全选(&A)"
Shortcut = ^A
End
Begin VB.Menu MenDate
Caption = "时间/日期(&D)"
Shortcut = {F5}
End
End
Begin VB.Menu MenOption
Caption = "格式(&O)"
Begin VB.Menu MenOptionZ
Caption = "自动换行(&Z)"
Checked = -1 'True
End
Begin VB.Menu MenFont
Caption = "字体(&F)..."
End
Begin VB.Menu MenColor
Caption = "颜色(&C)..."
End
End
Begin VB.Menu MenView
Caption = "查看(&V)"
Begin VB.Menu MenViewZ
Caption = "状态栏(&Z)"
Checked = -1 'True
End
End
Begin VB.Menu MenHelp
Caption = "帮助(&H)"
Begin VB.Menu MenHelpM
Caption = "帮助主题(&H)..."
End
Begin VB.Menu MenHelpP1
Caption = "-"
End
Begin VB.Menu MenAbout
Caption = "关于记事本(&A)..."
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Dim FormWidth As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETLINECOUNT = &HBA
Private Const EM_LINELENGTH = &HC1
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Enum FileNewOpen
new1 = 1
open1 = 2
End Enum
Private Sub Form_Load()
Call FrmMainRefresh
End Sub
Private Sub Form_Resize()
On Error Resume Next
FormHeight = Me.ScaleHeight - Label1.Height
Label1.Move 0, Me.ScaleHeight - Label1.Height + 30, Me.ScaleWidth - Label2.Width
Label2.Move Label1.Width, Me.ScaleHeight - Label2.Height + 30
Label3.Move 0, 0, Label3.Width, Me.ScaleHeight - Label1.Height
Text1.Move Label3.Width, 0, Me.ScaleWidth - Label3.Width, FormHeight
Dim temp As Long
'Timer2.Enabled = True
Dim n As Long, s As String
For n = 1 To 100
s = s & n & vbNewLine
Next n
Label3.Caption = s
End Sub
Private Sub Form_Unload(Cancel As Integer)
If FileEdit = True Then
Select Case MsgBox("文件已修改,是否进行保存?", vbYesNoCancel + 32)
Case vbYes
Call FileSave(True)
Case vbCancel
Cancel = True
Case vbNo
End
End Select
End If
End Sub
Private Sub MenAbout_Click()
ShowMsg "正在查看关于"
frmAbout.Show , FrmMain
End Sub
Private Sub MenAll_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
ShowMsg "已经选择了整篇文档"
End Sub
Private Sub MenCls_Click()
Clipboard.Clear
ShowMsg "已经成功清空了剪贴板"
End Sub
Private Sub MenColor_Click()
File.Flags = 4
File.ShowColor
If File.Color <> 0 Then Text1.ForeColor = File.Color
End Sub
Private Sub MenCopy_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText, vbCFText
ShowMsg "已经将数据复制到了剪贴板"
End Sub
Private Sub MenDate_Click()
Text1.SelText = Now & Space(2) & "星期" & Choose(Weekday(Now, vbMonday), "一", "二", "三", "四", "五", "六", "日")
ShowMsg "已经将日期插入在文档中"
End Sub
Private Sub MenDel_Click()
Text1.SelText = ""
ShowMsg "已经删除了选定的文本"
End Sub
Private Sub MenEdit_Click()
'是否有选择的文字
If Text1.SelText <> "" Then
MenCopy.Enabled = True
MenEditX.Enabled = True
MenDel.Enabled = True
Else
MenCopy.Enabled = False
MenEditX.Enabled = False
MenDel.Enabled = False
End If
'如果文本为空
If Text1.Text = "" Then
MenFind.Enabled = False
MenAll.Enabled = False
Else
MenFind.Enabled = True
MenAll.Enabled = True
End If
'粘贴 查看剪贴板
If Clipboard.GetText(vbCFText) <> "" Then
MenEditV.Enabled = True
MenCls.Enabled = True
Else
MenEditV.Enabled = False
MenCls.Enabled = False
End If
End Sub
Private Sub MenEditT_Click()
ShowMsg "正在查找数据"
Call MenFind_Click
End Sub
Private Sub MenEditV_Click()
Text1.SelText = Clipboard.GetText(vbCFText)
ShowMsg "已经将剪贴板的数据粘贴到了文档中"
End Sub
Private Sub MenEditX_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText, vbCFText
Text1.SelText = ""
ShowMsg "已经将选中的数据剪切到了剪贴板上"
End Sub
Private Sub MenFileAttr_Click()
ShowMsg "正在查看文件属性"
FrmShu.Show 1
End Sub
Private Sub MenFind_Click()
ShowMsg "正在查找数据"
FrmFind.Show , FrmMain
End Sub
Private Sub MenFont_Click()
On Error Resume Next
File.Flags = 7
File.ShowFont
If Trim(File.FontName) <> "" Then
Text1.FontName = File.FontName
Text1.FontSize = File.FontSize
Text1.FontBold = File.FontBold
Text1.FontStrikethru = File.FontStrikethru
End If
End Sub
Private Sub MenGoTo_Click()
ShowMsg "此功能暂时不能用"
FrmGo.Show , FrmMain
End Sub
Private Sub MenHelpM_Click()
Dim temp As String
ShowMsg "正在查看记事本帮助"
temp = Environ("windir") & "\help\notepad.chm"
Shell Environ("windir") & "\hh.exe " & temp, vbNormalFocus
End Sub
Private Sub MenNew_Click()
Call FileSaveYN(new1)
End Sub
Private Sub MenOpen_Click()
Call FileSaveYN(open1)
End Sub
Private Sub MenOptionZ_Click()
On Error Resume Next
MenOptionZ.Checked = Not (MenOptionZ.Checked)
'
Exit Sub
'If MenOptionZ.Checked = True Then
' Text1.ScrollBars = 2
'Else
' Text1.ScrollBars = 0
'End If
End Sub
Private Sub MenQuit_Click()
Unload Me
End Sub
Private Sub MenSave_Click()
Call FileSave
End Sub
Private Sub Text1_Change()
FileEdit = True
Call Text1_KeyUp(0, 0)
End Sub
Sub FileSaveYN(NewOrOpen As FileNewOpen)
ShowMsg "正在思考是否保存文件", True
Dim MsgSel As Long
If FileEdit = True Then
MsgSel = MsgBox("文件 " & FileName & " 已经修改,是否保存?", 3 + 32 + vbDefaultButton3, App.Title, "notepad.chm", 0)
Else
Select Case NewOrOpen
Case new1
FileNew
Case open1
FileOpen
End Select
End If
Select Case NewOrOpen
Case new1
Select Case MsgSel
Case vbYes
Call FileSave
Call FileNew
Case vbNo
Call FileNew
Case vbCancel
End Select
Case open1
Select Case MsgSel
Case vbYes
Call FileSave
Call FileOpen
Case vbNo
Call FileOpen
Case vbCancel
End Select
Case Else
Err.Raise 19871, , "没有此选项!"
End Select
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Static X As Long
Static y As Long
y = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, 0)
X = SendMessage(Text1.hwnd, EM_LINELENGTH, y, 0)
Dim n As Long, m As Long
m = 1
Do While True
n = InStr(n + 1, Text1.Text, vbNewLine, vbBinaryCompare)
If n <> 0 Then m = m + 1 Else Exit Do
Loop
Label2.Caption = "第 " & m & " 行" & " 第 " & X & " 列"
ShowMsg "记事本 文档正在编辑中...", True
End Sub
Private Sub Timer1_Timer()
Static n As Integer
n = n + 1
If n >= 10 Then
n = 0
FrmMain.Timer1.Enabled = False
Else
FrmMain.Timer1.Enabled = True
End If
If Label1.BackColor = MsgColor Then
Label1.BackColor = vbDesktop
Else
Label1.BackColor = MsgColor
End If
Label2.BackColor = Label1.BackColor
End Sub
Private Sub Timer2_Timer()
Static n As Long
n = n + 1
If n >= 4 Then
n = 0
Timer2.Enabled = False
Else
Timer2.Enabled = True
End If
FlashWindow Me.hwnd, True
DoEvents
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -