frmdoc.frm

这是一个完美版本的的超强文件编辑器,支持各种程序的语法高亮,支持插件和宏录制,支持XP菜单,支持浏览器浏览等等功能,记得有位网友做文件编辑器要求我给他一个支持语法高亮和DockWindows技术的代码

  If LineIndex + 1 > LastLine.Count Then Exit Sub 'this won't work we are at the end of lines
  LineIndex = LineIndex + 1
  'rt.ExecuteCmd cmCmdGotoLine, LastLine(LineIndex)
  rt.SetCaretPos LastLine(LineIndex), 1
  If LineIndex < LastLine.Count Then
    frmMain.tbProgramming.Buttons(13).Enabled = True
  Else
    frmMain.tbProgramming.Buttons(13).Enabled = True
  End If
  
  If LineIndex > 1 Then
    frmMain.tbProgramming.Buttons(12).Enabled = True
  Else
    frmMain.tbProgramming.Buttons(12).Enabled = False
  End If
End Sub

Public Sub PrevLine()
  On Error Resume Next
  If LineIndex - 1 < 1 Then Exit Sub 'this won't work we are at the end of lines
  LineIndex = LineIndex - 1
  rt.SetCaretPos LastLine(LineIndex), 1
  If LineIndex < LastLine.Count Then
    frmMain.tbProgramming.Buttons(13).Enabled = True
  Else
    frmMain.tbProgramming.Buttons(13).Enabled = False
  End If
  
  If LineIndex > 1 Then
    frmMain.tbProgramming.Buttons(12).Enabled = True
  Else
    frmMain.tbProgramming.Buttons(12).Enabled = False
  End If
End Sub

Public Sub CommentBlock()
  If rt.Language = "" Then Exit Sub
  Dim i As Integer
  Dim p As CodeSenseCtl.Language
  Dim s As CodeSenseCtl.globals
  Set s = New CodeSenseCtl.globals
  Dim UA() As String
  Dim cmstring As String
  Dim NewStr As String
  Set p = s.GetLanguageDef(rt.Language)
  cmstring = p.SingleLineComments
  Set p = Nothing
  Set s = Nothing
  NewStr = ""
  UA = Split(rt.SelText, Chr$(10))
  For i = 0 To UBound(UA)
    NewStr = NewStr & cmstring & UA(i)
  Next
  Erase UA
  InsertString rt, NewStr
  NewStr = ""
  cmstring = ""
End Sub

Public Sub UncommentBlock()
  If rt.Language = "" Then Exit Sub
  Dim p As CodeSenseCtl.Language
  Dim s As CodeSenseCtl.globals, cmstring As String
  Set s = New CodeSenseCtl.globals
  Set p = s.GetLanguageDef(rt.Language)
  cmstring = p.SingleLineComments
  Set p = Nothing
  Set s = Nothing
  InsertString rt, Replace(rt.SelText, cmstring, "")
End Sub

Private Sub Clear()
  Dim x As Integer
  For x = LastLine.Count To 1 Step -1
    LastLine.Remove (x)
  Next
End Sub

Public Sub DoAct()
  frmMain.tb.Tabs("key" & Me.Tag).Caption = StripPath(Me.Caption)
  frmMain.tb.Tabs("key" & Me.Tag).Selected = True
  frmMain.tb.Tabs("key" & Me.Tag).ToolTipText = Me.Caption
  If Changed = False Then
    frmMain.tb.Tabs("key" & Me.Tag).Image = 1
  Else
    frmMain.tb.Tabs("key" & Me.Tag).Image = 2
  End If
End Sub

Private Sub EnableMac()
  Dim x As Integer
  If (frmMain.tbMacro.Buttons("mac1").Enabled) = True Then Exit Sub 'They are already enabled
  For x = 1 To 10
    frmMain.tbMacro.Buttons("mac" & x).Enabled = True
  Next
  frmMain.tbMacro.Buttons("cmac").Enabled = True
End Sub

Private Sub DisableMac()
  Dim x As Integer
  If frmMain.tbMacro.Buttons("mac1").Enabled = False Then Exit Sub
  If UBound(Document()) > 0 Then Exit Sub
  If closeall = True Then Exit Sub
  For x = 1 To 10
    frmMain.tbMacro.Buttons("mac" & x).Enabled = False
  Next
  frmMain.tbMacro.Buttons("cmac").Enabled = False
End Sub

