📄 frmnote_b.frm

📁 个人记事本
💻 FRM
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
'//////////////////////////////////
'////           编辑
Private Sub menuEditUndo_Click()
    SendKeys "^z", True
End Sub
Private Sub menuEditCopy_Click()
    SendKeys "^c", True
End Sub
Private Sub menuEditCut_Click()
    SendKeys "^x", True
End Sub
Private Sub menuEditPaste_Click()
    SendKeys "^v", True
End Sub
Private Sub menuEditAll_Click()
    SendKeys "^a", True
End Sub

Private Sub menuEditFont_Click()
    CommonDialog1.flags = 1 + 256       '只列出屏幕字体
    CommonDialog1.CancelError = True
    If Not RTFMatter.SelFontName = Null Then CommonDialog1.FontName = RTFMatter.SelFontName '字体名称
    If Not RTFMatter.SelBold = Null Then CommonDialog1.FontBold = RTFMatter.SelBold                     '字体粗体
    If Not RTFMatter.SelFontSize = Null Then CommonDialog1.FontSize = RTFMatter.SelFontSize  '字体大小
    If Not RTFMatter.SelItalic = Null Then CommonDialog1.FontItalic = RTFMatter.SelItalic  '字体斜体
    If Not RTFMatter.SelStrikeThru = Null Then CommonDialog1.FontStrikethru = RTFMatter.SelStrikeThru  '删除线
    If Not RTFMatter.SelUnderline = Null Then CommonDialog1.FontUnderline = RTFMatter.SelUnderline    '下划线
    If Not RTFMatter.SelColor = Null Then CommonDialog1.Color = RTFMatter.SelColor       '字体颜色
    On Error GoTo CancelError
    
    CommonDialog1.ShowFont
    RTFMatter.SelFontName = CommonDialog1.FontName  '字体名称
    RTFMatter.SelBold = CommonDialog1.FontBold      '字体粗体
    RTFMatter.SelFontSize = CommonDialog1.FontSize  '字体大小
    RTFMatter.SelItalic = CommonDialog1.FontItalic  '字体斜体
    RTFMatter.SelStrikeThru = CommonDialog1.FontStrikethru  '删除线
    RTFMatter.SelUnderline = CommonDialog1.FontUnderline    '下划线
    RTFMatter.SelColor = CommonDialog1.Color        '字体颜色
CancelError:
End Sub

Private Sub menuEditColour_Click()
    CommonDialog1.CancelError = True
    On Error GoTo CancelError
    
    CommonDialog1.ShowColor
    RTFMatter.SelColor = CommonDialog1.Color        '字体颜色
CancelError:
End Sub

Private Sub menuEditEncrypt_Click()
'容错
    If Data1.Recordset.RecordCount = 0 Then
        MsgBox "无当前记录", vbInformation + vbOKOnly, "错误信息"
        Exit Sub
    End If
    If txtflag.Text = 1 Then
        MsgBox "当前记录已被加密", vbInformation + vbOKOnly, "错误信息"
        Exit Sub
    End If
    
'获得密码
    Dim code As String
    'get encryption code and use it to encrypt file
    code = InputBox("请输入密码：", , "xujiayong")
    If code = "" Then Exit Sub  'if Cancel chosen, exit sub
    
    MousePointer = 11     'display hourglass
    
    Dim PASSWORD() As Byte  '定义数组用于存放密码的ASCII码
    Dim password_len As Integer
    
    password_len = Len(code)
    ReDim PASSWORD(password_len) As Byte
    For i = 0 To password_len - 1 '把密码转化为ASCII码
        PASSWORD(i) = Asc(Mid(code, i + 1, 1))
    Next
    
