vb的简单记事本的代码

'窗体代码

东洲网站制作公司哪家好，找创新互联！从网页设计、网站建设、微信开发、APP开发、响应式网站设计等网站项目制作，到程序开发，运营维护。创新互联于2013年开始到现在10年的时间，我们拥有了丰富的建站经验和运维经验，来保证我们的工作的顺利进行。专注于网站建设就选创新互联。

Option Explicit

Dim filename As String

Dim FileType As String

Dim FiType As String

Dim sFind As String

Dim result As String

Dim bWrap As Boolean

Dim ask As Boolean

Dim msgtext As String

Dim Flag As String

Private Sub Form_Load()

ask = False

RichText.Text = ""

filename = "无标题-记事本"

Form1.Caption = "无标题-记事本"

RichText.Height = Form1.ScaleHeight

RichText.Width = Form1.ScaleWidth

StatusBar1.Visible = False

StatusBar1.Panels(1).Text = Time

mnucopy.Enabled = False

mnucut.Enabled = False

mnufound.Enabled = False

mnufoundnext.Enabled = False

mnudel.Enabled = False

mnucancel.Enabled = False

mnuwordwrap.Checked = True

mnugoto.Enabled = False

If Clipboard.GetText "" Then

mnuplaster.Enabled = True

Else

mnuplaster.Enabled = False

End If

App.HelpFile = App.Path "\notepad.chm"

End Sub

Private Sub Form_Resize()

RichText.Height = Form1.ScaleHeight

RichText.Width = Form1.ScaleWidth

End Sub

Private Sub Form_Unload(Cancel As Integer)

msgtext = "文件" filename "的文字已经改变。" Chr(10) Chr(13) "想保存文件吗？"

If ask = True Then

Flag = MsgBox(msgtext, 35, "记事本") ' 35=32+3

If Flag = vbYes Then mnusave_Click '选择了确定则保存之

If Flag = vbCancel Then Cancel = True

If Flag = vbNo Then Unload Me

End If

End Sub

Private Sub mnuabout_Click()

MsgBox "记事本", vbOKOnly, "关于"

End Sub

Private Sub mnuall_Click()

RichText.SelStart = 0

RichText.SelLength = Len(RichText.Text)

End Sub

Private Sub mnucancel_Click()

MsgBox "请点击鼠标右键撤销！", vbOKOnly, "提示"

End Sub

Private Sub mnucopy_Click()

Clipboard.Clear

Clipboard.SetText RichText.SelText

End Sub

Private Sub mnucut_Click()

Clipboard.Clear

Clipboard.SetText RichText.SelText

RichText.SelText = ""

End Sub

Private Sub mnudel_Click()

RichText.SelText = ""

End Sub

Private Sub mnuedit_Click()

If RichText.SelText "" Then

mnuopen.Enabled = True

mnucut.Enabled = True

mnudel.Enabled = True

mnucopy.Enabled = True

End If

If Len(RichText.Text) 0 Then

mnufound.Enabled = True

mnufoundnext.Enabled = True

End If

If ask = True Then mnucancel.Enabled = True

End Sub

Private Sub mnuexit_Click()

Unload Me

End Sub

Private Sub mnufont_Click()

On Error Resume Next

CommonDialog1.flags = H3 Or H1 Or H2 Or H100

CommonDialog1.Action = 4

RichText.Font.Name = CommonDialog1.FontName

RichText.Font.Size = CommonDialog1.FontSize

RichText.Font.Bold = CommonDialog1.FontBold

RichText.Font.Italic = CommonDialog1.FontItalic

RichText.Font.Underline = CommonDialog1.FontUnderline

RichText.SelColor = CommonDialog1.Color

End Sub

Private Sub mnufound_Click()

sFind = InputBox("请输入要查找的字、词：", "查找内容", sFind)

RichText.Find sFind

End Sub

Private Sub mnufoundnext_Click()

RichText.SelStart = RichText.SelStart + RichText.SelLength + 1

RichText.Find sFind, , Len(RichText)

End Sub

Private Sub mnuhelptopic_Click()

SendKeys "{F1}"

End Sub

Private Sub mnunewfile_Click()

On Error Resume Next

Dim n As Integer

msgtext = "文件" filename "的文字已经改变。" Chr(10) Chr(13) "想保存文件吗？"

If Len(RichText.Text) 0 Then

If filename = "无标题-记事本" Then

Flag = MsgBox(msgtext, 35, "记事本") '给予提示

