frmmain.frm

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

      Begin VB.Menu mnuViewBackColor 
         Caption         =   "背景色"
      End
      Begin VB.Menu mnuViewBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewWebBrowser 
         Caption         =   "Web 浏览器(&W)"
      End
   End
   Begin VB.Menu mnuTools 
      Caption         =   "工具(&T)"
      Begin VB.Menu mnuToolsWordCount 
         Caption         =   "统计字数"
      End
      Begin VB.Menu mnuToolsBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolsPost 
         Caption         =   "邮编/区号/区划代码查询"
      End
      Begin VB.Menu mnuToolsMeasure 
         Caption         =   "中外度量衡换算表"
      End
      Begin VB.Menu mnuToolsCalc 
         Caption         =   "神龙计算器"
      End
      Begin VB.Menu mnuToolsComm 
         Caption         =   "个人通讯助理"
      End
      Begin VB.Menu mnuToolsBar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuToolsOptions 
         Caption         =   "选项(&O)..."
      End
   End
   Begin VB.Menu mnuUser 
      Caption         =   "用户(&U)"
      Begin VB.Menu mnuUserGL 
         Caption         =   "用户管理(&G)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "目录(&C)"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "搜索帮助主题(&S)..."
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function OSWinHelp% Lib "User32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private 内容有修改 As Boolean
Private 不是第一次 As Boolean
Private 操作被用户取消 As Boolean
Private sFile As String '文章名
Private f_rs As ADODB.Recordset
Public Ctb As Byte

Private Sub Combo1_Click()
    Text1(Ctb).FontSize = Val(Combo1.Text)
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
    On Error GoTo ErrAbc
    If KeyAscii = 13 Then
        Text1(Ctb).FontSize = Val(Combo1.Text)
        Combo1.SelStart = 0
        Combo1.SelLength = Len(Combo1.Text)
    Else
        If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
            KeyAscii = 0
        End If
    End If
    Exit Sub
ErrAbc:
    MsgBox "请输入 1 - 2160(磅)之间的值。", vbOKOnly + vbCritical, "神龙提示"
    Resume Next
End Sub

Private Sub Command1_Click()
    ImageCombo1.ComboItems
End Sub

Private Sub Combo2_Click()
    Text1(0).Font.Name = Combo2.Text
    Text1(1).Font.Name = Combo2.Text
End Sub

Private Sub Form_Activate()
    Text1(Ctb).Visible = True
    Text1(Ctb).SetFocus
End Sub

Private Sub Form_Initialize()
    On Error GoTo ErrAbc
    Set f_rs = New ADODB.Recordset
    f_rs.Open "文章表", g_DBCon, adOpenStatic, adLockPessimistic, adCmdTable
    Exit Sub
ErrAbc:
    MsgBox "错误编号：" & Err.Number _
            & "错误描述：" & Err.Description, vbOKOnly + vbCritical, "神龙提示"
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    sFile = ""
    For i = 5 To 72
        Combo1.AddItem "" & i
    Next i
    Combo1.ListIndex = 8
    For i = 0 To Screen.FontCount - 1
        Combo2.AddItem Screen.Fonts(i)
    Next i

    For i = 0 To Combo2.ListCount - 1
        If Combo2.List(i) = Text1(Ctb).Font.Name Then
            Exit For
        End If
    Next i
    Combo2.ListIndex = i
    Text1(0).Text = ""
    内容有修改 = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    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 Cancel = -1

End Sub

Private Sub Form_Resize()
    '当窗体大小改变时，更改RichTextBox控件的大小以适应窗体。
    If tbToolBar.Visible Then
        Text1(0).Top = tbToolBar.Height + 1
        If sbStatusBar.Visible Then
            Text1(0).Height = Me.ScaleHeight - tbToolBar.Height - sbStatusBar.Height
        Else
            Text1(0).Height = Me.ScaleHeight - tbToolBar.Height
        End If
    Else
        Text1(0).Top = 0
        If sbStatusBar.Visible Then
            Text1(0).Height = Me.ScaleHeight - sbStatusBar.Height
        Else
            Text1(0).Height = Me.ScaleHeight
        End If
    End If
    Text1(0).Left = 0
    Text1(0).Width = Me.ScaleWidth
    
    Text1(1).Top = Text1(0).Top
    Text1(1).Left = Text1(0).Left
    Text1(1).Width = Text1(0).Width
    Text1(1).Height = Text1(0).Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer

    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    
    f_rs.Close
    Set f_rs = Nothing
    DisConnect '关闭数据库连接
    Set g_DBCon = Nothing
