记事本代码

记事本代码 Option Explicit Dim strfilename As String Dim lrc As String Dim st As String Dim starttime As String Private Sub Form_Load() Form1.Show frmlrc.Hide mnusave.Enabled = False mnusaveas.Enabled = False End Sub Private Sub Form_Unload(Cancel As Integer) Close strfilename = "" End Sub Private Sub mnuabout_Click() MsgBox "欢迎使用，记事本V1.0 Beat", vbOKOnly, "版本信息" End Sub Private Sub mnucolor_Click() dlgctrl.CancelError = True On Error GoTo errhandle With dlgctrl .ShowColor txtlrc.ForeColor = .Color End With Exit Sub errhandle: Exit Sub End Sub Private Sub mnucopy_Click() Clipboard.SetText txtlrc.SelText End Sub Private Sub mnucut_Click() Clipboard.SetText txtlrc.SelText txtlrc.SelText = "" End Sub Private Sub mnuexit_Click() Close strfilename = "" End Sub Private Sub mnufont_Click() dlgctrl.CancelError = True On Error GoTo errhandle dlgctrl.Flags = 1 With dlgctrl .ShowFont If .FontName <> "" And .FontName <> "" Then txtlrc.FontName = .FontName txtlrc.FontSize = .FontSize txtlrc.FontBold = .FontBold txtlrc.FontItalic = .FontItalic txtlrc.ForeColor = .Color End With Exit Sub errhandle: Exit Sub End Sub Private Sub mnunew_Click() mnuopen.Enabled = False mnusave.Enabled = True mnusaveas.Enabled = True frmlrc.Caption = "文档编辑" & "文档.txt" txtlrc.Alignment = 0 txtlrc.Text = "" End Sub Private Sub mnuopen_Click() mnunew.Enabled = False mnusave.Enabled = False mnusaveas.Enabled = False txtlrc.Alignment = 2 dlgctrl.CancelError = True On Error GoTo errhandle dlgctrl.DialogTitle = "打开" dlgctrl.Filter = "*.txt|*.TXT" dlgctrl.ShowOpen If dlgctrl.FileName = "" Then MsgBox " 您没有选择关联的文档～", vbOKOnly Else If strfilename <> "" Then Close End If lrc = "" txtlrc.Text = "" starttime = "" strfilename = dlgctrl.FileName Open strfilename For Input As #1 Do While Not EOF(1) Line Input #1, st txtlrc.Text = txtlrc.Text + st + vbCrLf Loop Close #1 frmlrc.Caption = "文档 " & strfilename End If Exit Sub errhandle: Exit Sub End Sub Private Sub mnupaste_Click() txtlrc.SelText = Clipboard.GetText End Sub Private Sub mnupopcopy_Click() mnucopy_Click End Sub Private Sub mnupopcut_Click() mnucut_Click End Sub Private Sub mnupoppaste_Click() mnupaste_Click End Sub Private Sub mnusave_Click() Dim strnewfile As String strnewfile = "文档.txt" Open strnewfile For Output As #2 Print #2, txtlrc.Text Close #2 End Sub Private Sub mnusaveas_Click() Dim strsaveasfile As String dlgctrl.CancelError = True On Error GoTo errhandle With dlgctrl .DialogTitle = "另存为" .Filter = "*.txt|*.TXT" .ShowSave strsaveasfile = .FileName End With If strsaveasfile <> "" Then Open strsaveasfile For Output As #2 Print #2, txtlrc.Text Close #2 End If Exit Sub errhandle: Exit Sub End Sub Private Sub tblbutton_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key Case "新建" mnunew_Click Case "打开" mnuopen_Click Case "保存" mnusave_Click Case "剪切" mnucut_Click Case "复制" mnucopy_Click Case "粘贴" mnupaste_Click Case "左对齐" txtlrc.Alignment = 0 Case "居中" txtlrc.Alignment = 2 End Select End Sub Private Sub tmlrc_Timer() L1.Caption = Time Label1.Left = Label1.Left + 300 If Label1.Left >= Me.ScaleWidth Then Label1.Left = -Label1.Width Label1.ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256) End Sub Private Sub txtlrc_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu mnupop End If End Sub Private Sub Command1_Click() If Text1.Text = "" Then answer = MsgBox("请输入用户名～", vbOKOnly + vbCritical, "错误") Exit Sub Else If Text1.Text = "wj" And Text2.Text = "123" Then answer = MsgBox("验证正确，欢迎使用～", vbOKOnly + vbInformation, "欢迎") Form1.Visible = True frmlrc.Show Unload Me Else answer = MsgBox("用户名或密码错误，请从新输入。忘记帐号或者密码请与管理员联系。", vbOKOnly + vbCritical, "错误") Text1.Text = "" Text2.Text = "" End If End If End Sub Private Sub Command2_Click() Unload Me End Sub