frmmain.frm

关于记事本的编码,对大家有用

        Text1(1).SetFocus
        Text1(1).SelStart = ss
        Text1(1).SelLength = sl
        'Text1(1).SelText = Text1(0).SelText
        
    End If
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "新建"
            mnuFileNew_Click '调用 "新建" 菜单项代码。
        Case "打开"
            mnuFileOpen_Click  '调用 "打开" 菜单项代码。
        Case "保存"
            mnuFileSave_Click  '调用 "保存" 菜单项代码。
        Case "打印"
            mnuFilePrint_Click  '调用 "打印" 菜单项代码。
        Case "剪切"
            mnuEditCut_Click  '调用 "剪切" 菜单项代码。
        Case "复制"
            mnuEditCopy_Click  '调用 "复制" 菜单项代码。
        Case "粘贴"
            mnuEditPaste_Click  '调用 "粘贴" 菜单项代码。
        Case "粗体"
            '粗体 按钮代码。
            Text1(Ctb).FontBold = Not Text1(Ctb).FontBold
            Button.Value = IIf(Text1(Ctb).FontBold, tbrPressed, tbrUnpressed)
        Case "斜体"
            '斜体 按钮代码。
            Text1(Ctb).FontItalic = Not Text1(Ctb).FontItalic
            Button.Value = IIf(Text1(Ctb).FontItalic, tbrPressed, tbrUnpressed)
        Case "下划线"
            '下划线 按钮代码。
            Text1(Ctb).FontUnderline = Not Text1(Ctb).FontUnderline
            Button.Value = IIf(Text1(Ctb).FontUnderline, tbrPressed, tbrUnpressed)
            
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuToolsOptions_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewWebBrowser_Click()
    Dim frmB As New frmBrowser
    frmB.StartingAddress = "http://www.microsoft.com"
    frmB.Show
End Sub

Private Sub mnuViewOptions_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    Call Form_Resize
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
    Call Form_Resize
End Sub

Private Sub mnuEditPaste_Click()
    '粘贴操作 代码。
    Text1(Ctb).SelText = Clipboard.GetText(1)
End Sub

Private Sub mnuEditCopy_Click()
    '复制操作 代码。
    Clipboard.Clear
    Clipboard.SetText Text1(Ctb).SelText, 1
End Sub

Private Sub mnuEditCut_Click()
    '剪切操作 代码。
    Clipboard.Clear
    Clipboard.SetText Text1(Ctb).SelText, 1
    Text1(Ctb).SelText = ""
End Sub

Private Sub mnuEditUndo_Click()
    '应做:添加 'mnuEditUndo_Click' 代码。
    'MsgBox "添加 'mnuEditUndo_Click' 代码。"
End Sub

Private Sub mnuFileExit_Click()
    '卸载窗体
    Unload Me

End Sub

Private Sub mnuFileSend_Click()
    '应做:添加 'mnuFileSend_Click' 代码。
    'MsgBox "添加 'mnuFileSend_Click' 代码。"
End Sub

Private Sub mnuFilePrint_Click()
    '应做:添加 'mnuFilePrint_Click' 代码。
    'MsgBox "添加 'mnuFilePrint_Click' 代码。"
End Sub

Private Sub mnuFilePrintPreview_Click()
    '应做:添加 'mnuFilePrintPreview_Click' 代码。
    'MsgBox "添加 'mnuFilePrintPreview_Click' 代码。"
End Sub

Private Sub mnuFilePageSetup_Click()
    On Error Resume Next
    With dlgCommonDialog
        .DialogTitle = "页面设置"
        .CancelError = True
        .ShowPrinter
    End With

End Sub

Private Sub mnuFileProperties_Click()
    '应做:添加 'mnuFileProperties_Click' 代码。
    'MsgBox "添加 'mnuFileProperties_Click' 代码。"
End Sub

Private Sub mnuFileSaveAs_Click()
    '文件另存。。。
    Dim ifn As New frmInputFileName
    ifn.FileName = sFile
    ifn.Show vbModal
    sFile = ifn.FileName
    Unload ifn
    Set ifn = Nothing
    
    If Len(sFile) = 0 Then
        操作被用户取消 = True
    Else
        SaveAsToLib sFile
        mnuFileSave.Enabled = False
        tbToolBar.Buttons.Item("保存").Enabled = False
        内容有修改 = False
        操作被用户取消 = False
    End If
End Sub

