frmmain.frm

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

      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/06/19
'描  述：完整版本的超强文件编辑器
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
Option Explicit

Private Sub about_Click()
  On Error Resume Next
  frmAbout.Show vbModal, frmMain
End Sub

Private Sub acksoftsite_Click()
  On Error Resume Next
  ShowSite "http://cedit.sourceforge.net"
End Sub

Private Sub arrangeicons_Click()
  On Error Resume Next
  Me.Arrange vbArrangeIcons
End Sub

Private Sub cascade_Click()
  On Error Resume Next
  Me.Arrange vbCascade
End Sub

Private Sub close_Click()
  On Error Resume Next
  'Document(dnum).Visible = False
  Unload Document(dnum)
End Sub

Private Sub close2_Click()
  On Error Resume Next
  Unload Document(dnum)
End Sub

Private Sub closeall_Click()
  On Error Resume Next
  CloseAllDoc
End Sub
Private Sub CloseAllDoc()
  On Error Resume Next
  LockWindowUpdate Me.hwnd
  Dim x As Integer
  For x = 1 To UBound(Document)
    'Document(X).Visible = False
    Unload Document(x)
    
    If StopClose = True Then Exit For
  Next
  LockWindowUpdate 0
End Sub

Private Sub copy_Click()
  On Error Resume Next
  Document(dnum).rt.copy
End Sub

Private Sub countall_Click()
  On Error Resume Next
  Dim ua2() As String, us As Integer, ut As Integer
  ua2 = Split(Document(dnum).rt.Text, " ")
  us = Len(Document(dnum).rt.Text)
  ut = Document(dnum).rt.LineCount
  MsgBox "Words: " & UBound(ua2) + 1 & Chr(10) & "Characters:" & us & Chr(10) & "Lines: " & ut, vbOKOnly + vbInformation, "Count All"
  Erase ua2
End Sub

Private Sub cut_Click()
  On Error Resume Next
  Document(dnum).rt.cut
End Sub

Private Sub datetime_Click()
  On Error Resume Next
  Dim timedate As String
  timedate = Date & "/" & Time
  InsertString Document(dnum).rt, timedate
End Sub

Private Sub delete_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdDelete
End Sub


Private Sub editor_Click()
  On Error Resume Next
  frmDoc.rt.ExecuteCmd cmCmdProperties
  WriteOptions
End Sub

Private Sub exit_Click()
  On Error Resume Next
  Unload Me
  Unload frmDoc
  Unload frmAbout
  End
End Sub



Private Sub fDock_FormHide(ByVal DockedForm As TabDock.TDockForm)
  On Error Resume Next
  Select Case DockedForm.Key
    Case "frmNav"
      quicknav.Checked = False
    Case "frmOutput"
      MDebugOutput.Checked = False
  End Select
End Sub

Private Sub fDock_FormShow(ByVal DockedForm As TabDock.TDockForm)
  On Error Resume Next
  Select Case DockedForm.Key
    Case "frmNav"
      quicknav.Checked = True
    Case "frmOutput"
      MDebugOutput.Checked = True
  End Select
End Sub

Private Sub fileassoc_Click()
  On Error Resume Next
  frmNew.Show vbModal, Me
End Sub

Private Sub find_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdFind
End Sub

Private Sub findnext_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdFindNext
End Sub

Private Sub findprev_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdFindPrev
End Sub

Private Sub genhelp_Click()
  On Error Resume Next
  HHShowContents Me.hwnd
End Sub

Private Sub goto_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdGotoLine, -1
End Sub

Private Sub hlline_Click()
  On Error Resume Next
  Dim x As Integer
  If hlline.Checked = False Then
    hlline.Checked = True
    HighLight = True
    For x = 1 To UBound(Document)
      Set Document(x).r = Document(x).rt.GetSel(True)
      Document(x).rt.HighlightedLine = Document(x).r.EndColNo
    Next
  Else
    hlline.Checked = False
    HighLight = False
    For x = 1 To UBound(Document)
      Document(x).rt.HighlightedLine = -1
    Next
  End If
  WriteInput