If Flag = vbYes Then

mnusaveas_Click

RichText.Text = ""

Form1.Caption = "无标题-记事本"

filename = "无标题-记事本"

End If

If Flag = vbCancel Then Exit Sub

If Flag = vbNo Then

RichText.Text = ""

Form1.Caption = "无标题-记事本"

filename = "无标题-记事本"

End If

End If

End If

End Sub

Private Sub mnuopen_Click()

msgtext = "文件" filename "的文字已经改变。" Chr(10) Chr(13) "想保存文件吗？"

On Error Resume Next

If ask = True Then

Flag = MsgBox(msgtext, 35, "记事本") '给予提示

If Flag = vbYes Then mnusave_Click '选择了确定则保存之

If Flag = vbCancel Then Exit Sub

If Flag = vbNo Then GoTo L1

End If

ask = False

L1: CommonDialog1.Filter = "文本文档(*.txt)|*.txt|RTF文档(*.rtf)|*.rtf|所有文件(*.*)|*.*"

CommonDialog1.ShowOpen

RichText.Text = "" '清空文本框

filename = CommonDialog1.filename

RichText.LoadFile filename

result = GetFileTitle(filename)

Me.Caption = "" result "-记事本"

End Sub

Private Sub mnupagesetup_Click()

psdlg.lStructSize = Len(psdlg)

psdlg.hwndOwner = hwnd

PageSetupDlg psdlg

End Sub

Private Sub mnuplaster_Click()

RichText.SelText = Clipboard.GetText(1)

End Sub

Private Sub mnuprint_Click()

Dim f As Integer, t As Integer

Dim i As Integer

CommonDialog1.CancelError = True

CommonDialog1.Max = 1000

CommonDialog1.Min = 1

On Error Resume Next

CommonDialog1.ShowPrinter

For f = CommonDialog1.FromPage To t = CommonDialog1.ToPage

Do While i CommonDialog1.Copies + 1

Printer.Print RichText.Text

i = i + 1

Loop

Next

Printer.EndDoc

Cancel:

If Err.Number = 32755 Then

Exit Sub

End If

End Sub

Private Sub mnusave_Click()

CommonDialog1.Filter = "文本文档(*.txt)|所有文件(*.*)|*.*"

On Error Resume Next

filename = CommonDialog1.filename '保存文件

If filename "" Then

RichText.SaveFile filename, rtfText

Else

mnusaveas_Click

End If

ask = False

End Sub

Private Sub mnusaveas_Click()

CommonDialog1.Filter = "文本文档(*.txt)|所有文件(*.*)|*.*"

On Error Resume Next

CommonDialog1.ShowSave

filename = CommonDialog1.filename

RichText.SaveFile filename, rtfText

result = GetFileTitle(filename)

Me.Caption = "" result "-记事本"

ask = False

End Sub

Private Sub mnustatusbar_Click()

If mnustatusbar.Checked Then

StatusBar1.Visible = False

mnustatusbar.Checked = False

Else

StatusBar1.Visible = True

mnustatusbar.Checked = True

End If

End Sub

Private Sub mnutimedate_Click()

RichText.SelText = Format(Now, "h:mm ddddd")

End Sub

Private Sub mnuwordwrap_Click()

WrapTextLine RichText, bWrap

bWrap = Not bWrap

If mnuwordwrap.Checked = False Then

HScroll1.Enabled = True

mnuwordwrap.Checked = True

Else

HScroll1.Enabled = False

mnuwordwrap.Checked = False

End If

End Sub

Private Sub RichText_Change()

ask = True

End Sub

Private Sub Timer1_Timer()

If StatusBar1.Panels(1).Text CStr(Time) Then

StatusBar1.Panels(1).Text = Time

End If

End Sub

'模块代码

Option Explicit

Const WM_USER = H400

Const EM_SETTARGETDEVICE = (WM_USER + 72)

Type POINTAPI

x As Long

y As Long

End Type

Type RECT

left As Long

right As Long

top As Long

bottom As Long

End Type

Public Type PageSetupDlg

lStructSize As Long

hwndOwner As Long

hDevMode As Long

hDevNames As Long

flags As Long

ptPaperSize As POINTAPI

rtMinMargin As RECT

rtMargin As RECT

hInstance As Long

lCustData As Long

lpfnPageSetupHook As Long

lpfnPagePaintHook As Long

lpPageSetupTemplateName As String

hPageSetupTemplate As Long

