fileexplo.frm

改压缩包是一个用vb做的简单的记事本

modify.Visible = True
options.Visible = True
psave.Enabled = True
psaveas.Enabled = True
pnothis.Enabled = False
oldtext = Text1.Text
For i = 0 To 9
notext(i) = ""
Next i
flag3 = True
If Clipboard.GetText() = "" Then
ppaste.Enabled = False
Command9.Enabled = False
End If
Me.MousePointer = 0
End If
End Sub

Private Sub Command3_Click()
If flag1 = 3 Then
MsgBox "对不起，没有文件", vbCritical, "保存文件"
Exit Sub
End If
Me.MousePointer = 13
If flag1 = 0 Then
comdia1.FileName = ""
comdia1.FLAGS = 4096
comdia1.Filter = "All Files|*.*|Word Files|*.doc|Text Files|*.txt"
comdia1.FilterIndex = 3
comdia1.DialogTitle = "保存文件"
comdia1.ShowSave
If comdia1.FileName = "" Then
Me.MousePointer = 0
Exit Sub
Else
filename2 = comdia1.FileName
Open filename2 For Output As #2
End If
Else
Open filename1 For Output As #2
End If
Print #2, Text1.Text
Close #2
flag2 = 0
Me.MousePointer = 0
End Sub

Private Sub Command4_Click()
Text1.FontBold = Not Text1.FontBold
pfontbold.Checked = Not pfontbold.Checked
End Sub

Private Sub Command5_Click()
Text1.FontItalic = Not Text1.FontItalic
pfontitalic.Checked = Not pfontitalic.Checked
End Sub

Private Sub Command6_Click()
Text1.FontUnderline = Not Text1.FontUnderline
pfontunderline.Checked = Not pfontunderline.Checked
End Sub

Private Sub Command7_Click()
pcut_Click
End Sub

Private Sub Command8_Click()
pcopy_Click
End Sub

Private Sub Command9_Click()
ppaste_Click
End Sub


Private Sub pauthor_Click()
MsgBox "此程序作者:王勇" + Chr$(13) + Chr$(10) + "E-mail:[e-mail]" + Chr$(13) + Chr$(10) + "联系电话:[phone]" + Chr$(13) + Chr$(10) + "任何人不经作者同意.不得任意删改此程序!", 64, "关于作者"
End Sub

Private Sub pcopy_Click()
Clipboard.SetText Text1.SelText
ppaste.Enabled = True
Command9.Enabled = True
End Sub

Private Sub pcut_Click()
Clipboard.SetText Text1.SelText
Text1.SelText = ""
ppaste.Enabled = True
Command9.Enabled = True
cpcc False
pnothis.Enabled = True
End Sub

Private Sub pdelete_Click()
Text1.SelText = ""
cpcc False
pnothis.Enabled = True
End Sub

Private Sub pexit_Click()
Unload Me
End Sub

Private Sub pfind_Click()
Form2.Show
Form2.Text1(0).SetFocus
End Sub

Private Sub pfontbold_Click()
Text1.FontBold = Not Text1.FontBold
pfontbold.Checked = Not pfontbold.Checked
End Sub

Private Sub pfontitalic_Click()
Text1.FontItalic = Not Text1.FontItalic
pfontitalic.Checked = Not pfontitalic.Checked
End Sub

Private Sub pfontname_Click()
On Error Resume Next
comdia1.FLAGS = 3
comdia1.ShowFont
Text1.FontName = comdia1.FontName
Text1.FontSize = comdia1.FontSize
Combo1.Text = Text1.FontName
Combo2.Text = Text1.FontSize
End Sub

Private Sub pfontstrikethru_Click()
pfontstrikethru.Checked = Not pfontstrikethru.Checked
Text1.FontStrikethru = Not Text1.FontStrikethru
End Sub

Private Sub pfontunderline_Click()
Text1.FontUnderline = Not Text1.FontUnderline
pfontunderline.Checked = Not pfontunderline.Checked
End Sub
Private Function theline(ByVal myhwnd As Long) As String
Static linecout As Long, linefore As Long
linecout = SendMessageLong(myhwnd, EM_GETLINECOUNT, -1&, 0&)
linefore = SendMessageLong(myhwnd, EM_LINEFROMCHAR, -1&, 0&) + 1
theline = CStr(linefore) + "/" + CStr(linecout)
End Function