End Sub

Private Sub inbrowser_Click()
  On Error Resume Next
  ShowSite "about:" & Document(dnum).rt.Text
End Sub

Private Sub mac_Click(Index As Integer)
  On Error Resume Next
  Select Case Index
    Case 1
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro1
    Case 2
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro2
    Case 3
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro3
    Case 4
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro4
    Case 5
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro5
    Case 6
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro6
    Case 7
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro7
    Case 8
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro8
    Case 9
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro9
    Case 10
      Document(dnum).rt.ExecuteCmd cmCmdPlayMacro10
  End Select
End Sub

Private Sub MDIForm_Load()
'  On Error Resume Next
  LockWindowUpdate Me.hwnd
  xpMenu.SubClassMenu Me
  xpMenu.ImageList = img
  SetupXPMenu
    
  Set xpMenu.BackgroundPicture = Picture1.Picture
  Me.Visible = False
  cbMain.Bands(1).Width = 7600
  cbMain.Bands(3).Width = 4125
  FlatBorder picBottom.hwnd
  'FlatBorder tb.hwnd
  LoadEditor

  fDock.Show
  ActiveForm.rt.SetFocus
  Me.Visible = True
  LockWindowUpdate 0
End Sub
Private Sub SetupXPMenu()
  xpMenu.ItemIcon("new") = 0
  xpMenu.ItemIcon("open") = 1
  xpMenu.ItemIcon("close") = 2
  xpMenu.ItemIcon("save") = 3
  xpMenu.ItemIcon("saveas") = 44
  xpMenu.ItemIcon("saveall") = 43
  xpMenu.ItemIcon("prints") = 4
  xpMenu.ItemIcon("undo") = 6
  xpMenu.ItemIcon("redo") = 7
  xpMenu.ItemIcon("cut") = 8
  xpMenu.ItemIcon("copy") = 9
  xpMenu.ItemIcon("paste") = 10
  xpMenu.ItemIcon("delete") = 11
  xpMenu.ItemIcon("mnuComment") = 18
  xpMenu.ItemIcon("mnuUncomment") = 19
  xpMenu.ItemIcon("find") = 13
  xpMenu.ItemIcon("findnext") = 14
  xpMenu.ItemIcon("findprev") = 15
  xpMenu.ItemIcon("mnuToggle") = 20
  xpMenu.ItemIcon("mnuNext") = 21
  xpMenu.ItemIcon("mnuPrev") = 22
  xpMenu.ItemIcon("mnuClear") = 23
  xpMenu.ItemIcon("mnuNLine") = 24
  xpMenu.ItemIcon("mnuLPrev") = 25
  xpMenu.ItemIcon("editor") = 12
  xpMenu.ItemIcon("mac(1)") = 32
  xpMenu.ItemIcon("mac(2)") = 33
  xpMenu.ItemIcon("mac(3)") = 34
  xpMenu.ItemIcon("mac(4)") = 35
  xpMenu.ItemIcon("mac(5)") = 36
  xpMenu.ItemIcon("mac(6)") = 37
  xpMenu.ItemIcon("mac(7)") = 38
  xpMenu.ItemIcon("mac(8)") = 39
  xpMenu.ItemIcon("mac(9)") = 40
  xpMenu.ItemIcon("mac(10)") = 41
  xpMenu.ItemIcon("mnuCreate") = 42
  xpMenu.ItemIcon("tilehor") = 27
  xpMenu.ItemIcon("tilever") = 28
  xpMenu.ItemIcon("cascade") = 29
  xpMenu.ItemIcon("genhelp") = 30
End Sub
Private Sub MDIForm_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)
  On Error Resume Next
    Dim OLEFilename As String
    Dim i As Integer
    
    For i = 1 To Data.Files.Count
        If Data.GetFormat(vbCFFiles) Then
            OLEFilename = Data.Files(i)
        End If
        On Error GoTo errexit
        DoOpen OLEFilename
    Next i