End Type

Public psdlg As PageSetupDlg

Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PageSetupDlg) As Long

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim bWrap As Boolean '// 换行标记'// 自定义一个换行的过程

Public Sub WrapTextLine(ByRef RichText As RichTextBox, ByVal bWrapSwitch As Boolean)

On Error Resume Next

If bWrapSwitch Then '// 设置 RichTextBox 自动换行

SendMessage RichText.hwnd, EM_SETTARGETDEVICE, GetDC(RichText.hwnd), RichText.Width / 15

RichText.RightMargin = IIf(RichText.RightMargin = 0, 1, 0)

Else

'// 设置 RichTextBox 不自动换行

SendMessage RichText.hwnd, EM_SETTARGETDEVICE, 0, 1

End If

End Sub

Function GetFileTitle(OldStr As String) As String

On Error Resume Next

Dim n As Integer, m As Integer '声明字符串变量

Dim i As String, r As String

Dim p As Integer

i = "\" '要查找的指定字符

For n = 1 To Len(OldStr) '用Len函数计算已知字符串的字节数

m = InStrRev(OldStr, i, -1) '"\"所在的位置(其中的-1是默认的)

Next n '找下去！

'截取最后一个"\"后面的字符串

r = right(OldStr, Len(OldStr) - m) '获取Title

p = InStrRev(r, ".", -1) '"."所在位置

GetFileTitle = left(r, p - 1) '去掉后缀

End Function

用vb.net编写记事本源代码

Dim sFileName As String

Dim Search

Private Sub dateTimeMenu_Click()

Text1.Text = Now

End Sub

Private Sub deleteMenu_Click()

Text1.Text = Left(Text1.Text, Text1.SelStart) + Mid(Text1.Text, Text1.SelStart + Text1.SelLength + 1)

End Sub

Private Sub findMenu_Click()

Search = InputBox("请输入要查找的字词：")

Dim Where1 '获取需要查找的字符串变量

Text1.SetFocus '文本框获得焦点，以显示所找到的内容Search = InputBox("请输入要查找的字词：")

Where1 = InStr(Text1.Text, Search) '在文本中查找字符串

If Where1 Then

'若找到则设置选定的起始位置并使找到的字符串高亮

Text1.SelStart = Where1 - 1

Text1.SelLength = Len(Search)

' Me.Caption = Where1 '测试用

'否则给出提示

Else: MsgBox "未找到所要查找的字符串。", vbInformation, "提示"

End If

End Sub

Private Sub findNextMenu_Click()

Dim Where2

Dim StartMe As Integer '查找的起始位置变量

Text1.SetFocus '文本框获得焦点

StartMe = Text1.SelLength + Text1.SelStart + 1 '给变量赋值

Where2 = InStr(StartMe, Text1.Text, Search) '令其从上次找到的地方找起

If Where2 Then

Text1.SelStart = Where2 - 1

Text1.SelLength = Len(Search)

Else: MsgBox "未找到所要查找的字符串.", vbInformation, "提示"

End If

End Sub

Private Sub aboutMenu_Click()

MsgBox Space(2) "文本编辑器版本号1.0" Chr(13) "由西南财经大学天府学院" Chr(13) Space(5) "肖忠 开发" Chr(13) Space(2) "copyright:天府学院"

End Sub

Private Sub allMenu_Click()

Text1.SelStart = 0

Text1.SelLength = Len(Text1.Text)

End Sub

Private Sub backcolorMenu_Click() '设置背景色代码

Form1.CommonDialog1.Action = 3

Text1.BackColor = Form1.CommonDialog1.Color

End Sub

Private Sub colorMenu_Click() '改变文字颜色代码

Form1.CommonDialog1.Action = 3

Text1.ForeColor = Form1.CommonDialog1.Color

End Sub

Private Sub cutMenu_Click()

Clipboard.SetText Text1.SelText

Text1.Text = Left(Text1.Text, Text1.SelStart) + Mid(Text1.Text, Text1.SelStart + Text1.SelLength + 1)

End Sub

Private Sub exitMenu_Click()

End

End Sub

Private Sub fontMenu_Click() '字体菜单代码

Form1.CommonDialog1.Flags = 3 Or 256

Form1.CommonDialog1.Action = 4

If Len(Form1.CommonDialog1.FontName) = 0 Then

Form1.Text1.FontName = "宋体"

Else

Form1.Text1.FontName = Form1.CommonDialog1.FontName

End If

