VB记事本源代码.doc

这是窗口一（主窗体）的代码：Option ExplicitDim saveNot As BooleanDim allText As StringPrivate Sub About_Click() MsgBox 记事本 Ver1.0 版权所有(C) 魏文彬 , vbOKOnly, 关于End Sub全选功能代码Private Sub Allselect_Click() RichtextBox1.SelStart = 0 RichtextBox1.SelLength = Len(RichtextBox1.Text)End Sub背景颜色代码Private Sub BgColor_Click() CommonDialog1.ShowColor RichtextBox1.BackColor = CommonDialog1.ColorEnd Sub撤销代码Private Sub Cancel_Click() SendMessageLong RichtextBox1.hwnd, EM_UNDO, 0, 0End SubPrivate Sub Copy_Click() Clipboard.SetText RichtextBox1.SelText RichtextBox1.SetFocusEnd Sub剪切功能代码Private Sub Cut_Click() Clipboard.SetText RichtextBox1.SelText RichtextBox1.SelText = RichtextBox1.SetFocusEnd Sub时间日期代码Private Sub date_Click() RichtextBox1.SelText = DateTime.NowEnd Sub删除功能代码Private Sub Delect_Click() RichtextBox1.SelText = 删除选中的文字End Sub退出功能代码Private Sub Exit_Click() Dim x As Integer If saveNot Then x = MsgBox(文件已更改 是否保存更改, vbYesNoCancel + vbExclamation, 我的记事本) If x = 6 Then Save_Click ElseIf x = 7 Then End Else RichtextBox1.SetFocus End If Else End End IfEnd Sub查找功能代码Private Sub Find_Click() Form2.Label2.Visible = False Form2.Text2.Visible = False Form2.Command4.Visible = False Form2.Caption = 查找 Form2.ShowEnd Sub设置选中文字的字体Private Sub Font_Click() CommonDialog1.ShowFont RichtextBox1.SelFontName = CommonDialog1.FontName RichtextBox1.SelFontSize = CommonDialog1.FontSize RichtextBox1.SelBold = CommonDialog1.FontBold RichtextBox1.SelStrikeThru = CommonDialog1.FontStrikethru RichtextBox1.SelItalic = CommonDialog1.FontItalic RichtextBox1.SelUnderline = CommonDialog1.FontUnderline End Sub设置选中文字的颜色Private Sub FontColor_Click() CommonDialog1.ShowColor RichtextBox1.SelColor = CommonDialog1.ColorEnd Sub新建功能代码Private Sub New_Click() Dim x As Integer If saveNot Then x = MsgBox(文件已更改，是否保存更改, vbYesNoCancel + vbExclamation, 我的记事本) If x = 6 Then Save_Click ElseIf x = 7 Then RichtextBox1.Text = Else RichtextBox1.SetFocus End If Else RichtextBox1.Text = End IfEnd Sub打开功能代码Private Sub Open_Click() Close #1 CommonDialog1.Filter = 文本文件(*.TXT)|*.txt CommonDialog1.ShowOpen If CommonDialog1.FileName Then RichtextBox1.Text = Open CommonDialog1.FileName For Input As #1 Do While Not EOF(1) Input #1, allText RichtextBox1.Text = RichtextBox1.Text + allText + Chr(13) + Chr(10) Loop End If saveNot = FalseEnd SubPrivate Sub Paste_Click() RichtextBox1.SelText = Clipboard.GetText()End Sub打印功能代码Private Sub printer_Click() CommonDialog1.ShowPrinterEnd SubPrivate Sub Replace_Click() Form2.Label2.Visible = True Form2.Text2.Visible = True Form2.Command4.Visible = True Form2.Caption = 替换 Form2.ShowEnd Sub查看文本是否变化Private Sub RichtextBox1_Change() saveNot = TrueEnd Sub保存功能代码Private Sub Save_Click() Close #1 CommonDialog1.Filter = 文本文件(*.TXT)|*.txt CommonDialog1.ShowSave If CommonDialog1.FileName Then Open CommonDialog1.FileName For Output As #1 Print #1, RichtextBox1.Text Close #1 End If saveNot = FalseEnd Sub保持窗体一致代码Private Sub Form_Resize() If Form1.WindowState 1 Then RichtextBox1.Width = Form1.Width - 135 If Form1.Height 0 Then Form1.RichtextBox1.SelStart = textStart - 1 Form1.RichtextBox1.SelLength = Len(seekstring) Form1.SetFocus Else MsgBox 找不到 & & & seekstring & , vbInformation End IfEnd SubPrivate Sub Command2_Click() textStart = InStr(Form1.RichtextBox1.SelStart + Form1.RichtextBox1.SelLength + 1, Form1.RichtextBox1.Text, seekstring) If textStart 0 Then Form1.RichtextBox1.SelStart = textStart - 1 Form1.RichtextBox1.SelLength = Len(seekstring) Form1.SetFocus Else MsgBox 找不到 & & & seekstring & , vbInformation End IfEnd SubPrivate Sub Command3_Click() seekstring = Unload MeEnd SubPrivate Sub Command4_Click() If textStart 0 And Form1.RichtextBox1.SelText Then Form1.RichtextBox1.SelText = Text2.Text Form1.SetFocus End IfEnd Sub保持查找窗口总在最前端Private Sub Form_Load() Dim retValue As Long Const HWND_TOPMOST = -1 Const SWP_SHOWWINDOW = &H40 retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 500, 250, SWP_SHOWWINDOW)End Sub接下来就是模块的代码：Option ExplicitPublic Const EM_UNDO = &HC7Declare Function SetWindowPos Lib user32 (ByVal hwnd As Long, ByVal hwndInsertAfter As Long, _ByVal x As Long, ByVal y As Long, ByVal CX As Long, ByVal CY As Long, ByVal wflags As Long) As LongPublic Declare Function SendMessageLong Lib user32 Alias SendMessageA (ByVal hwnd As Long, ByV