——————————————附錄程序清單及註釋
程序清單6.1
Option Explicit
Dim Fi
leName As String '文件名，用於打開、保存文件
Dim UndoString As String '用於 Undo 操作
Dim UndoNew As String '用於 Undo 操作
Private Sub ImgUndoDisable()
'禁用“Undo”按鈕
UndoString = ""
UndoNew = ""
ImgUndo.Enabled = False
ImgUndo.Picture = ImageDisable.ListImages("Undo").Picture
End Sub
Private Sub ImgUndoEnable()
'有效“Undo”按鈕
ImgUndo.Enabled = True
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End Sub
Private Sub Check_ImgPaste()
'設置粘貼按鈕
If Len(Clipboard.GetText) > 0 Then
ImgPaste.Enabled = True
ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
Else
ImgPaste.Enabled = False
ImgPaste.Picture = ImageDisable.ListImages("Paste").Picture
End If
End Sub
Private Sub Check_ImgCutCopy()
'設置剪切、復制按鈕
If Text1.SelLength > 0 Then
ImgCut.Enabled = True
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
ImgCopy.Enabled = True
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
Else
ImgCut.Enabled = False
ImgCut.Picture = ImageDisable.ListImages("Cut").Picture
ImgCopy.Enabled = False
ImgCopy.Picture = ImageDisable.ListImages("Copy").Picture
End If
End Sub
Private Sub BackColor_Click()
CommonDialog1.ShowColor
Text1.BackColor = CommonDialog1.Color
End Sub
Private Sub Box_Click()
'顯停工具欄
If Box.Checked Then
'將停顯工具欄
Box.Checked = False
CoolBar1.Visible = False
Else
Box.Checked = True
CoolBar1.Visible = True[NextPage]
End If
Form_Resize '重新調整控件位置
End Sub
Private Sub Close_Click()
Dim FileNum As Integer
If Len(FileName) > 0 Then
'有輸入文件名
FileNum = FreeFile() '獲得可用文件號
Open FileName For Output As FileNum '打開輸出文件
'如果無指定文件，則創建新文件
Print #FileNum, Text1.Text '輸出文本
Close FileNum '關閉文件
End If
Text1.Text = ""
FileName = ""
End Sub
Private Sub ComboSize_Click()
Text1.FontSize = Val(ComboSize.Text)
End Sub
Private Sub ComboFont_Click()
Text1.FontName = ComboFont.Text
End Sub
Private Sub Copy_Click()
Clipboard.SetText Text1.SelText '復制文本到剪裁板
End Sub
Private Sub Cut_Click()
Clipboard.SetText Text1.SelText '復制文本到剪裁板
Text1.SelText = "" '清選擇的文本
End Sub
Private Sub DataTime_Click()
Text1.SelText = Now
End Sub
Private Sub Delete_Click()
Text1.SelText = "" '清選擇的文本
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 Exit_Click()
Unload Me
End Sub
Private Sub FindText_KeyPress(KeyAscii As Integer)
Dim BeginPos As Long
If KeyAscii = 13 Then
BeginPos = InStr(1, Text1.Text, FindText.Text, vbTextCompare)
If BeginPos > 0 Then
Text1.SelStart = BeginPos - 1
Text1.SelLength = Len(FindText.Text)
End If
End If
End Sub
Private Sub Fontcolor_Click()
CommonDialog1.ShowColor
Text1.ForeColor = CommonDialog1.Color
End Sub
Private Sub Form_Load()
Dim i As Integer
'加載圖像
ImgNew.Picture = ImageUp.ListImages("New").Picture
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
ImgSave.Picture = ImageUp.ListImages("Save").Picture
ImgUndo.Picture = ImageDisable.ListImages("Undo").Picture
Check_ImgPaste
Check_ImgCutCopy
'加載系統字體
For i = 0 To Screen.FontCount - 1
ComboFont.AddItem Screen.Fonts(i)
Next i
End Sub
Private Sub Form_Resize()
Dim TextTop As Long
'修改工具條大小
CoolBar1.Top = Me.ScaleTop
Me.ScaleLeft
Text1.Width = Me.ScaleWidth
If Me.ScaleHeight > CoolBar1.Height Then
Text1.Height = Me.ScaleHeight - TextTop
Else
Text1.Height = 0
End If
End Sub
Private Sub ImgCopy_Click()
Copy_Click '復制
Check_ImgPaste
Check_ImgCutCopy
End Sub
Private Sub ImgCopy_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
'“按下”按鈕
If Button = 1 Then
ImgCopy.Picture = ImageDown.ListImages("Copy").Picture
End If
End Sub
Private Sub ImgCopy_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "將選擇的文本復制到剪裁板"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgCopy.Picture = ImageDown.ListImages("Copy").Picture[NextPage]
ElseIf Button = 1 Then
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
End If
End Sub
Private Sub ImgCopy_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgCopy.Picture = ImageUp.ListImages("Copy").Picture
End If
End Sub
Private Sub ImgCut_Click()
'If Text1.SelLength > 0 Then
Cut_Click '剪切
Check_ImgPaste
Check_ImgCutCopy
'End If
End Sub
Private Sub ImgCut_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
If Button = 1 Then
'“按下”按鈕
ImgCut.Picture = ImageDown.ListImages("Cut").Picture
End If
End Sub
Private Sub ImgCut_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "剪切選擇的文字到剪裁板"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgCut.Picture = ImageDown.ListImages("Cut").Picture
ElseIf Button = 1 Then
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
End If
End Sub
Private Sub ImgCut_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgCut.Picture = ImageUp.ListImages("Cut").Picture
End If
End Sub
Private Sub ImgNew_Click()
New_Click
End Sub
Private Sub ImgNew_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
If Button = 1 Then
'“按下”按鈕
ImgNew.Picture = ImageDown.ListImages("New").Picture
End If
End Sub
Private Sub ImgNew_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "創建新文件" '修改提示信息
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgNew.Picture = ImageDown.ListImages("New").Picture
ElseIf Button = 1 Then
ImgNew.Picture = ImageUp.ListImages("New").Picture
End If
End Sub
Private Sub ImgNew_MouseUp(Button As Integer, Shift As Int
eger, X As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgNew.Picture = ImageUp.ListImages("New").Picture
End If
End Sub
Private Sub ImgOpen_Click()
Open_Click
End Sub
Private Sub ImgOpen_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
'“按下”按鈕
If Button = 1 Then
ImgOpen.Picture = ImageDown.ListImages("Open").Picture
End If
End Sub
Private Sub ImgOpen_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "選擇文件名並打開文件"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgOpen.Picture = ImageDown.ListImages("Open").Picture
ElseIf Button = 1 Then
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
End If
End Sub
Private Sub ImgOpen_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgOpen.Picture = ImageUp.ListImages("Open").Picture
End If
End Sub
Private Sub ImgPaste_Click()
Paste_Click '粘貼
End Sub
Private Sub ImgPaste_MouseDown(Button As Integer, Shift As
Integer, X As Single, Y As Single)
If Button = 1 Then
'“按下”按鈕
ImgPaste.Picture = ImageDown.ListImages("Paste").Picture[NextPage]
End If
End Sub
Private Sub ImgPaste_MouseMove(Button As Integer, Shift As
Integer, X As Single, Y As Single)
Label1 = "粘貼文本到當前光標位置"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgPaste.Picture = ImageDown.ListImages("Paste").Picture
ElseIf Button = 1 Then
ImgPaste.Picture = ImageUp.ListImages("Paste").Picture
End If
End Sub
Private Sub ImgPaste_MouseUp(Button As Integer, Shift As Integer,
X As Single, Y As Single)
If Button = 1 Then
eName For Output As FileNum '打開輸出文件
'如果無指定文件，則創建新文件
Print #FileNum, Text1.Text '輸出文本
Close FileNum '關閉文件
ImgUndoDisable
Else
MsgBox "不能保存無名文件" + Chr(13) + Chr(10) + "請選擇“文件”菜單
的“保存”項", , "警告"
End If
End Sub
Private Sub ImgSave_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
If Button = 1 Then
ImgSave.Picture = ImageDown.ListImages("Save").Picture
End If
End Sub
Private Sub ImgSave_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "保存當前文件"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgSave.Picture = ImageDown.ListImages("Save").Picture
ElseIf Button = 1 Then
ImgSave.Picture = ImageUp.ListImages("Save").Picture
End If
Private Sub ImgUndo_MouseMove(Button As Integer, Shift As Integer,
X As Single, Y As Single)
Label1 = "取消當前操作"
'判斷鼠標位置,顯示不同圖像
If Button = 1 And (X > 0 And X < ImgNew.Width And Y > 0 And Y <
ImgNew.Height) Then
ImgUndo.Picture = ImageDown.ListImages("Undo").Picture
ElseIf Button = 1 Then
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End If
End Sub
Private Sub ImgUndo_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgUndo.Picture = ImageUp.ListImages("Undo").Picture
End If
End Sub
Private Sub New_Click()
FileName = ""
Text1 = ""
ImgUndoDisable
End Sub
Private Sub Open_Click()
Dim FileNum As Integer
Dim buffer As String
Dim buffer1 As String
Dim FileSize As Long
Dim MaxLen As Long
MaxLen = 32768 '文件最大長度
CommonDialog1.ShowOpen '顯示"打開文件"對話框
If Len(CommonDialog1.FileName) > 0 Then
'有輸入文件名
FileName = CommonDialog1.FileName '保存文件名
FileSize = FileLen(FileName) '獲得文件長度
If FileSize > MaxLen Then[NextPage]
'文件超長
MsgBox "該文件過大，只能顯示部分文本", , "警告"
Exit Sub
End If
Screen.MousePointer = 11 '設置鼠標為沙漏
FileNum = FreeFile() '獲得可用文件號
Open FileName For Input As FileNum '以順序輸入方式打開文件
Do While Not EOF(FileNum) And Len(buffer) < MaxLen '讀必須文本小於
32K
Line Input #FileNum, buffer1 '讀壹行文字
buffer = buffer + buffer1 + Chr(13) + Chr(10) '加入回車換行符
Loop '循環體
Close FileNum '關閉文件
ImgUndoDisable '取消 Undo 功能
Text1.Text = buffer '顯示文本
UndoNew = buffer '保存文本
buffer = "" '釋放內存
buffer1 = ""
Screen.MousePointer = 0 '恢復鼠標指針
Me.Caption = "記事本 - " + FileName '修改標題顯示
End If
End Sub
Private Sub Paste_Click()
Text1.SelText = Clipboard.GetText
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As
Integer, X As Single, Y As Single)
Label1 = "工具欄"
End Sub
Private Sub Picture1_Resize()
If Picture1.Width > Label1.Left Then
Label1.Width = Picture1.ScaleWidth - Label1.Left
End If
End Sub
Private Sub Save_Click()
Dim FileNum As Integer '文件句柄號
CommonDialog1.ShowSave '顯示保存對話框
If Len(CommonDialog1.FileName) > 0 Then
'有輸入文件名
FileName = CommonDialog1.FileName '保存文件名
FileNum = FreeFile() '獲得可用文件號
Open FileName For Output As FileNum '打開輸出文件
'如果無指定文件，則創建新文件
Print #FileNum, Text1.Text '輸出文本
Close FileNum '關閉文件
Me.Caption = "記事本 - " + FileName '修改標題顯示
ImgUndoDisable
End If
End Sub
Private Sub Text1_Change()
If Not ImgUndo.Enabled Then
'使“Undo”按鈕可用
ImgUndoEnable
End If
UndoString = UndoNew
UndoNew = Text1
End Sub
Private Sub Text1_Click()
Check_ImgCutCopy
End Sub
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
Check_ImgCutCopy
End sub
End Sub
Private Sub ImgSave_MouseUp(Button As Integer, Shift As Integer, X
As Single, Y As Single)
If Button = 1 Then
'“擡起”按鈕
ImgSave.Picture = ImageUp.ListImages("Save").Picture
End If
End Sub
Private Sub ImgUndo_Click()
Text1.Text = UndoString
End Sub
Private Sub ImgUndo_MouseDown(Button As Integer, Shift As Integer,
X As Single, Y As Single)
If Button = 1 Then
'“按下”按鈕
ImgUndo.Picture = ImageDown.ListImages("Undo").Picture
End If
End Sub