Form1.Text1.FontSize = Form1.CommonDialog1.FontSize

If Form1.CommonDialog1.FontBold = True Then

Form1.Text1.FontBold = True

Else

Form1.Text1.FontBold = False

End If

If Form1.CommonDialog1.FontItalic = True Then

Form1.Text1.FontItalic = True

Else

Form1.Text1.FontItalic = False

End If

Text1.ForeColor = Form1.CommonDialog1.Color

End Sub

Private Sub Form_Load()

Form1.Text1.Width = Form1.Width - 130

Form1.Text1.Height = Form1.Height

End Sub

Private Sub Form_Resize()

Form1.Text1.Width = Form1.Width - 130

Form1.Text1.Height = Form1.Height

End Sub

Private Sub help1Menu_Click()

Form1.CommonDialog1.HelpCommand = cdlHelpForceFile

Form1.CommonDialog1.HelpFile = "c:\windows\system32\winhelp.hlp"

CommonDialog1.ShowHelp

End Sub

Private Sub newMenu_Click()

If Len(Trim(Text1.Text)) = 0 Then

Form1.Caption = "我的记事本" "--" "未命名"

sFileName = "未命名"

Text1.FontSize = 15

Text1.FontName = "宋体"

Text1.Text = ""

Else

Call saveAsMenu_Click

Form1.Caption = "我的记事本" "--" "未命名"

sFileName = "未命名"

Text1.FontSize = 15

Text1.FontName = "宋体"

Text1.Text = ""

End If

End Sub

Private Sub openMenu_Click() '打开文件代码

If Len(Trim(Text1.Text)) = 0 Then

Form1.Caption = "我的记事本"

Form1.CommonDialog1.Filter = "文本文件|*.txt"

Form1.CommonDialog1.Flags = 4096

Form1.CommonDialog1.Action = 1

If Len(Form1.CommonDialog1.FileName) 0 Then

sFileName = Form1.CommonDialog1.FileName

Form1.Caption = Form1.Caption "--" Form1.CommonDialog1.FileTitle

Open sFileName For Input As #1

Text1.FontSize = 15

Text1.FontName = "宋体"

Do While Not EOF(1)

Line Input #1, Text$

All$ = All$ + Text$ + Chr(13) + Chr(10)

Loop

Text1.Text = All

Close #1

End If

Else

Call saveAsMenu_Click

Form1.Caption = "我的记事本"

Form1.CommonDialog1.Filter = "文本文件|*.txt"

Form1.CommonDialog1.Flags = 4096

Form1.CommonDialog1.Action = 1

If Len(Form1.CommonDialog1.FileName) 0 Then

sFileName = Form1.CommonDialog1.FileName

Form1.Caption = Form1.Caption "--" Form1.CommonDialog1.FileTitle

Open sFileName For Input As #1

Text1.FontSize = 15

Text1.FontName = "宋体"

Do While Not EOF(1)

Line Input #1, Text$

All$ = All$ + Text$ + Chr(13) + Chr(10)

Loop

Text1.Text = All

Close #1

End If

End If

End Sub

Private Sub pasteMenu_Click() '粘贴菜单代码

Text1.Text = Left(Text1.Text, Text1.SelStart) + Clipboard.GetText() + Mid(Text1.Text, Text1.SelStart + Text1.SelLength + 1)

End Sub

Private Sub printMenu_Click()

Form1.CommonDialog1.ShowPrinter

For i = 1 To CommonDialog1.Copies

Printer.Print Text1.Text

Printer.Print Text1.Text

Next

Printer.EndDoc

End Sub

Private Sub saveAsMenu_Click() '另存为菜单代码

If Len(Trim(Text1.Text)) 0 Then

Form1.CommonDialog1.DialogTitle = "保存文件"

Form1.CommonDialog1.InitDir = "D:\"

Form1.CommonDialog1.Filter = "文本文件|*.txt"

Form1.CommonDialog1.Flags = 2

Form1.CommonDialog1.ShowSave

If Len(Form1.CommonDialog1.FileName) 0 Then

sFileName = Form1.CommonDialog1.FileName

Open sFileName For Output As #1

whole$ = Text1.Text

Print #1, whole

Close #1

End If

End If

End Sub

Private Sub saveMenu_Click()

If Len(Trim(Text1.Text)) 0 Then

Form1.CommonDialog1.DialogTitle = "保存文件"

Form1.CommonDialog1.InitDir = "D:\"