Private Sub DisableMenu()
  Dim x As Integer
  If frmMain.close.Enabled = False Then Exit Sub  'Just make sure it's not already done to save the effort
  If UBound(Document()) > 0 Then Exit Sub
  frmMain.close.Enabled = False
  frmMain.save.Enabled = False
  frmMain.saveas.Enabled = False
  frmMain.saveall.Enabled = False
  frmMain.saveto.Enabled = False
  frmMain.prints.Enabled = False
  frmMain.printsetup.Enabled = False
  frmMain.properties.Enabled = False
  frmMain.undo.Enabled = False
  frmMain.redo.Enabled = False
  frmMain.cut.Enabled = False
  frmMain.copy.Enabled = False
  frmMain.paste.Enabled = False
  frmMain.delete.Enabled = False
  frmMain.mnuComment.Enabled = False
  frmMain.mnuUncomment.Enabled = False
  frmMain.selectall.Enabled = False
  frmMain.selectline.Enabled = False
  frmMain.datetime.Enabled = False
  frmMain.find.Enabled = False
  frmMain.findnext.Enabled = False
  frmMain.findprev.Enabled = False
  frmMain.mnuReplace.Enabled = False
  frmMain.goto.Enabled = False
  frmMain.mnuToggle.Enabled = False
  frmMain.mnuNext.Enabled = False
  frmMain.mnuPrev.Enabled = False
  frmMain.mnuClear.Enabled = False
  frmMain.mnuNLine.Enabled = False
  frmMain.mnuLPrev.Enabled = False
  frmMain.countall.Enabled = False
  frmMain.mnuCompile.Enabled = False
  frmMain.mnuBuildConfig.Enabled = False
  For x = 1 To 10
    frmMain.mac(x).Enabled = False
  Next
  frmMain.mnuSave.Enabled = False
  frmMain.mnuCreate.Enabled = False
  frmMain.tilehor.Enabled = False
  frmMain.tilever.Enabled = False
  frmMain.arrangeicons.Enabled = False
  frmMain.cascade.Enabled = False
  frmMain.closeall.Enabled = False
  frmMain.inbrowser.Enabled = False
  frmMain.wnlist.Enabled = False
End Sub

Private Sub EnableMenu()
  Dim x As Integer
  If frmMain.close.Enabled = True Then Exit Sub
  If closeall = True Then Exit Sub
  frmMain.close.Enabled = True
  frmMain.save.Enabled = True
  frmMain.saveas.Enabled = True
  frmMain.saveall.Enabled = True
  frmMain.saveto.Enabled = True
  frmMain.prints.Enabled = True
  frmMain.printsetup.Enabled = True
  frmMain.properties.Enabled = True
  frmMain.undo.Enabled = True
  frmMain.redo.Enabled = True
  frmMain.cut.Enabled = True
  frmMain.copy.Enabled = True
  frmMain.paste.Enabled = True
  frmMain.delete.Enabled = True
  frmMain.mnuComment.Enabled = True
  frmMain.mnuUncomment.Enabled = True
  frmMain.selectall.Enabled = True
  frmMain.selectline.Enabled = True
  frmMain.datetime.Enabled = True
  frmMain.find.Enabled = True
  frmMain.findnext.Enabled = True
  frmMain.findprev.Enabled = True
  frmMain.mnuReplace.Enabled = True
  frmMain.goto.Enabled = True
  frmMain.mnuToggle.Enabled = True
  frmMain.mnuNext.Enabled = True
  frmMain.mnuPrev.Enabled = True
  frmMain.mnuClear.Enabled = True
  frmMain.mnuNLine.Enabled = True
  frmMain.mnuLPrev.Enabled = True
  frmMain.countall.Enabled = True
  frmMain.mnuCompile.Enabled = True
  frmMain.mnuBuildConfig.Enabled = True
  For x = 1 To 10
    frmMain.mac(x).Enabled = True
  Next
  frmMain.mnuSave.Enabled = True
  frmMain.mnuCreate.Enabled = True
  frmMain.tilehor.Enabled = True
  frmMain.tilever.Enabled = True
  frmMain.arrangeicons.Enabled = True
  frmMain.cascade.Enabled = True
  frmMain.closeall.Enabled = True
  frmMain.inbrowser.Enabled = True
  frmMain.wnlist.Enabled = True
End Sub

Private Sub CloseAble()
  ' This is a simple function which will
  ' disable all the unnecisary toolbar buttons
  ' on the main toolbar when the form unloads.
  
  ' First off lets check a button which is always
  ' enabled if a doc is open but never enabled if
  ' it's not and check (just to avoid doing this if
  ' their already disabled
  If (frmMain.tBar.Buttons("close").Enabled = False) Then Exit Sub 'Exit sub if it's already disabled
  If UBound(Document) >= 1 Then Exit Sub
  With frmMain.tBar
    .Buttons("close").Enabled = False
    .Buttons("save").Enabled = False
    .Buttons("saveas").Enabled = False
    .Buttons("saveall").Enabled = False
    .Buttons("reload").Enabled = False
    .Buttons("print").Enabled = False
    .Buttons("undo").Enabled = False
    .Buttons("redo").Enabled = False
    .Buttons("cut").Enabled = False
    .Buttons("copy").Enabled = False
    .Buttons("paste").Enabled = False
    .Buttons("delete").Enabled = False
    .Buttons("find").Enabled = False
    .Buttons("findnext").Enabled = False
    .Buttons("findprev").Enabled = False
    .Buttons("tilehor").Enabled = False
    .Buttons("tilever").Enabled = False
    .Buttons("cascade").Enabled = False
    .Buttons("tabl").Enabled = False
    .Buttons("tabr").Enabled = False
    .Buttons("cblock").Enabled = False
    .Buttons("ublock").Enabled = False
    .Buttons("tbmark").Enabled = False
    .Buttons("nbmark").Enabled = False
    .Buttons("pbmark").Enabled = False
    .Buttons("cbmark").Enabled = False
    .Buttons("nline").Enabled = False
    .Buttons("pline").Enabled = False
    .Buttons("nline").Enabled = False
    .Buttons("ctag").Enabled = False
  End With
End Sub

Private Sub OpenAble()
  ' This function will enabled all the neccisary buttons on the primary toolbar
  ' Please note not all the toolbar buttons will automaticly be enabled
  ' as some are dependant on certain factors.
  
  ' Check to verify their not already enabled cause if they are
  ' we don't need to waste the processor time on this
  If (frmMain.tBar.Buttons("close").Enabled = True) Then Exit Sub ' If it's enabled already just exit this sub
  
  With frmMain.tBar
    .Buttons("close").Enabled = True
    .Buttons("save").Enabled = True
    .Buttons("saveas").Enabled = True
    .Buttons("saveall").Enabled = True
    .Buttons("reload").Enabled = True
    .Buttons("delete").Enabled = True
    .Buttons("print").Enabled = True
    .Buttons("tilehor").Enabled = True
    .Buttons("tilever").Enabled = True
    .Buttons("cascade").Enabled = True
  End With
  With frmMain.tbSearch
    .Buttons("find").Enabled = True
    .Buttons("findnext").Enabled = True
    .Buttons("findprev").Enabled = True
  End With
  With frmMain.tbProgramming
    .Buttons("tabl").Enabled = True
    .Buttons("tabr").Enabled = True
    .Buttons("cblock").Enabled = True
    .Buttons("ublock").Enabled = True
    .Buttons("tbmark").Enabled = True
    .Buttons("nbmark").Enabled = True
    .Buttons("pbmark").Enabled = True
    .Buttons("cbmark").Enabled = True
    .Buttons("nline").Enabled = True
    .Buttons("pline").Enabled = True
    .Buttons("ctag").Enabled = True
  End With
End Sub

Private Sub ShouldEnable()
  ' This simple function will simply check if the
  ' several different things can take place and then
  ' depending on that enable or disable certain buttons
  ' on the toolbar.
  
  With frmMain.tBar
    If rt.CanUndo Then
      .Buttons("undo").Enabled = True
    Else
      .Buttons("undo").Enabled = False
    End If
    If rt.CanRedo Then
      .Buttons("redo").Enabled = True
    Else
      .Buttons("redo").Enabled = False
    End If
    If rt.CanCut Then
      .Buttons("cut").Enabled = True
    Else
      .Buttons("cut").Enabled = False
    End If
    If rt.CanCopy Then
      .Buttons("copy").Enabled = True
    Else
      .Buttons("copy").Enabled = False
    End If
    If rt.CanPaste Then
      .Buttons("paste").Enabled = True
    Else
      .Buttons("paste").Enabled = False
    End If
  End With
End Sub


Public Sub SetLangWords()
  Dim lng As CodeSenseCtl.Language, x As Long
  Dim glb As CodeSenseCtl.globals
  Set lng = New CodeSenseCtl.Language
  Set glb = New CodeSenseCtl.globals
  If rt.Language <> "" Then
    Set lng = glb.GetLanguageDef(rt.Language)
  End If
  Erase Keywords
  Erase Attributes
  Erase Elements
  Keywords = Split(lng.Keywords, Chr$(10))
  Attributes = Split(lng.TagAttributeNames, Chr$(10))
  Elements = Split(lng.TagElementNames, Chr$(10))
End Sub

Private Sub LangKeywords(lang As String)
  On Error Resume Next
  Dim lng As CodeSenseCtl.Language, UA() As String, x As Long
  Dim glb As CodeSenseCtl.globals
  cboProcedures.Clear
  Set lng = New CodeSenseCtl.Language
  Set glb = New CodeSenseCtl.globals
  Set lng = glb.GetLanguageDef(lang)
  UA = Split(lng.Keywords, Chr$(10))
  
  For x = 0 To UBound(UA) - 1
   cboProcedures.AddItem UA(x)
  Next
  Erase UA
End Sub