errexit:
    Exit Sub
End Sub

Private Sub MDIForm_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single, State As Integer)
  On Error Resume Next
    If Not Data.GetFormat(vbCFFiles) Then Effect = vbDropEffectNone
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  If dnum = 0 Then Exit Sub
  CloseAllDoc
  If StopClose = True Then
    StopClose = False
    Cancel = 1
  End If
End Sub

Private Sub MDIForm_Resize()
  On Error Resume Next
  tb.Left = 0
  tb.Width = picBottom.ScaleWidth
  stBar.Panels(1).Width = (Me.Width - stBar.Panels(2).Width - stBar.Panels(3).Width - stBar.Panels(4).Width - 450)
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
  On Error Resume Next
  LockWindowUpdate Me.hwnd
  Dim x As Integer
  For x = 0 To 9
    SaveMacros App.path & "\macros\" & x & ".dem", x
  Next
  WriteData
  WriteInput
  
  'UnloadAll
  LockWindowUpdate 0
End Sub

Private Sub mnuBuildConfig_Click()
  On Error Resume Next
  frmBuild.Show vbModal, Me
End Sub

Private Sub mnucEdit_Click()
  ShowSite "http://www.sourceforge.net/projects/cedit"
End Sub

Private Sub mnuClear_Click()
  On Error Resume Next
  Document(dnum).rt.ExecuteCmd cmCmdBookmarkClearAll
End Sub

Private Sub mnuComment_Click()
  On Error Resume Next
  Document(dnum).CommentBlock
End Sub

Private Sub mnuCompile_Click()
  On Error Resume Next
  Dim CaptureOut As String
  Dim s As String
  Dim lang As String, Exe As String, Comp As String, Variables As String
  Dim RunComp As String, InForOut As String, file As String, FileToCompile As String
  Dim Found As Boolean, VarRead As String
  'Dim dnum As Integer, Found As Boolean, VarRead As String, FileToCompile As String
  s = Dir(App.path & "\compile\")
  Found = False
  Do While s <> ""
    If Right(s, 3) = "cmp" Then
      file = App.path & "\compile\" & s
      lang = ReadINI("Compile", "Language", file)
      Exe = ReadINI("Compile", "Extension", file)
      If LCase(lang) = LCase(Document(dnum).rt.Language) <> 0 Or GetExtension(Document(dnum).Caption) = LCase(Exe) Then
        Found = True
        Exit Do
      End If
    End If
    s = Dir
  Loop
  If Found = False Then
    MsgBox "No compiler found for this file type or language.", vbOKOnly + vbCritical, "Build"
    Exit Sub
  End If
  If Document(dnum).FTP = True Then
    Document(dnum).rt.SaveFile App.path & "\data\tmp." & GetExtension(Document(dnum).FileName), False
    FileToCompile = App.path & "\data\tmp." & GetExtension(Document(dnum).FileName)
  ElseIf Document(dnum).FTP = False And Document(dnum).FileName <> "" Then
    doSave
    FileToCompile = Document(dnum).FileName
    'Document(dnum).rt.SaveFile Document(dnum).filename, False
  Else
    FileToCompile = App.path & "\data\tmp." & Exe
    Document(dnum).rt.SaveFile App.path & "\data\tmp." & Exe, False
  End If
  Comp = ReadINI("Compile", "Compile", file)
  Variables = ReadINI("Compile", "Variables", file)
  RunComp = ReadINI("Compile", "RunWhenComplete", file)
  InForOut = ReadINI("Compile", "InputForOutput", file)
  Variables = Replace(Variables, "%s", StrWrap(FileToCompile))
  CaptureOut = ReadINI("Compile", "CaptureOutput", file)
  If InForOut = "on" Then
    VarRead = InputStr("Enter the filename you would like this outputed to. (IE: hello.exe)", "Write Name")
    Variables = Replace(Variables, "%e", VarRead)
  End If