Private Sub Form_Load()
Dim i As Integer
Text1.Visible = False
Me.MousePointer = 13
flag1 = 3
flag2 = 0
For i = 1 To Screen.FontCount
Combo1.AddItem Screen.Fonts(i)
Next i
For i = 8 To 12
Combo2.AddItem Mid$(Str$(i), 2)
Next i
For i = 14 To 28
Combo2.AddItem Mid$(Str$(i), 2)
Next i
Combo2.AddItem "36"
Combo2.AddItem "48"
Combo2.AddItem "72"
Combo1.Text = "宋体"
Combo2.Text = "12"
comtf False
modify.Visible = False
options.Visible = False
psave.Enabled = False
psaveas.Enabled = False
cpcc False
SBar1.Height = 250
Dim mybar1 As Panel
SBar1.Panels(1).Width = 800
SBar1.Panels(1).Text = ""
SBar1.Panels(1).Alignment = sbrCenter
Set mybar1 = SBar1.Panels.Add(, , , 1)
SBar1.Panels(2).Width = 600
Set mybar1 = SBar1.Panels.Add(, , , 2)
SBar1.Panels(3).Width = 500
Set mybar1 = SBar1.Panels.Add(, , , 3)
SBar1.Panels(4).Width = 500
Set mybar1 = SBar1.Panels.Add(, , , 4)
SBar1.Panels(5).Width = 600
Set mybar1 = SBar1.Panels.Add(, , , 5)
SBar1.Panels(6).Width = 700
Set mybar1 = SBar1.Panels.Add(, , , 6)
filename1 = ""
filename1 = Command
If filename1 <> "" Then
filename1 = Trim$(filename1)
If Left$(filename1, 1) = Chr$(34) Then
filename1 = Mid$(filename1, 2, Len(filename1) - 2)
End If
Dim whole, aspect As String
flag1 = 3
Open filename1 For Input As #1
Do While Not EOF(1)
Line Input #1, aspect
whole = whole + aspect + Chr$(13) + Chr$(10)
Loop
Close #1
Text1.Visible = True
Text1.Text = whole
'Text1.SetFocus
flag1 = 1
flag2 = 0
comtf True
modify.Visible = True
options.Visible = True
psave.Enabled = True
psaveas.Enabled = True
pnothis.Enabled = False
oldtext = Text1.Text
For i = 0 To 9
notext(i) = ""
Next i
flag3 = True
If Clipboard.GetText() = "" Then
ppaste.Enabled = False
Command9.Enabled = False
End If
Else
Text1.Visible = True
Text1.Text = ""
'Text1.SetFocus
flag1 = 0
flag2 = 1
comtf True
modify.Visible = True
options.Visible = True
psave.Enabled = True
psaveas.Enabled = True
pnothis.Enabled = False
oldtext = Text1.Text
For i = 0 To 9
notext(i) = ""
Next i
flag3 = True
If Clipboard.GetText() = "" Then
ppaste.Enabled = False
Command9.Enabled = False
End If
End If
Me.MousePointer = 0
End Sub

Private Sub Form_Resize()
Frame2.Width = Form1.Width - 130
Frame1.Width = Form1.Width - 130
If Form1.ScaleHeight > 570 Then
Frame2.Height = Form1.ScaleHeight - 620
End If
Text1.Width = Frame2.Width - 100
If Frame2.Height > 200 Then
Text1.Height = Frame2.Height - 200
End If
If Text1.Visible = True Then
Text1.SetFocus
SBar1.Panels(1).Text = theline(Text1.hwnd)
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
Me.MousePointer = 13
If flag1 <> 3 And flag2 = 1 Then
Dim ynsave As Integer
Cancel = 1
ynsave = MsgBox("保存此文件吗？", 67, "关闭文件")
If ynsave = 6 Then
If flag1 = 0 Then
comdia1.FileName = ""
comdia1.FLAGS = 4096
comdia1.Filter = "All Files|*.*|Word Files|*.doc|Text Files|*.txt"
comdia1.FilterIndex = 3
comdia1.DialogTitle = "保存文件"
comdia1.ShowSave
If comdia1.FileName = "" Then
Me.MousePointer = 0
Exit Sub
Else
filename2 = comdia1.FileName
Open filename2 For Output As #2
End If
Else
Open filename1 For Output As #2
End If
Print #2, Text1.Text
Close #2
Cancel = 0
End
End If
If ynsave = 7 Then
Cancel = 0
End
End If
Else
End
End If
Me.MousePointer = 0
End Sub

Private Sub pnew_Click()
Command1_Click
End Sub
Private Sub pnothis_Click()
Dim i As Integer
flag3 = False
Text1.Text = notext(9)
oldtext = Text1.Text
For i = 9 To 1 Step -1
notext(i) = notext(i - 1)
Next i
notext(0) = ""
flag3 = True
If notext(9) = "" Then
pnothis.Enabled = False
Exit Sub
End If
End Sub

Private Sub popen_Click()
Command2_Click
End Sub