'将要加密的内容写入文件 App.System & "system01.txt"
    Open App.Path & "\System\system01.txt" For Output As #1
        Print #1, RTFMatter.TextRTF
    Close #1
    
    Dim databuff() As Byte  '定义数组用于存放文件内容
    Dim addbuff() As Byte   '定义数组用于存放加密后的文件内容
    
    '读取要加密的文件内容
    Open App.Path & "\System\system01.txt" For Binary As #1
    ReDim databuff(LOF(1))
    Get #1, , databuff
    Close #1
    
    '加密
    ReDim addbuff(UBound(databuff)) As Byte
    For i = 0 To UBound(databuff)
        'addbuff(i) = databuff(i) Xor password((i Mod password_len) + 1)
        addbuff(i) = Not databuff(i) '无密码加密
    Next
    
    '把加密后的内容写入文件
    Open App.Path & "\System\system01.txt" For Binary As #1
    Put #1, , addbuff
    Close #1
    
    '将加密后的文件写入纪录
    Me.RTFMatter.Text = StrConv(addbuff, vbUnicode) '显示加密后的文件内容
    'Me.RTFMatter.LoadFile (App.Path & "\System\system01.txt")
    Me.RTFMatter.Enabled = False
    
    MousePointer = 0  'reset mouse
    
    '记录 flag =1,标志已加密
    txtflag.Text = 1
End Sub

Private Sub menuEditDecrypt_Click()
    '容错
    If Data1.Recordset.RecordCount = 0 Then
        MsgBox "无当前记录", vbInformation + vbOKOnly, "错误信息"
        Exit Sub
    End If
    If txtflag.Text = 0 Then
        MsgBox "当前记录未被加密", vbInformation + vbOKOnly, "错误信息"
        Exit Sub
    End If
    
'获得密码
    Dim code As String
    'get encryption code and use it to encrypt file
    code = InputBox("请输入密码：", , "xujiayong")
    If code = "" Then Exit Sub  'if Cancel chosen, exit sub
    
    MousePointer = 11     'display hourglass
    
    Dim PASSWORD() As Byte  '定义数组用于存放密码的ASCII码
    Dim password_len As Integer
    
    password_len = Len(code)
    ReDim PASSWORD(password_len) As Byte
    For i = 0 To password_len - 1 '把密码转化为ASCII码
        PASSWORD(i) = Asc(Mid(code, i + 1, 1))
    Next
    
'将要加密的内容写入文件 App.System & "system01.txt"
    Open App.Path & "\System\system01.txt" For Output As #1
        Print #1, RTFMatter.TextRTF
    Close #1
    
    Dim databuff() As Byte  '定义数组用于存放文件内容
    Dim addbuff() As Byte   '定义数组用于存放加密后的文件内容
    
    '读取要加密的文件内容
    Open App.Path & "\System\system01.txt" For Binary As #1
    ReDim databuff(LOF(1))
    Get #1, , databuff
    Close #1
    
    '加密
    ReDim addbuff(UBound(databuff)) As Byte
    For i = 0 To UBound(databuff)
        'addbuff(i) = databuff(i) Xor password((i Mod password_len) + 1)
        addbuff(i) = Not databuff(i) '无密码加密
    Next
    
    '把加密后的内容写入文件
    Open App.Path & "\System\system01.txt" For Binary As #1
    Put #1, , addbuff
    Close #1
    
     '将解密后的文件写入纪录
    Me.RTFMatter.TextRTF = StrConv(addbuff, vbUnicode) '显示加密后的文件内容
    Me.RTFMatter.Enabled = True
    
    MousePointer = 0  'reset mouse
    
    '记录 flag =0,标志未加密
    txtflag.Text = 0
    
    '清空 App.Path & "\System\system01.txt"
    Open App.Path & "\System\system01.txt" For Output As #1
        Print #1, ""
    Close #1
End Sub

'//////////////////////////////////
'////           RTF 右键菜单
Private Sub menuQEditUndo_Click()
    SendKeys "^z", True
End Sub
Private Sub menuQEditCopy_Click()
    SendKeys "^c", True
End Sub
Private Sub menuQEditCut_Click()
    SendKeys "^x", True
End Sub
Private Sub menuQEditPaste_Click()
    SendKeys "^v", True
End Sub
Private Sub menuQEditAll_Click()
    SendKeys "^a", True
End Sub

Private Sub menuQEditFont_Click()
    menuEditFont_Click
End Sub

Private Sub menuQEditColour_Click()
    menuEditColour_Click
End Sub

'//////////////////////////////////
'////           选项
Private Sub menuOptionCipher_Click()
    frmSetPassword.Show (1) '模式窗口
End Sub

Private Sub menuOptionParameter_Click()
    frmSetParameter.Show 1, Me '模式窗口