Private Sub mnuFileSave_Click()
    '应做:添加 'mnuFileSave_Click' 代码。
    If sFile = "" Then
        Call mnuFileSaveAs_Click
    Else
        SaveToLib
        mnuFileSave.Enabled = False
        tbToolBar.Buttons.Item("保存").Enabled = False
        内容有修改 = False
    End If
End Sub

Private Sub mnuFileClose_Click()
    '关闭当前文档
    Dim ans As Integer
    
    操作被用户取消 = False
    
    If 内容有修改 Then
        '提示是否保存当前文件？
        ans = MsgBox("当前文件已经修改过，是否要保存它？", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "神龙提示")
        If ans = vbYes Then
            If sFile = "" Then
                Call mnuFileSaveAs_Click
                If Not 操作被用户取消 Then
                    Text1(Ctb).Text = ""
                    Text1(Ctb).Visible = False
                    sFile = ""
                    内容有修改 = False
                End If
            Else
                SaveToLib
                内容有修改 = False
                Text1(Ctb).Visible = False
            End If
        ElseIf ans = vbNo Then
            Text1(Ctb).Text = ""
            sFile = ""
            内容有修改 = False
            Text1(Ctb).Visible = False
        Else
            操作被用户取消 = True
        End If
    Else
        Text1(Ctb).Text = ""
        Text1(Ctb).Visible = False
        sFile = ""
    End If

End Sub

Private Sub mnuFileOpen_Click()
    Dim fod As frmOpenDialog
    
    Dim ans As Integer
    
    操作被用户取消 = False
    
    If 内容有修改 Then
        '提示是否保存当前文件？
        ans = MsgBox("当前文件已经修改过，是否要保存它？", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "神龙提示")
        If ans = vbYes Then
            If sFile = "" Then
                Call mnuFileSaveAs_Click
            Else
                SaveToLib
            End If
        ElseIf ans = vbCancel Then
            操作被用户取消 = True
        End If
    End If
    
    If 操作被用户取消 Then Exit Sub
    
    Set fod = New frmOpenDialog
    fod.Show vbModal
    If fod.FileName = "" Then
        操作被用户取消 = True
    Else
        f_rs.MoveFirst
        Do While Not f_rs.EOF
            If f_rs.Fields.Item("文章名").Value = fod.FileName Then
                Exit Do
            End If
            f_rs.MoveNext
        Loop
        Text1(Ctb).Text = f_rs.Fields.Item("正文内容").Value
        Text1(Ctb).BackColor = f_rs.Fields.Item("背景色").Value
        Text1(Ctb).Font.Bold = f_rs.Fields.Item("粗体").Value
        Text1(Ctb).Font.Italic = f_rs.Fields.Item("斜体").Value
        Text1(Ctb).Font.Name = f_rs.Fields.Item("字体").Value
        Text1(Ctb).Font.Size = f_rs.Fields.Item("字号").Value
        Text1(Ctb).Font.Strikethrough = f_rs.Fields.Item("删除线").Value
        Text1(Ctb).Font.Underline = f_rs.Fields.Item("下划线").Value
        Text1(Ctb).ForeColor = f_rs.Fields.Item("前景色").Value
        Text1(Ctb).SelStart = f_rs.Fields.Item("选定开始").Value
        Text1(Ctb).SelLength = f_rs.Fields.Item("选定长度").Value
        Text1_Click (CInt(Ctb))
        tbToolBar.Buttons.Item("粗体").Value = IIf(Text1(Ctb).FontBold, tbrPressed, tbrUnpressed)
        tbToolBar.Buttons.Item("斜体").Value = IIf(Text1(Ctb).FontItalic, tbrPressed, tbrUnpressed)
        tbToolBar.Buttons.Item("下划线").Value = IIf(Text1(Ctb).FontUnderline, tbrPressed, tbrUnpressed)
        Combo1.Text = "" & Text1(Ctb).FontSize
        Combo2.Text = Text1(Ctb).FontName

        sFile = fod.FileName
        内容有修改 = False

    End If
    Unload fod
    Set fod = Nothing
End Sub

Private Sub mnuFileNew_Click()
    Dim ans As Integer
    
    操作被用户取消 = False
    
    If 内容有修改 Then
        '提示是否保存当前文件？
        ans = MsgBox("当前文件已经修改过，是否要保存它？", vbYesNoCancel + vbDefaultButton1 + vbQuestion, "神龙提示")
        If ans = vbYes Then
            If sFile = "" Then
                Call mnuFileSaveAs_Click
                If Not 操作被用户取消 Then
                    Text1(Ctb).Text = ""
                    sFile = ""
                    内容有修改 = False
                End If
            Else
                SaveToLib
                Text1(Ctb).Text = ""
                sFile = ""
                内容有修改 = False
            End If
        ElseIf ans = vbNo Then
            Text1(Ctb).Text = ""
            sFile = ""
            内容有修改 = False
        Else
            操作被用户取消 = True
        End If
    Else
        Text1(Ctb).Text = ""
        Text1(Ctb).Visible = True
        sFile = ""
        内容有修改 = False
    End If
    不是第一次 = True
