frmmain.frm

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

  If Dir(Comp) = "" Then
    MsgBox "Compiler not found.", vbOKOnly + vbCritical, "Error"
    Exit Sub
  End If
  If CaptureOut = "on" Then
    fDock.FormShow ("frmOutput")
    frmOutput.txtOut.Text = "Compilation in progress..."
    DoEvents
    MDebugOutput.Checked = True
    ChDir Mid(FileToCompile, 1, InStrRev(FileToCompile, "\"))
    frmOutput.txtOut.Text = GetCommandOutput(StrWrap(Comp) & " " & Variables)
    frmOutput.txtOut.SelStart = Len(frmOutput.txtOut.Text)
  Else
    Shell StrWrap(Comp) & " " & Variables, vbNormalFocus
  End If
  If InForOut = "on" And RunComp = "on" Then
    Shell VarRead, vbNormalFocus
  End If
End Sub

Private Sub mnuCreate_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdRecordMacro
End Sub

Private Sub mnuFindInFiles_Click()
  frmFindInFiles.Show vbModal, Me
End Sub

Private Sub mnuLPrev_Click()
  On Error Resume Next
  Document(dnum).PrevLine
End Sub

Private Sub mnuMacBar_Click()
  On Error Resume Next
  If mnuMacBar.Checked = True Then
    tbMacro.Visible = False
    mnuMacBar.Checked = False
  Else
    tbMacro.Visible = True
    mnuMacBar.Checked = True
  End If
End Sub

Private Sub mnuNext_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdBookmarkNext
End Sub

Private Sub mnuNLine_Click()
  On Error Resume Next
  Document(dnum).NextLine
End Sub

Private Sub mnuPlugin_Click(Index As Integer)
  On Error Resume Next
  Call RunPlugin(mnuPlugin(Index).Tag, Me) ' Execute the plug-in
End Sub

Private Sub mnuPrev_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdBookmarkPrev
End Sub

Private Sub mnuPSC_Click()
  ShowSite "http://www.mndsoft.com"
End Sub

Private Sub mnuRec_Click(Index As Integer)
  On Error Resume Next
  DoOpen mnuRec(Index).Caption
End Sub

Private Sub mnuReplace_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdFindReplace
End Sub

Private Sub mnuSave_Click()
  On Error Resume Next
  Dim x As Integer
  For x = 0 To 9
    SaveMacros App.path & "\macros\" & x & ".dem", x
  Next
End Sub

Private Sub mnuTemplate_Click(Index As Integer)
  LoadTemplate mnuTemplate(Index).Tag
End Sub

Private Sub mnuToggle_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdBookmarkToggle
End Sub

Private Sub mnuUncomment_Click()
  On Error Resume Next
  Document(dnum).UncommentBlock
End Sub

Private Sub mnuVB_Click()
  ShowSite "http://www.freevbcode.com"
End Sub

Private Sub mnuVBA_Click()
  ShowSite "http://www.vbaccelerator.com"
End Sub

Private Sub new_Click()
  On Error Resume Next
  doNew ""
End Sub

Private Sub online_Click()
  On Error Resume Next
  OpenURL "http://cedit.sourceforge.net/doc/index.html", Me.hwnd
End Sub

Private Sub picBottom_Resize()
'  On Error Resume Next
  tb.Move 0, 0, picBottom.ScaleWidth, picBottom.ScaleHeight
End Sub



Private Sub print2_Click()
  On Error Resume Next
  Call Document(dnum).rt.PrintContents(0, cmPrnColor + cmPrnDefaultPrn + cmPrnRichFonts)

End Sub

Private Sub quicknav_Click()
  On Error Resume Next
  If quicknav.Checked = True Then
    fDock.FormHide ("frmNav")
    quicknav.Checked = False
  Else
    quicknav.Checked = True
    fDock.FormShow ("frmNav")
  End If
End Sub

Private Sub open_Click()
  On Error Resume Next
  cd.CancelError = True
  cd.DialogTitle = "Open a document..."
  cd.Filter = AllSupport & FilterB
  cd.ShowOpen
  If cd.FileName = "" Then Exit Sub
  DoOpen cd.FileName
  AddRecent cd.FileName
End Sub

Private Sub openftp_Click()
  On Error Resume Next
  frmFTP.Caption = "Open Document"
  frmFTP.cmdOpen.Caption = "&Open"
  frmFTP.Show , Me
End Sub

Private Sub paste_Click()
  On Error Resume Next
  Document(dnum).rt.paste
End Sub

Private Sub Prints_Click()
  On Error Resume Next
  Call Document(dnum).rt.PrintContents(0, cmPrnColor + cmPrnDefaultPrn + cmPrnRichFonts)
End Sub

Private Sub printsetup_Click()
  On Error Resume Next
  Call Document(dnum).rt.PrintContents(0, cmPrnColor + cmPrnRichFonts)
End Sub

Private Sub properties_Click()
  On Error Resume Next
  Dim UA() As String, kB As Double
  kB = (Len(Document(dnum).rt.Text) / 1024)
  UA() = Split(Document(dnum).rt.Text, " ")
  With frmProperties
    .lblChar = "Characters: " & Len(Document(dnum).rt.Text)
    .lblLine = "Total Lines: " & Document(dnum).rt.LineCount
    .lblWord = "Word Count: " & UBound(UA) + 1
    If Left(Document(dnum).Caption, 12) = "New Document" Then
      .lblFile = "File Name: " & "New Document"
    Else
      .lblFile = "File Name: " & Document(dnum).Caption
    End If
    .lblSizeK = "File Size(K): " & kB & " KBytes"
    .lblSizeB = "File Size(B): " & Len(Document(dnum).rt.Text) & " Bytes"
    .lblData(0).Caption = Document(dnum).Caption
    .Show vbModal, frmMain
  End With
  Erase UA
End Sub



Private Sub readme_Click()
  On Error Resume Next
  DoOpen App.path & "\Readme.txt"
End Sub

Private Sub redo_Click()
  On Error Resume Next
  Document(dnum).rt.redo
End Sub


Private Sub save_Click()
  On Error Resume Next
  If Document(dnum).FTP = True And FState(dnum).Deleted = False Then
    frmUpload.cboAccount.Text = Document(dnum).FTPAccount
    frmUpload.cboAccount.Enabled = False
    DoEvents
    frmUpload.Show
    frmUpload.Refresh
    frmUpload.PutFile Document(dnum).FileName, Document(dnum).rt.Text, Document(dnum).ftpDir
    Document(dnum).Changed = False
    Document(dnum).FTP = True
    Document(dnum).ftpDir = CurDir
    Document(dnum).DoAct
    
    Unload frmUpload
  Else
    doSave
  End If
End Sub

Private Sub save2_Click()
  On Error Resume Next
  If Document(dnum).FTP = True Then
      frmUpload.Show , frmMain
  Else
    doSave
  End If
End Sub

Private Sub saveall_Click()
  On Error Resume Next
  Dim x As Integer, Y As Integer
  Y = dnum
  For x = 1 To UBound(Document)
    Document(x).SetFocus
    doSave
  Next
  Document(Y).SetFocus
End Sub

Private Sub saveas_Click()
  On Error Resume Next
  doSaveAs
  
End Sub

Private Sub saveas2_Click()
  On Error Resume Next
  doSaveAs
End Sub

Private Sub saveto_Click()
  On Error Resume Next
  frmFTP.Caption = "Save Document"
  frmFTP.cmdOpen.Caption = "&Save"
  frmFTP.SaveString = ActiveForm.rt.Text
  frmFTP.Show
End Sub

Private Sub selectall_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdSelectAll
End Sub

Private Sub selectline_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdSelectLine
End Sub


Private Sub statusbar2_Click()
  statusbar2.Checked = Not statusbar2.Checked
  picBottom.Visible = statusbar2.Checked
End Sub



Private Sub tb_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
  On Error Resume Next
  Dim dnum As String
  dnum = (Mid(tb.SelectedItem.Key, 4))
  Document(dnum).SetFocus
End Sub

Private Sub tb_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
  On Error Resume Next
  Dim dnum As String
  dnum = (Mid(tb.SelectedItem.Key, 4))
  Document(dnum).SetFocus
  If Button = vbRightButton Then
    Button = vbLeftButton
    PopupMenu tabmenu
  End If
End Sub

Private Sub tBar_ButtonClick(ByVal Button As MSComctlLib.Button)
  On Error Resume Next
  Dim quicktag As String
  Select Case Button.Key
    Case "new"
      doNew ""
    Case "close"
      Unload Document(dnum)
    Case "prop"
      frmDoc.rt.ExecuteCmd cmCmdProperties
      WriteOptions
    Case "reload"
      If Document(dnum).IsFile = False Then Exit Sub
      Document(dnum).rt.OpenFile Document(dnum).Caption
    Case "find"
      Document(dnum).rt.ExecuteCmd cmCmdFind
    Case "findnext"
      Document(dnum).rt.ExecuteCmd cmCmdFindNext
    Case "findprev"
      Document(dnum).rt.ExecuteCmd cmCmdFindPrev
    Case "undo"
      Document(dnum).rt.undo
      SetDo
    Case "saveas"
      saveas_Click
    Case "saveall"
      saveall_Click
    Case "redo"
      Document(dnum).rt.redo
      SetDo
    Case "tilever"
      Me.Arrange vbTileVertical
    Case "tilehor"
      Me.Arrange vbTileHorizontal
    Case "cascade"
      Me.Arrange vbCascade
    Case "cut"
      Document(dnum).rt.cut
    Case "paste"
      Document(dnum).rt.paste
    Case "copy"
      Document(dnum).rt.copy
    Case "delete"
      Document(dnum).rt.ExecuteCmd cmCmdDelete
    Case "open"
      open_Click
    Case "print"
      Call Document(dnum).rt.PrintContents(0, cmPrnColor + cmPrnDefaultPrn + cmPrnRichFonts)
    Case "save"
      doSave
    Case "tabl"
      Document(dnum).rt.ExecuteCmd cmCmdIndentSelection
    Case "tabr"
      Document(dnum).rt.ExecuteCmd cmCmdUnindentSelection
    Case "cblock"
      Document(dnum).CommentBlock
    Case "ublock"
      Document(dnum).UncommentBlock
    Case "tbmark"
      Document(dnum).rt.ExecuteCmd cmCmdBookmarkToggle
    Case "nbmark"
      Document(dnum).rt.ExecuteCmd cmCmdBookmarkNext
    Case "pbmark"
      Document(dnum).rt.ExecuteCmd cmCmdBookmarkPrev
    Case "cbmark"
      Document(dnum).rt.ExecuteCmd cmCmdBookmarkClearAll
    Case "pline"
      Document(dnum).PrevLine
    Case "nline"
      Document(dnum).NextLine
    Case "ctag"
      quicktag = InputStr("Enter the HTML tag to insert", "Quick Tag", "<>", 1)
      If quicktag <> "" Then InsertString Document(dnum).rt, quicktag
    Case "help"
      HHShowContents Me.hwnd
  End Select
End Sub

Private Sub tbMacro_ButtonClick(ByVal Button As MSComctlLib.Button)
  On Error Resume Next
  Select Case LCase(Button.Key)
    Case "mac1"
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro1
    Case "mac2"
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro2
    Case "mac3"
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro3
    Case "mac4"
      Document(dnum).rt.ExecuteCmd cmCmdPl