End Sub

'//////////////////////////////////
'////           帮助
Private Sub menuHelpSubject_Click()
    'help
End Sub

Private Sub menuHelpReadme_Click()
    CommandLine = "C:\WINDOWS\NOTEPAD.EXE " & App.Path & "\Readme.txt"
    x = Shell(CommandLine, vbNormalFocus)
End Sub

Private Sub menuHelpSentmail_Click()
    sendmail
End Sub

Private Sub menuHelpWeb_Click()
    gotoweb
End Sub

Private Sub menuHelpAbout_Click()
    frmAbout.Show (1)
End Sub

'///////////////////////////////////
'///////    输入 tab
Private Sub RTFMatter_GotFocus()
    Me.listSubject.TabStop = False
    Me.txtSubject.TabStop = False
    Me.txtEditTime.TabStop = False
    Me.CmdAdd.TabStop = False
    Me.CmdToSearch.TabStop = False
    Me.CmdList.TabStop = False
    Me.CmdDel.TabStop = False
    Me.CmdOK.TabStop = False
End Sub

Private Sub RTFMatter_LostFocus()
    Me.listSubject.TabStop = True
    Me.txtSubject.TabStop = True
    Me.txtEditTime.TabStop = True
    Me.CmdAdd.TabStop = True
    Me.CmdToSearch.TabStop = True
    Me.CmdList.TabStop = True
    Me.CmdDel.TabStop = True
    Me.CmdOK.TabStop = True
End Sub

Private Sub RTFMatter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then Me.PopupMenu menuQEdit
End Sub

Private Sub txtSubject_Change()
    '防止“主题”输入超出 50 字节时出错
    '【 Note 工程 】Bug 解决方法 8,1
    If Len(txtSubject.Text) > 48 Then
        txtSubject.Text = left(txtSubject.Text, 48)
        Me.txtSubject.SelStart = 100
    End If
End Sub

'///////////////////////////////////
'///////    查找
Private Sub CmdSearch_Click()
    Dim equal As Boolean
    equal = False
    For i = 0 To n - 1
        If Combo.Text = Search(i) Then equal = True
    Next
    If Not equal Then
        ReDim Preserve Search(n)
        Combo.AddItem Combo.Text, n
        Search(n) = Combo.Text
        n = n + 1
    End If

    With Data1.Recordset
        If Trim(Combo.Text) <> "" Then
            LastPosition = .Bookmark
            If CheckAllMatch.Value = 1 Then
                .FindFirst "[主题] like" & "'" & Trim(Combo.Text) & "'"
            Else
                .FindFirst "[主题] like" & "'*" & Trim(Combo.Text) & "*'"
            End If
            If .NoMatch Then
                MsgBox "数据库中不存在" & "主题为 '" & Trim(Combo.Text) & "' 的记录！"
                .Bookmark = LastPosition
                Exit Sub
            Else
                LastPosition = .Bookmark
                CmdSearch.Visible = False
                CmdSearchNext.Visible = True
            End If
        Else
            MsgBox "请输入要查找的主题！", vbExclamation
            Combo.SetFocus
        End If
    End With
End Sub

Private Sub CmdSearchNext_Click()
    With Data1.Recordset
    If Trim(Combo.Text) <> "" Then
        LastPosition = .Bookmark
        If CheckAllMatch.Value = 1 Then
            .FindNext "[主题] like" & "'" & Trim(Combo.Text) & "'"
            Else
            .FindNext "[主题] like" & "'*" & Trim(Combo.Text) & "*'"
        End If
        If .NoMatch Then
            MsgBox "已搜索到数据库末了！"
            .Bookmark = LastPosition
            Exit Sub
        Else
            LastPosition = .Bookmark
            CmdSearch.Enabled = False
        End If
    Else
        MsgBox "请输入要查找的主题！", vbExclamation
        Combo.SetFocus
    End If
    End With
End Sub

Private Sub Combo_Click()
    CmdSearch.Visible = True
    CmdSearchNext.Visible = False
End Sub

Private Sub Combo_Change()
    CmdSearch.Visible = True
    CmdSearchNext.Visible = False
End Sub
上一页 1 2 34
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -