VB6简单的记事本程序,高手见笑了!

来源：互联网发布：ajax json类型编辑：程序博客网时间：2024/04/30 16:43

最近自己写了一个简单的记事本程序,自己第一次完整写的程序.程序中有很多Bug,程序代码沉余很大.写了很多重复的代码. 但是基本的记事本功能实现了.准备重新更新代码,希望至少在代码结构上能有所提高.

Private Sub about_Click()
mb = MsgBox("作者：城市灯火 E-Mail:xgd.csdh@yahoo.com.cn", vbOKOnly, "记事本")
End Sub

Private Sub all_Click()
If RichTextBox1.Visible = True Then
With RichTextBox1
    .SelStart = 0
    .SelLength = Len(.Text)
End With
Else
With RichTextBox2
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End If
End Sub

Private Sub copy_Click()
    Clipboard.Clear
If RichTextBox1.Visible = True Then
    Clipboard.SetText RichTextBox1.SelText
Else
    Clipboard.SetText RichTextBox2.SelText
End If
End Sub

Private Sub datatime_Click()
If RichTextBox1.Visible = True Then
RichTextBox1.SelText = Now()
Else
RichTextBox2.SelText = Now()
End If
End Sub

Private Sub del_Click()
    If RichTextBox1.Visible = True Then
    RichTextBox1.SelText = ""
Else
    RichTextBox2.SelText = ""
End If
End Sub

Private Sub font_Click()
CommonDialog1.Flags = 1
CommonDialog1.ShowFont
With RichTextBox1
    .font.Name = CommonDialog1.FontName
    .font.Size = CommonDialog1.FontSize
    .font.Bold = CommonDialog1.FontBold
    .SelColor = CommonDialog1.Color
    .font.Italic = CommonDialog1.FontItalic
    .font.Underline = CommonDialog1.FontUnderline
    .font.Strikethrough = CommonDialog1.FontStrikethru
End With
With RichTextBox2
    .font.Name = CommonDialog1.FontName
    .font.Size = CommonDialog1.FontSize
    .SelColor = CommonDialog1.Color
    .font.Bold = CommonDialog1.FontBold
    .font.Italic = CommonDialog1.FontItalic
    .font.Underline = CommonDialog1.FontUnderline
    .font.Strikethrough = CommonDialog1.FontStrikethru
End With
End Sub

Private Sub Form_Load()
Tyuedu.Checked = False
zhuangtai.Checked = False
StatusBar1.Visible = False
End Sub

Private Sub Form_Resize() '设置richtextbox控件大小的动态变化
If zhuangtai.Checked = False Then
With RichTextBox1
    .Top = ScaleTop
    .Left = ScaleLeft
    .Width = ScaleWidth
    .Height = ScaleHeight
End With
With RichTextBox2
    .Top = ScaleTop
    .Left = ScaleLeft
    .Width = ScaleWidth
    .Height = ScaleHeight
End With
Else
With RichTextBox1
    .Top = ScaleTop
    .Left = ScaleLeft
    .Width = ScaleWidth
    .Height = ScaleHeight - 270
End With
With RichTextBox2
    .Top = ScaleTop
    .Left = ScaleLeft
    .Width = ScaleWidth
    .Height = ScaleHeight - 270
End With
End If
End Sub

Private Sub h1_Click()
mbox = MsgBox("详细帮助说明请查看程序主目录下的Help.text！", vbOKOnly, "记事本")
End Sub

Private Sub jiantie_Click()
Clipboard.Clear
If RichTextBox1.Visible = True Then
    Clipboard.SetText RichTextBox1.SelText
    RichTextBox1.SelText = ""
Else
    Clipboard.SetText RichTextBox2.SelText
    RichTextBox1.SelText = ""
End If
End Sub

Private Sub new_Click()
Dim a As Integer
If RichTextBox1.Text = "" And RichTextBox2.Text = "" Then
    MainForm.Caption = "新建文本文档.txt -记事本"
    RichTextBox1.Text = ""
    RichTextBox2.Text = ""
Else
   a = MsgBox("当前文件已被修改，需要保存吗？", vbYesNoCancel + vbExclamation, "记事本")
    If a = 6 Then
      CommonDialog1.Filter = "文本文件 | *.txt"
      CommonDialog1.InitDir = "%userprofile%/桌面"
      CommonDialog1.DialogTitle = "保存文件"
      CommonDialog1.ShowSave
    ElseIf a = 7 Then
      MainForm.Caption = "新建文本文档.txt -记事本"
      RichTextBox1.Text = ""
      RichTextBox2.Text = ""
    End If
End If
End Sub

Private Sub open_Click() '根据richtextbox.visible属性判断文本文件在打开以前是否需要保存，并且弹出打开文件窗口
Dim aa As Integer, bb As Integer
If RichTextBox1.Visible = True Then
If RichTextBox1.Text > "" Then
    aa = MsgBox("当前文件已被修改，需要保存吗？", vbYesNoCancel + vbExclamation, "记事本")
    If aa = 6 Then
      CommonDialog1.Filter = "文本文件 | *.txt"
      CommonDialog1.InitDir = "%systemroot%"
      CommonDialog1.DialogTitle = "保存文件"
      CommonDialog1.ShowSave
    ElseIf aa = 7 Then
        RichTextBox1.Text = ""
        CommonDialog1.Filter = "文本文件 | *.txt"
        CommonDialog1.InitDir = "%systemroot%"
        CommonDialog1.ShowOpen
        RichTextBox1.FileName = CommonDialog1.FileName
        MainForm.Caption = CommonDialog1.FileName + "-记事本"
      End If
    Else
        CommonDialog1.Filter = "文本文件 | *.txt"
        CommonDialog1.InitDir = "%systemroot%"
        CommonDialog1.ShowOpen
        RichTextBox1.FileName = CommonDialog1.FileName
        MainForm.Caption = CommonDialog1.FileName + "-记事本"
    End If
Else
    If RichTextBox2.Text > "" Then
    aa = MsgBox("当前文件已被修改，需要保存吗？", vbYesNoCancel + vbExclamation, "记事本")
    If aa = 6 Then
      CommonDialog1.Filter = "文本文件 | *.txt"
      CommonDialog1.InitDir = "%systemroot%"
      CommonDialog1.DialogTitle = "保存文件"
      CommonDialog1.ShowSave
    ElseIf aa = 7 Then
        RichTextBox2.Text = ""
        CommonDialog1.Filter = "文本文件 | *.txt"
        CommonDialog1.InitDir = "%systemroot%"
        CommonDialog1.ShowOpen
        RichTextBox2.FileName = CommonDialog1.FileName
        MainForm.Caption = CommonDialog1.FileName + "-记事本"
      End If
    Else
        CommonDialog1.Filter = "文本文件 | *.txt"
        CommonDialog1.InitDir = "%systemroot%"
        CommonDialog1.ShowOpen
        RichTextBox2.FileName = CommonDialog1.FileName
        MainForm.Caption = CommonDialog1.FileName + "-记事本"
    End If
End If
End Sub

Private Sub quit_Click()
End
End Sub

Private Sub RichTextBox1_Change()
StatusBar1.Panels(2).Text = RichTextBox1.SelStart
End Sub

Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu TMenu
End If
End Sub

Private Sub RichTextBox2_Click()
StatusBar1.Panels(2).Text = RichTextBox2.SelStart
End Sub

Private Sub RichTextBox2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
PopupMenu TMenu
End If
End Sub

Private Sub save_Click()
      CommonDialog1.Filter = "文本文件 | *.txt"
      CommonDialog1.InitDir = "%userprofile%/桌面"
      CommonDialog1.DialogTitle = "保存文件"
      CommonDialog1.ShowSave
    Open CommonDialog1.FileName For Output As #1
        If RichTextBox1.Visible = True Then
            Print #1, RichTextBox1.Text
        Else
            Print #1, RichTextBox2.Text
        End If
    Close #1
End Sub
Private Sub Tfuzhi_Click()
      Clipboard.Clear
If RichTextBox1.Visible = True Then
    Clipboard.SetText RichTextBox1.SelText
Else
    Clipboard.SetText RichTextBox2.SelText
End If
End Sub

Private Sub Tjiantie_Click()
    Clipboard.Clear
If RichTextBox1.Visible = True Then
    Clipboard.SetText RichTextBox1.SelText
    RichTextBox1.SelText = ""
Else
    Clipboard.SetText RichTextBox2.SelText
    RichTextBox1.SelText = ""
End If
End Sub

Private Sub Tquanxuan_Click()
If RichTextBox1.Visible = True Then
With RichTextBox1
    .SelStart = 0
    .SelLength = Len(.Text)
End With
Else
With RichTextBox2
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End If
End Sub

Private Sub Tshanchu_Click()
If RichTextBox1.Visible = True Then
RichTextBox1.SelText = ""
Else
RichTextBox2.SelText = ""
End If
End Sub

Private Sub Tyuedu_Click()
If RichTextBox1.Visible = True Then
With RichTextBox1
    .SelStart = 0
    .SelLength = Len(.Text)
End With
Else
With RichTextBox2
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End If
Tyuedu.Checked = Not Tyuedu.Checked
If Tyuedu.Checked = True Then
    RichTextBox1.SelAlignment = 1
    RichTextBox2.SelAlignment = 1
Else
    RichTextBox1.SelAlignment = 0
    RichTextBox2.SelAlignment = 0
End If
End Sub

Private Sub Tzhantie_Click()
If RichTextBox1.Visible = True Then
RichTextBox1.SelText = Clipboard.GetText
Else
RichTextBox2.SelText = Clipboard.GetText
End If
End Sub

Private Sub zhantie_Click()
If RichTextBox1.Visible = True Then
RichTextBox1.SelText = Clipboard.GetText
Else
RichTextBox2.SelText = Clipboard.GetText
End If
End Sub

Private Sub zhuangtai_Click()
    zhuangtai.Checked = Not zhuangtai.Checked
    StatusBar1.Visible = zhuangtai.Checked
    If zhuangtai.Checked = True Then
        RichTextBox1.Height = ScaleHeight - 270
        RichTextBox2.Height = ScaleHeight - 270
    Else
        RichTextBox1.Height = ScaleHeight
        RichTextBox2.Height = ScaleHeight
    End If
End Sub

Private Sub zidonghuanhang_Click()
zidonghuanhang.Checked = Not zidonghuanhang.Checked
RichTextBox1.Visible = Not RichTextBox1.Visible
RichTextBox2.Visible = Not RichTextBox2.Visible
If zidonghuanhang.Checked Then
RichTextBox1.Text = RichTextBox2.Text
Else
RichTextBox2.Text = RichTextBox1.Text
End If
End Sub