Form1.CommonDialog1.FileName = "新建文本"

Form1.CommonDialog1.Filter = "文本文件|*.txt"

Form1.CommonDialog1.Flags = 2

Form1.CommonDialog1.ShowSave

If Len(Form1.CommonDialog1.FileName) 0 Then

sFileName = Form1.CommonDialog1.FileName

Open sFileName For Output As #1

whole$ = Text1.Text

Print #1, whole

Close #1

End If

End If

End Sub

Private Sub statusMenu_Click()

End Sub

VB编写记事本

vb编写的简单记事本代码

Dim b As String

Dim a As String

Dim m As String

Dim x As String

Private Declare 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 Long

Const HWND_TOPMOST = -1

Const SWP_SHOWWINDOW = H40

Private Sub baocun_Click()

Dim abc As String

If Len(Trim(m)) = 0 Then

m = "f:"

End If

abc = m "\" Text2.Text ".txt"

Open abc For Output As #1

Write #1, Text1.Text

Close #1

Label2.Caption = "保存的路径为：" m "\" Text2.Text ".txt"

a = MsgBox("保存成功！" Chr(13) "是否退出程序", 4 + 64 + 0, "提示")

If a = vbYes Then

End

End If

End Sub

Private Sub Command1_Click()

Dir1.Visible = False

Drive1.Visible = False

m = Dir1.Path

Command1.Visible = False

b = MsgBox("你选的文件夹是：" m, vbYesNo + vbDefaultButton1 + 48, "提示")

If b = vbNo Then

Dir1.Visible = True

Drive1.Visible = True

Command1.Visible = True

Else

Dir1.Visible = False

Drive1.Visible = False

Command1.Visible = False

End If

End Sub

Private Sub Command2_Click()

MsgBox (App.Path + "1.ico")

End Sub

Private Sub dakai_Click()

CommonDialog1.Filter = "文本文件(*.txt)|*.txt"

CommonDialog1.ShowOpen

Open CommonDialog1.FileName For Input As #1

Dim abc As String

linefromfile = StrConv(InputB(LOF(1), 1), vbUnicode)

Text1.Text = linefromfile

Close #1

End Sub

Private Sub Drive1_Change()

Dir1.Path = Drive1.Drive

End Sub

Private Sub Form_Load()

Drive1.Drive = "f:\"

Dir1.Visible = False

Drive1.Visible = False

Command1.Visible = False

Dim fullpath As String

If Right(App.Path, 1) = "\" Then

fullpath = App.Path + "1.ico"

Else

fullpath = App.Path + "\" + "1.ico"

Form1.Icon = LoadPicture(fullpath)

End If

End Sub

Private Sub lingcunwei_Click()

Dim abc As String

CommonDialog1.ShowSave

If Len(Trim(CommonDialog1.FileName)) 0 Then

x = CommonDialog1.FileName

Else

x = "f:\1.txt"

End If

Open x For Append As #1

Write #1, Text1.Text

Close #1

End Sub

Private Sub s_Click()

Text1.FontSize = 5

End Sub

Private Sub sanhao_Click()

Text1.FontSize = 12

End Sub

Private Sub st_Click()

CommonDialog1.ShowFont

End Sub

Private Sub shybcdwjj_Click()

Dir1.Visible = True

Drive1.Visible = True

Command1.Visible = True

End Sub

Private Sub Text2_GotFocus()

Dir1.Visible = False

Drive1.Visible = False

Command1.Visible = False

End Sub

Private Sub tuichu_Click()

End

End Sub

Private Sub wh_Click()

Text1.FontSize = 10

End Sub

Private Sub whs_Click()

Text1.FontSize = 10.5

End Sub

Private Sub xinjian_Click()

Text1.Text = ""

Text2.Text = ""

End Sub

Private Sub yh_Click()

Text1.FontSize = 24

End Sub

Private Sub zstj_Click()

MsgBox "所有字数为" Len(Text1.Text), , " 字数"

End Sub

Private Sub ztys_Click()

CommonDialog1.ShowColor

Text1.ForeColor = CommonDialog1.Color

End Sub

Private Sub zzqm_Click()

Dim retValue As Long

'将窗体设置为处于所有窗口的顶层，注意在 VB 中运行时，可能不行，但编译成EXE后就可以了

retValue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 380, 615, SWP_SHOWWINDOW)

End Sub

网页标题：vb.net+记事本源码的简单介绍
地址分享：http://kswjz.com/article/hhoope.html