VB制作个人专用记事本的代码谁有啊?
我想做个人记事本,但是没有代码,如果谁有,请给我写上,标清楚是新建文件、保存等等这些标记!多谢!
我想做个人记事本,但是没有代码,如果谁有,请给我写上,标清楚是新建文件、保存等等这些标记!多谢!
答案:此工程需另外添加三个timer控件、一个通用对话框(commondialog)控件、一个richtextbox控件。 下面代码 直接复制到代码编译器中即可。
Dim filem As String '保存文件名
Dim str As String
Dim msg
Dim bu As Boolean '用于判断文本框中的内容是否改变
Public Nexts As Double '用于存储查找末字符的位置
Public Sv, mo As Double 'sv用于存储查的下一个字符的位置,mo用于存储查找第一次查找字符的位置
Dim Cmt(3) As Single, Cml(3) As Single, Cmw(3) As Single, Cmh(3) As Single
Dim Tt(1) As Single, Tl(1) As Single, Tw(1) As Single, Th(1) As Single
Dim cht As Single, chl As Single, chw As Single, chh As Single
Private Sub Check1_Click()
If Check1.Value = 1 Then
Label1.Caption = "要连接的末字符"
Else
Label1.Caption = "要查找的首字符"
End If
End SubPrivate Sub Command1_Click()
Dim Ts As String
Dim a As Long
a = 1048576
cmo1.Filter = "*.txt"
cmo1.ShowOpen
filem = cmo1.FileName
If cmo1.FileName = "" Then
Exit Sub
End If
Ts = Right(cmo1.FileName, 4)
If Ts <> ".txt" Then
MsgBox "您打开的非文本文档文件", , "提示"
Exit Sub
End IfIf FileLen(filem) \ a > 10 Then
MsgBox "您打开的文件已超过10M", , "提示"
Exit Sub
End IfRichTextBox1.FileName = cmo1.FileName
bu = False
Label3.Caption = "你打开的文件名为:" & filem
If FileLen(filem) \ 1024 <= 0 Then '判断文件是否有1KB
Label4.Caption = FileLen(filem) & "字节"
ElseIf FileLen(filem) \ 1024 >= 1 And FileLen(filem) / 1024 <= 1024 Then '文件有1KB和文件小于1M时。
Label4.Caption = "文件大小为" & Left(FileLen(filem) / 1024, 5) & "KB"
ElseIf FileLen(filem) \ a > 0 Then '文件有1M时
Label4.Caption = "文件大小为:" & Left(FileLen(filem) / a, 4) & "M"
End If
Exit Sub
End SubPrivate Sub Command2_Click()
If Label1.Caption = "要查找的首字符" Then
If Text1.Text = "" Then
MsgBox "请输入要查找的内容"
Exit Sub
End If
Timer3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False '防止在程序忙时,用户点击其它按扭,导致程序崩溃。
Command3.Enabled = False
Label2.Visible = True
mo = InStr(RichTextBox1.Text, Text1.Text)
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
Sv = mo
RichTextBox1.SetFocus
DoEvents
RichTextBox1.SelStart = mo - 1
RichTextBox1.SelLength = Len(Text1.Text)
Label1.Caption = "要查找的末字符"
Text1.Text = "" '查找首字符ElseIf Label1.Caption = "要查找的末字符" Then
If Text1.Text = "" Then
MsgBox "请输入要查找的内容"
Exit Sub
End If
Timer3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Label2.Visible = True
Nexts = InStr(Sv + Len(Text1.Text), RichTextBox1.Text, Text1.Text) 'sv后面加上文本长度是为了从字符后面位置开始查找,否则只会从已查找到字符位置前查找。这样会重复
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
If Nexts = 0 Then
MsgBox "未查找到内容", , "提示"
Exit Sub
End If
Sv = Nexts
RichTextBox1.SetFocus
RichTextBox1.SelStart = Nexts - 1
RichTextBox1.SelLength = Len(Text1.Text)
Command2.Caption = "查找下一个"
Command2.Enabled = False
Timer1.Enabled = True '查找末字符,并把选中的代码交给时间控件ElseIf Label1.Caption = "要连接的末字符" Then
Timer3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Label2.Visible = True
mo = InStr(Sv + Len(Text1.Text), RichTextBox1.Text, Text1.Text)
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
If mo = 0 Then
MsgBox "找不到"
Exit Sub
End If
Sv = mo
DoEvents
RichTextBox1.SetFocus
RichTextBox1.SelStart = mo - 1
RichTextBox1.SelLength = Len(Text1.Text)
Command2.Caption = " 查找下一个"
Command2.Enabled = False
Timer2.Enabled = True '选中文本代码交给时间控件2完成
End If
End Sub
Private Sub Command3_Click()
Call save
MsgBox "保存成功"
End SubPrivate Sub Command4_Click()
msg = MsgBox("是否删除选中的字符", vbYesNo + 64, "询问")
If msg = vbYes Then
str = Replace(RichTextBox1.Text, RichTextBox1.SelText, "")
RichTextBox1.SelText = str
End If
End SubSub save()
Open filem For Output As #1
Print #1, RichTextBox1.Text
Close #1
End Sub
Private Sub Form_Load()
menpaste.Enabled = False
Tt(0) = Text1.Top
Tl(0) = Text1.Left
Tw(0) = Text1.Width
Th(0) = Text1.Height
Tt(1) = RichTextBox1.Top
Tl(1) = RichTextBox1.Left
Tw(1) = RichTextBox1.Width
Th(1) = RichTextBox1.Height
'保存Combo1控件的Top、Left、Width和Height属性
Cmt(0) = Command1.Top
Cml(0) = Command1.Left
Cmw(0) = Command1.Width
Cmh(0) = Command1.HeightEnd Sub
Private Sub Form_Unload(Cancel As Integer)
If filem <> "" And bu = True Then
msg = MsgBox("是否保存文件", vbYesNo + 64, "询问")
If msg = vbYes Then
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
Call save
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
MsgBox "保存成功"
End If
End If
End SubPrivate Sub mencopy_Click()
Clipboard.SetText RichTextBox1.SelText
menpaste.Enabled = True
End SubPrivate Sub menexit_Click()
End Sub
Private Sub menpaste_Click()
RichTextBox1.SelText = Clipboard.GetText
End SubPrivate Sub RichTextBox1_Change()
bu = True
If bu = True And filem <> "" Then
Command3.Enabled = True
End If
End SubPrivate Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
PopupMenu menfile
End If
End SubPrivate Sub Timer1_Timer()
Static a As Integer
a = a + 1
If a = 3 Then
Command2.Enabled = True
Timer1.Enabled = False '到时间后停止时间控件,以防多次运行
a = 0
msg = MsgBox("是否要将首末字符全部选中", vbYesNo + 64, "询问") '选中所查找的下一个字符
If msg = vbYes ThenTimer3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Label2.Visible = True
RichTextBox1.SetFocus
RichTextBox1.SelStart = mo - 1
RichTextBox1.SelLength = Nexts
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Timer3.Enabled = False
Label2.Visible = False
Label1.Caption = "要查找的首字符"
Command4.Enabled = True
Command2.Caption = "开始查找"
End If
End If
End SubPrivate Sub Timer2_Timer()
Static b As Integer
b = b + 1
If b = 3 Then
Timer2.Enabled = False
Command2.Enabled = True
b = 0
msg = MsgBox("是否从第一个文字到些内容位置全选中", vbYesNo + 64, "询问")
If msg = vbYes Then
Timer3.Enabled = True
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Label2.Visible = True
RichTextBox1.SetFocus
RichTextBox1.Sel