End Sub

Private Sub mnuEditAllSelect_Click()
    Text1(Ctb).SelStart = 0
    Text1(Ctb).SelLength = Len(Text1(Ctb).Text)
    Call Text1_Click(CInt(Ctb))
End Sub

Private Sub mnuEditDateTime_Click()
    Text1(Ctb).SelText = Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日 " & Hour(Now) & "点" & Minute(Now) & "分" & Second(Now) & "秒"
End Sub

Private Sub mnuEditFind_Click()
   ' 获取需要查找的字符串。
    frmFind.是替换 = False
    frmFind.Show
End Sub

Public Sub Find_Next()
    Find1.Where = InStr(Find1.Where, Text1(Ctb).Text, Find1.Find_Str)    ' 在文本中查找字符串。
    If Find1.Where Then   ' 如果找到，
        Text1(Ctb).SelStart = Find1.Where - 1     ' 设置选定的起始位置并
        Text1(Ctb).SelLength = Len(Find1.Find_Str)     ' 设置选定的长度。
        Text1_Click (CInt(Ctb))
    Else
        MsgBox "没有找到！", vbSystemModal   ' 给出通知。
    End If
    Find1.Where = Find1.Where + 1
    Me.SetFocus
End Sub

Private Sub mnuEditFindNext_Click()
    If Find1.Find_Str = "" Then
        Call mnuEditFind_Click
    Else
        Call Find_Next
    End If
End Sub

Private Sub mnuEditReplace_Click()
    frmFind.是替换 = True
    frmFind.Show
End Sub

Private Sub mnuFileImport_Click()
    Dim LineStr As String
    Dim ifn As frmInputFileName
    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
    With dlgCommonDialog
        .DialogTitle = "打开"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*|文本文件(*.txt)|*.txt|网页(*.htm)|*.htm"
        .FilterIndex = 2
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ToDo: 添加处理打开的文件的代码
    sbStatusBar.Panels(1).Text = "正在加载文件内容，请稍等..."
    Text1(Ctb).Text = ""
    Open sFile For Input As #1
    While Not EOF(1)
        Line Input #1, LineStr
        Text1(Ctb).Text = Text1(Ctb).Text & LineStr & Chr(13) & Chr(10)
    Wend
    Close #1
    内容有修改 = False
    '存入库中代码...
    Set ifn = New frmInputFileName
    ifn.FileName = sFile
    ifn.Show vbModal
    If ifn.FileName = "" Then
        操作被用户取消 = True
    Else
        f_rs.MoveFirst
        Do While Not f_rs.EOF
            If f_rs.Fields.Item("文章名").Value = ifn.FileName Then
                Exit Do
            End If
            f_rs.MoveNext
        Loop
        If f_rs.EOF Then
            SaveAsToLib ifn.FileName
        Else
            SaveToLib
        End If
    End If
    Unload ifn
    Set ifn = Nothing
    sbStatusBar.Panels(1).Text = "状态"

End Sub

Private Sub mnufileOutput_Click()
'导出文本到磁盘文件
    With dlgCommonDialog
        .DialogTitle = "导出..."
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*|文本文件(*.txt)|*.txt|网页文件(*.htm)|*.htm"
        .FilterIndex = 2
        .ShowSave
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
    End With
    SaveFile dlgCommonDialog.FileName
End Sub

Private Sub mnuUserGL_Click()
    frmUser.Show 1
End Sub