End Sub

Public Sub SaveFile(fn As String)
    Open fn For Output As #1
    Print #1, Text1(Ctb).Text
    Close #1
    内容有修改 = False
End Sub
Private Sub SaveAsToLib(fn As String)
    '保存文章到库中
    f_rs.AddNew
    f_rs.Fields.Item("文章名").Value = fn
    f_rs.Fields.Item("创建人ID").Value = 当前用户ID
    f_rs.Fields.Item("创建时间").Value = Now
    f_rs.Fields.Item("正文内容").Value = Text1(Ctb).Text
    
    f_rs.Fields.Item("背景色").Value = Text1(Ctb).BackColor
    f_rs.Fields.Item("粗体").Value = Text1(Ctb).Font.Bold
    f_rs.Fields.Item("斜体").Value = Text1(Ctb).Font.Italic
    f_rs.Fields.Item("字体").Value = Text1(Ctb).Font.Name
    f_rs.Fields.Item("字号").Value = Text1(Ctb).Font.Size
    f_rs.Fields.Item("删除线").Value = Text1(Ctb).Font.Strikethrough
    f_rs.Fields.Item("下划线").Value = Text1(Ctb).Font.Underline
    f_rs.Fields.Item("前景色").Value = Text1(Ctb).ForeColor
    f_rs.Fields.Item("选定开始").Value = Text1(Ctb).SelStart
    f_rs.Fields.Item("选定长度").Value = Text1(Ctb).SelLength
    
    
    f_rs.Update
End Sub

Private Sub SaveToLib()
    '更新修改后的文章到库中
    f_rs.Fields.Item("最近修改人").Value = 当前用户名
    f_rs.Fields.Item("最近修改时间").Value = Now
    f_rs.Fields.Item("正文内容").Value = Text1(Ctb).Text
    f_rs.Fields.Item("修改次数").Value = f_rs.Fields.Item("修改次数").Value + 1
    f_rs.Fields.Item("背景色").Value = Text1(Ctb).BackColor
    f_rs.Fields.Item("粗体").Value = Text1(Ctb).Font.Bold
    f_rs.Fields.Item("斜体").Value = Text1(Ctb).Font.Italic
    f_rs.Fields.Item("字体").Value = Text1(Ctb).Font.Name
    f_rs.Fields.Item("字号").Value = Text1(Ctb).Font.Size
    f_rs.Fields.Item("删除线").Value = Text1(Ctb).Font.Strikethrough
    f_rs.Fields.Item("下划线").Value = Text1(Ctb).Font.Underline
    f_rs.Fields.Item("前景色").Value = Text1(Ctb).ForeColor
    f_rs.Fields.Item("选定开始").Value = Text1(Ctb).SelStart
    f_rs.Fields.Item("选定长度").Value = Text1(Ctb).SelLength
    f_rs.Update
End Sub
Private Sub Text1_Change(Index As Integer)
    内容有修改 = True
    mnuFileSave.Enabled = True
    tbToolBar.Buttons.Item("保存").Enabled = True
End Sub

Public Sub Text1_Click(Index As Integer)
    If Text1(Index).SelLength > 0 Then
        mnuEditCopy.Enabled = True
        mnuEditCut.Enabled = True
        tbToolBar.Buttons("复制").Enabled = True
        tbToolBar.Buttons("剪切").Enabled = True
    Else
        mnuEditCopy.Enabled = False
        mnuEditCut.Enabled = False
        tbToolBar.Buttons("复制").Enabled = False
        tbToolBar.Buttons("剪切").Enabled = False
    End If
End Sub

Private Sub Text1_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyDelete
        If Text1(Index).SelLength = 0 Then
            Text1(Index).SelLength = 1
        End If
        Text1(Index).SelText = ""
    End Select
    Call Text1_Click(Index)  '当用户使用键盘选定（或取消）文本时，确保菜单和相应工具按钮显示对应状态。
End Sub

Public Function GetSelText() As String
    GetSelText = Text1(Ctb).SelText
End Function