frmmain-f3.frm

一个用VB实现的简单的记事本程序

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form FrmMain 
   Caption         =   "无标题"
   ClientHeight    =   4740
   ClientLeft      =   165
   ClientTop       =   450
   ClientWidth     =   7350
   Icon            =   "Frmmain-f3.frx":0000
   LinkTopic       =   "Form4"
   ScaleHeight     =   4740
   ScaleWidth      =   7350
   StartUpPosition =   2  '屏幕中心
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   4815
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7335
      _ExtentX        =   12938
      _ExtentY        =   8493
      _Version        =   393217
      Enabled         =   -1  'True
      TextRTF         =   $"Frmmain-f3.frx":0442
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3480
      Top             =   -120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuNew 
         Caption         =   "新建(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuOpen 
         Caption         =   "打开(&O)…"
         Shortcut        =   ^O
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu LineF1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPrint 
         Caption         =   "打印(&P)…"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuClose 
         Caption         =   "退出(&X)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuCut 
         Caption         =   "剪切(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuPaste 
         Caption         =   "粘贴(&P)"
         Shortcut        =   ^V
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除(&L)"
         Shortcut        =   {DEL}
      End
      Begin VB.Menu lineE1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSelectAll 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuFont 
         Caption         =   "字体(&F)"
      End
   End
   Begin VB.Menu mnuSouSuo 
      Caption         =   "搜索(&S)"
      Begin VB.Menu mnuSearch 
         Caption         =   "查找(&F)…"
      End
      Begin VB.Menu mnuSearchNext 
         Caption         =   "查找下一个(&N)"
         Shortcut        =   {F3}
      End
      Begin VB.Menu mnuReplac 
         Caption         =   "查找与替换(&P)"
         Shortcut        =   ^H
      End
   End
   Begin VB.Menu mnuSafety 
      Caption         =   "安全(&A)"
      Begin VB.Menu mnuJiami 
         Caption         =   "加密(&J)"
         Shortcut        =   ^J
      End
      Begin VB.Menu mnuJiemi 
         Caption         =   "解密(&M)"
         Shortcut        =   ^M
      End
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Modified As Boolean       '文件正文是否被修改
Dim Saved As Boolean          '文件是否保存
Dim FPath_Name As String      '保存/打开文件的名称
Dim TempStr As String         '加密后的字符
Dim AfterLoad As Boolean

Private Sub Command1_Click()
Dim I As Integer
Dim a As String
For I = 1 To Len(RichTextBox1.Text)
    a = Mid(RichTextBox1.Text, I, 1)
    RichTextBox1.Text = RichTextBox1.Text + a
Next I
End Sub

Private Sub Form_Load()
    '初始化模块级变量
    Modified = False
    Saved = False
    FPath_Name = ""
    AfterLoad = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '关闭窗体前，判断文件正文是否被改变，并提示用户保存文件
    Dim SaveIt As Integer
    If Modified = True Then      '正文改变
      SaveIt = MsgBox("文件 " & Me.Caption & " 的正文已更改，是否保存更改？", vbYesNoCancel)
    '单击“是”按钮，返回6，单击“否”按钮，返回7，单击“取消”按钮，返回2
      
      If SaveIt = 2 Then Cancel = True: Exit Sub
      If SaveIt = 6 Then
        '打开“另存为”对话框
        FrmMain.CommonDialog1.Filter = "Text Files (*.TXT)|*.txt|" & _
           "All Files (*.*)|*.*"        '设置对话框文件类型
        FrmMain.CommonDialog1.Flags = &H4
        FrmMain.CommonDialog1.ShowSave
    
        If CommonDialog1.FileName <> "" Then
        '以下代码用于将当前文本框中的内容写入要保存的文件中
          Open FrmMain.CommonDialog1.FileName For Output As #1
          Print #1, Me.RichTextBox1.Text
          Close #1
        End If
        
      End If
    End If
    Unload Me           '卸载窗体
End Sub

Private Sub Form_Resize()
If AfterLoad Then
  RichTextBox1.Width = FrmMain.ScaleWidth - 20
  RichTextBox1.Height = FrmMain.ScaleHeight - 20
End If

End Sub

Private Sub mnuClose_Click()
End
End Sub

Private Sub mnuCopy_Click()
    '单击“复制”命令，将选定文本复制到剪贴板
    Clipboard.Clear                    '清空剪贴板内容
    Clipboard.SetText RichTextBox1.SelText
End Sub

Private Sub mnuCut_Click()
    '单击“剪切”命令的操作
    Clipboard.Clear                    '清空剪贴板内容
    Clipboard.SetText RichTextBox1.SelText    '设置剪贴板内容为选定文本
    RichTextBox1.SelText = ""                 '删除文本框中选定内容
End Sub

Private Sub mnuDelete_Click()
    '单击“删除”按钮，将选定的内容设置为空
    RichTextBox1.SelText = ""
End Sub

Private Sub mnuFont_Click()
    '单击“字体”命令，打开“字体”对话框，
    '并根据用户的选取，设置文本框的字体格式。
    
    On Error Resume Next               '如果出现错误，忽略错误，继续执行
    CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects
    CommonDialog1.ShowFont             '显示“字体”对话框
    
    RichTextBox1.SelFontName = CommonDialog1.FontName
    RichTextBox1.SelFontSize = CommonDialog1.FontSize
    RichTextBox1.SelBold = CommonDialog1.FontBold
    RichTextBox1.SelColor = CommonDialog1.Color
    RichTextBox1.SelItalic = CommonDialog1.FontItalic
    RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
    RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
    
    End Sub
Sub EnCode(ByVal InS As String, OutS As String, KeyS As String)
'该过程用于将源字符串InS加密后，以目标字符串OutS输出，
'其中的参数KeyS为加密密码

Dim I As Integer
Dim KeyCh As String * 1      '表示密码字符串中的一个字符
Dim Temp As String           '存放结果的临时变量
Dim StartPos As Integer      '获取密码中一个字符的位置
Dim Ch As String * 1         '表示源字符串中的一个字符
Dim NewCh As String * 1      '将源字符加密后的字符

StartPos = 1
Temp = ""
'以下循环用于将源字符串中的每个字符与密码中的一个字符异或，
'并将结果放入临时变量中
For I = 1 To Len(InS)
  KeyCh = Mid(KeyS, StartPos, 1)           '获取密码字符串中的一个字符
  StartPos = StartPos + 1
  If StartPos > Len(KeyS) Then StartPos = 1
  Ch = Mid(InS, I, 1)                      '取源字符串中的一个字符
  NewCh = Chr(Asc(Ch) Xor Asc(KeyCh))      '得到异或后的新字符
  Temp = Temp + NewCh
Next I
OutS = Temp
End Sub
Private Sub mnuJiami_Click()
Dim Key As String
KeyWdFrm.Caption = "加密"
KeyWdFrm.Show 1
Key = PassWord
If Key = "" Then Exit Sub
Call EnCode(RichTextBox1.Text, TempStr, Key)
RichTextBox1.Text = TempStr
End Sub
'
Private Sub mnuJiemi_Click()
Dim Tstr As String
Dim Key As String
KeyWdFrm.Caption = "解密"
KeyWdFrm.Show 1
Key = PassWord
If Key = "" Then Exit Sub
Call EnCode(TempStr, Tstr, Key)
RichTextBox1.Text = Tstr
End Sub

Private Sub mnuNew_Click()
    '单击“新建”命令的处理：
    '1--如果当前文件被修改，提示用户保存文件。
    '2--初始化表示文件状态的变量，
    
    Dim SaveIt As Integer
    
    '如果文件正文被修改，提示用户保存文件
    If Modified = True Then
      SaveIt = MsgBox("文件 " & Me.Caption & " 的正文已更改，是否保存更改？", vbYesNoCancel)
      '单击“是”按钮，返回6，单击“否”按钮，返回7，单击“取消”按钮，返回2
      
      If SaveIt = 2 Then Exit Sub
      If SaveIt = 6 Then
        '以下代码用于打开“另存为”对话框
        CommonDialog1.CancelError = True
        On Error GoTo errhandler
        CommonDialog1.Filter = "文本文件(*.Txt)|*.txt"
        CommonDialog1.ShowSave
        RichTextBox1.SaveFile (CommonDialog1.FileName)
      End If
    End If

    '以下代码用于新建文件的初始化
newfile:
    RichTextBox1.Text = ""
    Me.Caption = "无标题"
    Modified = False
    'Saved = False
errhandler:
        Exit Sub
    End Sub

Private Sub mnuOpen_Click()
    '单击“打开”命令的处理过程：
    '1--如果当前编辑的文件内容被更改，提示用户保存文件
    '2--显示“打开”对话框，选取打开的文件
    '3--将选取的文件内容显示到文本框richtextbox1中
    
    Dim FileStr As String, FileN As String
    Dim TempStr As String, DotPos As Integer
    Dim SaveIt As Integer
    
    '如果当前文件的内容有改变，提示用户保存文件
    If Modified = True Then
      SaveIt = MsgBox("文件 " & Me.Caption & " 的正文已更改，是否保存更改？", vbYesNoCancel)
    '单击“是”按钮，返回6，单击“否”按钮，返回7，单击“取消”按钮，返回2
      
      If SaveIt = 2 Then Exit Sub
      If SaveIt = 6 Then
        '以下代码用于打开“另存为”对话框
         CommonDialog1.CancelError = True
         On Error GoTo errhandler
         CommonDialog1.Filter = "文本文件(*.Txt)|*.txt"
         CommonDialog1.ShowSave
         RichTextBox1.SaveFile (CommonDialog1.FileName)
         Me.Caption = CommonDialog1.FileTitle     '设置窗体的标题为被打开的文件名称
         Modified = False
      End If
    End If
    
    '以下代码用于显示“打开”对话框
        CommonDialog1.CancelError = True
        On Error GoTo errhandler
        CommonDialog1.FileName = ""
        CommonDialog1.Filter = "文本文件(*.Txt)|*.Txt|所有文件(*.*)|*.*"
        CommonDialog1.FilterIndex = 1
        CommonDialog1.ShowOpen
        RichTextBox1.LoadFile (CommonDialog1.FileName)
        Me.Caption = CommonDialog1.FileTitle     '设置窗体的标题为被打开的文件名称
        Modified = False
errhandler:
          Exit Sub
End Sub

Private Sub mnuPaste_Click()
    '单击“粘贴”按钮，将剪贴板上的内容复制到文本框中
    RichTextBox1.SelText = Clipboard.GetText
End Sub

Private Sub mnuPrint_Click()
    '单击“打印”命令时，显示打印对话框，并打印文件内容
    CommonDialog1.CancelError = True
    On Error GoTo errhandler
    CommonDialog1.Flags = &H4
    CommonDialog1.ShowPrinter                '显示打印对话框
    Printer.Copies = CommonDialog1.Copies    '返回打印份数
    
    Printer.Print RichTextBox1.Text                 '打印输出文件内容
errhandler:
    Exit Sub
End Sub

Private Sub mnuReplac_Click()
RplFrm.Show
End Sub

Private Sub mnuSave_Click()
    '单击“保存”命令时的处理过程：
    '1--打开“另存为”对话框，选取保存文件名称和路径
    '2--将文本框中内容保存到指定文件中
    
 CommonDialog1.CancelError = True
 On Error GoTo errhandler
 CommonDialog1.Filter = "文本文件(*.Txt)|*.txt"
 CommonDialog1.ShowSave
 RichTextBox1.SaveFile (CommonDialog1.FileName)
 Me.Caption = CommonDialog1.FileTitle     '设置窗体的标题为被打开的文件名称
 Modified = False
errhandler:
  Exit Sub
End Sub

Private Sub mnuSaveAs_Click()
    '单击“另存为”命令时的处理过程：
    '1--打开“另存为”对话框，选取保存文件名称和路径
    '2--将文本框中内容保存到指定文件中
    
    '以下代码用于显示“另存为”对话框
    CommonDialog1.Filter = "Text Files (*.TXT)|*.txt|All Files (*.*)|*.*"
    CommonDialog1.Flags = &H4
    CommonDialog1.ShowSave
    If CommonDialog1.FileName = "" Then Exit Sub
    
    '以下代码用于将当前文本框中的内容写入要保存的文件中
    Open CommonDialog1.FileName For Output As #1
    Print #1, RichTextBox1.Text
    Close #1
    
    FPath_Name = CommonDialog1.FileName
    Modified = False
    Me.Caption = CommonDialog1.FileTitle        '设置窗体标题为保存的文件名
End Sub

Private Sub mnuSearch_Click()
    '单击“查找”命令时，打开“查找”窗体
    FindFrm.Show
End Sub

Private Sub mnuSearchNext_Click()
    '单击“查找下一个”命令时的处理过程：
    '1--根据用户的选取，判断是否区分大小写查找
    '2--如果查找到字符，显示之，否则，显示未找到提示
    
    If MatchCase = True Then       '如果需要在查找中区分大小写
        Pos = InStr(Pos + 1, FrmMain.RichTextBox1.Text, SearchStr)
    Else
        Pos = InStr(Pos + 1, FrmMain.RichTextBox1.Text, SearchStr, vbTextCompare)
    End If
    
    If Pos <> 0 Then
       '如果找到了指定的字符串，显示该字符串
        FrmMain.RichTextBox1.SelStart = Pos - 1
        FrmMain.RichTextBox1.SelLength = Len(SearchStr)
        Exit Sub
    Else
        MsgBox "没有找到字符 " & Chr$(34) & SearchStr & Chr$(34)
    End If
End Sub

Private Sub mnuSelectAll_Click()
    '单击“全选”命令时，选取文本框的所有字符
    RichTextBox1.SelStart = 0                   '选取文本的起始位置
    RichTextBox1.SelLength = Len(RichTextBox1.Text)    '选取文本的字符个数
End Sub

Private Sub richtextbox1_Change()
    '当文本框内容发生变化时，设置变量值，以提示文件正文内容被改变
    Modified = True
End Sub