Private Sub mnuViewBackColor_Click()
    dlgCommonDialog.ShowColor
    Text1(Ctb).BackColor = dlgCommonDialog.Color
End Sub

Private Sub mnuViewColor_Click()
    dlgCommonDialog.ShowColor
    Text1(Ctb).ForeColor = dlgCommonDialog.Color
End Sub

Private Sub mnuViewFont_Click()
    
    dlgCommonDialog.FontName = Text1(Ctb).FontName
    dlgCommonDialog.FontSize = Text1(Ctb).FontSize
    dlgCommonDialog.FontStrikethru = Text1(Ctb).FontStrikethru
    dlgCommonDialog.FontUnderline = Text1(Ctb).FontUnderline
    dlgCommonDialog.FontItalic = Text1(Ctb).FontItalic
    dlgCommonDialog.FontBold = Text1(Ctb).FontBold
    dlgCommonDialog.Color = Text1(Ctb).ForeColor
    
    dlgCommonDialog.Flags = cdlCFScreenFonts + cdlCFEffects
    dlgCommonDialog.ShowFont
    
    Text1(Ctb).FontName = dlgCommonDialog.FontName
    Text1(Ctb).FontBold = dlgCommonDialog.FontBold
    Text1(Ctb).FontItalic = dlgCommonDialog.FontItalic
    Text1(Ctb).FontSize = dlgCommonDialog.FontSize
    Text1(Ctb).FontStrikethru = dlgCommonDialog.FontStrikethru
    Text1(Ctb).FontUnderline = dlgCommonDialog.FontUnderline
    Text1(Ctb).ForeColor = dlgCommonDialog.Color
    
    Combo1.Text = "" & Text1(Ctb).FontSize
    
End Sub

Private Sub mnuViewLF_Click()
    Dim ss As Long
    Dim sl As Long
    mnuViewLF.Checked = Not mnuViewLF.Checked
    Ctb = IIf(mnuViewLF.Checked, 0, 1)
    ss = Text1(IIf(Ctb = 0, 1, 0)).SelStart
    sl = Text1(IIf(Ctb = 0, 1, 0)).SelLength
    
    If Ctb = 0 Then
        Text1(0).Text = Text1(1).Text
        Text1(0).BackColor = Text1(1).BackColor
        Text1(0).Font.Bold = Text1(1).Font.Bold
        Text1(0).Font.Charset = Text1(1).Font.Charset
        Text1(0).Font.Italic = Text1(1).Font.Italic
        Text1(0).Font.Name = Text1(1).Font.Name
        Text1(0).Font.Size = Text1(1).Font.Size
        Text1(0).Font.Strikethrough = Text1(1).Font.Strikethrough
        Text1(0).Font.Underline = Text1(1).Font.Underline
        Text1(0).Font.Weight = Text1(1).Font.Weight
        
        Text1(0).ForeColor = Text1(1).ForeColor
        Text1(0).Locked = Text1(1).Locked
        Text1(0).Visible = True
        Text1(1).Visible = False
        Text1(0).SetFocus
        Text1(0).SelStart = ss
        Text1(0).SelLength = sl
        'Text1(0).SelText = Text1(1).SelText
        
    Else
        Text1(1).Text = Text1(0).Text
        Text1(1).Text = Text1(0).Text
        Text1(1).BackColor = Text1(0).BackColor
        Text1(1).Font.Bold = Text1(0).Font.Bold
        Text1(1).Font.Charset = Text1(0).Font.Charset
        Text1(1).Font.Italic = Text1(0).Font.Italic
        Text1(1).Font.Name = Text1(0).Font.Name
        Text1(1).Font.Size = Text1(0).Font.Size
        Text1(1).Font.Strikethrough = Text1(0).Font.Strikethrough
        Text1(1).Font.Underline = Text1(0).Font.Underline
        Text1(1).Font.Weight = Text1(0).Font.Weight
        Text1(1).ForeColor = Text1(0).ForeColor
        Text1(1).Locked = Text1(0).Locked
        Text1(1).Visible = False
        Text1(1).Visible = True