Private Sub ppaste_Click()
Text1.SelText = Clipboard.GetText()
cpcc False
End Sub

Private Sub psave_Click()
Command3_Click
End Sub

Private Sub saveas_Click()
flag1 = 0
Command3_Click
End Sub

Private Sub psaveas_Click()
Me.MousePointer = 13
comdia1.FileName = ""
comdia1.FLAGS = 4096
comdia1.Filter = "All Files|*.*|Word Files|*.doc|Text Files|*.txt"
comdia1.FilterIndex = 3
comdia1.DialogTitle = "保存文件"
comdia1.ShowSave
If comdia1.FileName = "" Then
Me.MousePointer = 0
Exit Sub
Else
filename2 = comdia1.FileName
Open filename2 For Output As #2
End If
Print #2, Text1.Text
Close #2
flag2 = 0
Me.MousePointer = 0
End Sub

Private Sub pselectall_Click()
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
cpcc True
End Sub

Private Sub psoftware_Click()
MsgBox "此记事本和Windows下的记事本功能无多大区别，当然功能是比不上它的了！" + Chr$(13) + Chr$(10) + "它功能简单，我想就不介绍它的各部分功能了！" + Chr$(13) + Chr$(10) + "请原谅！", 64, "关于记事本"
End Sub

Private Sub pthisdate_Click()
Text1.SelText = Date$
End Sub

Public Sub Text1_Change()
Dim i As Integer
flag2 = 1
If flag3 = True Then
For i = 0 To 8
notext(i) = notext(i + 1)
Next i
notext(9) = oldtext
pnothis.Enabled = True
oldtext = Text1.Text
End If
SBar1.Panels(1).Text = theline(Text1.hwnd)
End Sub


Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
SBar1.Panels(1).Text = theline(Text1.hwnd)
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
cpcc False
End If
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Text1.SelText <> "" Then
cpcc True
End If
SBar1.Panels(1).Text = theline(Text1.hwnd)
End Sub

Private Sub textback_Click()
comdia1.FLAGS = &H1&
comdia1.Color = RGB(255, 255, 255)
comdia1.Action = 3
Text1.BackColor = comdia1.Color
End Sub

Private Sub textfore_Click()
comdia1.FLAGS = &H1&
comdia1.Color = BackColor
comdia1.Action = 3
Text1.ForeColor = comdia1.Color
End Sub

Private Sub textleft_Click()
Text1.Alignment = 0
End Sub

Private Sub textmid_Click()
Text1.Alignment = 2
End Sub

Private Sub textright_Click()
Text1.Alignment = 1
End Sub

Private Sub zapall_Click()
Me.MousePointer = 13
Dim onelen As Long, i As Long
onelen = Len(Text1.Text)
flag3 = False
For i = onelen To 3 Step -1
If Mid$(Text1.Text, i, 2) = vbCrLf Then
Text1.SetFocus
Text1.SelStart = i - 1
Text1.SelLength = 2
Text1.SelText = vbNullString
End If
Next i
flag3 = True
Call Text1_Change
Text1.SetFocus
Me.MousePointer = 0
End Sub

Private Sub zapline_Click()
Me.MousePointer = 13
Dim textlen As Long, i As Long
textlen = Len(Text1.Text)
flag3 = False
For i = textlen To 3 Step -1
If Mid$(Text1.Text, i, 2) = vbCrLf Then
If Mid$(Text1.Text, i - 2, 2) = vbCrLf Then
Text1.SelStart = i - 3
Text1.SelLength = 2
Text1.SelText = vbNullString
End If
If Mid$(Text1.Text, i - 1, 1) = " " Or Mid$(Text1.Text, i - 1, 1) = "　" Or Mid$(Text1.Text, i - 1, 1) = Chr$(9) Then
Text1.SelStart = i - 2
Text1.SelLength = 1
Text1.SelText = vbNullString
i = i + 1
End If
End If
Next i
flag3 = True
Call Text1_Change
Text1.SetFocus
Me.MousePointer = 0
End Sub

Private Sub zapspace_Click()
Me.MousePointer = 13
Dim onelen As Long, i As Long
onelen = Len(Text1.Text)
flag3 = False
For i = onelen To 1 Step -1
If Mid$(Text1.Text, i, 1) = Space(1) Or Mid$(Text1.Text, i, 1) = "　" Or Mid$(Text1.Text, i, 1) = Chr$(9) Then
Text1.SetFocus
Text1.SelStart = i - 1
Text1.SelLength = 1
Text1.SelText = vbNullString
End If
Next i
flag3 = True
Call Text1_Change
Text1.SetFocus
Me.MousePointer = 0
End Sub