frmmain.frm

VB写的一个IDE开发环境,支持脚本运行,内置了一个简单的编译器,可以直接生成EXE.. 推荐下载!

Public Sub 菜单()
Dim i

    For i = 1 To 12: Load 文件(i): Next i
    For i = 1 To 8: Load 编辑(i): Next i
    For i = 1 To 2: Load 搜索(i): Next i
    'For i = 1 To 10: Load 设置(i): Next i
    For i = 1 To 5: Load 编译(i): Next i
    For i = 1 To 3: Load 其他(i): Next i
    For i = 1 To 2: Load 帮助(i): Next i
    
    文件(0).Caption = "新建..."
    文件(1).Caption = "打开..."
    文件(2).Caption = "-"
    文件(3).Caption = "添加..."
    文件(4).Caption = "移除..."
    文件(5).Caption = "-"
    文件(6).Caption = "保存..."
    文件(7).Caption = "另存为..."
    文件(8).Caption = "-"
    文件(9).Caption = "打印..."
    文件(10).Caption = "打印设置..."
    文件(11).Caption = "-"
    文件(12).Caption = "退出"
    
    编辑(0).Caption = "撤消"
    编辑(1).Caption = "重做"
    编辑(2).Caption = "-"
    编辑(3).Caption = "剪切"
    编辑(4).Caption = "复制"
    编辑(5).Caption = "粘贴"
    编辑(6).Caption = "删除"
    编辑(7).Caption = "-"
    编辑(8).Caption = "全选"
    
    搜索(0).Caption = "查找"
    搜索(1).Caption = "查找下一个"
    搜索(2).Caption = "替换"
    
    '设置(0).Caption = "设置"
    
    编译(0).Caption = "连接 && 运行"
    编译(1).Caption = "编译成可执行文件"
    编译(2).Caption = "-"
    编译(3).Caption = "VBS脚本执行"
    编译(4).Caption = "JS脚本执行"
    编译(5).Caption = "Bat脚本执行"
    
    其他(0).Caption = "层叠"
    其他(1).Caption = "横向平铺"
    其他(2).Caption = "纵向平铺"
    其他(3).Caption = "排列图标"
    
    帮助(0).Caption = "内容"
    帮助(1).Caption = "-"
    帮助(2).Caption = "关于"
    
Dim Tmp
    Tmp = ReadINI(App.Path & "\Tools.Ini", "工具", "数量", Tmp)
    If Tmp = "" Then Exit Sub
    For i = 1 To Tmp
        Tmp = ReadINI(App.Path & "\Tools.Ini", "工具", "工具" & i, "")
        If Tmp <> "" Then
            Load 工具(i)
            工具(i).Caption = Tmp
            工具(i).Tag = i
        End If
    Next i
End Sub

Private Sub 帮助_Click(Index As Integer)
On Error Resume Next
    Select Case 帮助(Index).Caption
        Case "内容": frmAbout.Show
        Case "关于": MsgBox "IDE 集成开发环境 -- by a2si", vbOKOnly, App.Title
    End Select
End Sub

Private Sub 工具_Click(Index As Integer)
On Error Resume Next
Dim Tmp
    Tmp = ReadINI(App.Path & "\Tools.Ini", "工具", 工具(Index).Caption, Tmp)
    If Tmp <> "" Then
        Shell Tmp, 1
    ElseIf Index = 0 Then
    
    Else
        If MsgBox("没有找到工具，删除吗？", vbYesNo, App.Title) = vbYes Then
            Tmp = ReadINI(App.Path & "\Tools.Ini", "工具", "数量", Tmp)
            WriteINI App.Path & "\Tools.Ini", "工具", "数量", Tmp - 1
            WriteINI App.Path & "\Tools.Ini", "工具", "工具" & 工具(Index).Tag, ""
        End If
    End If
End Sub

Private Sub 其他_Click(Index As Integer)
On Error Resume Next
    Select Case 其他(Index).Caption
        Case "层叠": Me.Arrange vbCascade
        Case "横向平铺": Me.Arrange vbTileHorizontal
        Case "纵向平铺": Me.Arrange vbTileVertical
        Case "排列图标": Me.Arrange vbArrangeIcons
        
    End Select
End Sub

Private Sub 编译_Click(Index As Integer)
On Error Resume Next
    Select Case 编译(Index).Caption
        Case "连接 && 运行": Link
        Case "编译成可执行文件": Make
        Case "VBS脚本执行": Script "VBScript"
        Case "JS脚本执行": Script "JScript"
        Case "Bat脚本执行": BatRun
    End Select
End Sub
Public Sub Script(ScrtiptL As String)
Dim objTest As Object
    ActiveForm.Text1.Text = ActiveForm.rtfText.Text
    Set objTest = CreateObject("MSScriptControl.ScriptControl.1")
    objTest.Language = ScrtiptL
    objTest.AddCode ActiveForm.Text1.Text
    Set objTest = Nothing
End Sub
Public Sub BatRun()
    ActiveForm.Text1.Text = ActiveForm.rtfText.Text
    Open App.Path & "\Tmp.bat" For Output As #1
        Print #1, ActiveForm.Text1.Text
        Print #1, "@Del %0"
    Close #1
    Shell "cmd /k " & App.Path & "\Tmp.Bat", 1
End Sub

Private Sub 设置_Click(Index As Integer)
On Error Resume Next
    Select Case 设置(Index).Caption
        Case "设置": frmSettings.Show
    End Select
End Sub

Private Sub 搜索_Click(Index As Integer)
On Error Resume Next
    Select Case 搜索(Index).Caption
        Case "查找": 查找
        Case "查找下一个": 查找下一个
        Case "替换": 替换
    End Select
End Sub
Public Sub 查找()
    'ActiveForm.Find "Test"
    'ActiveForm.rtfText.SelStart = 3
    'ActiveForm.rtfText.SelLength = 5
    Find ActiveForm.rtfText, "Test"
End Sub
Public Sub 查找下一个()
    'ActiveForm.Find "Test"
    'ActiveForm.rtfText.SelStart = 3
    'ActiveForm.rtfText.SelLength = 5
    Find ActiveForm.rtfText, "Test"
End Sub
Public Sub 替换()
    frmSFR.功能 "替换"
End Sub

Private Sub 编辑_Click(Index As Integer)
On Error Resume Next
    Select Case 编辑(Index).Caption
        Case "撤消": ActiveForm.Undo
        Case "重做": ActiveForm.Undo
        Case "剪切": ActiveForm.Cut
        Case "复制": ActiveForm.CopyM
        Case "粘贴": ActiveForm.Paste
        Case "删除": ActiveForm.Delete
        Case "全选": ActiveForm.SelAll
    End Select
End Sub

Private Sub 文件_Click(Index As Integer)
On Error Resume Next
    Select Case 文件(Index).Caption
        Case "新建...": 新建
        Case "打开...": 打开
        Case "添加...": 新建
        Case "移除...": Unload ActiveForm
        Case "保存...": 保存
        Case "另存为...": 另存为
        Case "打印...": 打印
        Case "打印设置...": 打印设置
        Case "退出": 程序退出
    End Select
End Sub
Private Sub 新建()
Static lDocumentCount As Long
Dim frmD As frmDoc
    lDocumentCount = lDocumentCount + 1
    Set frmD = New frmDoc
    frmD.Caption = "新建文件 " & lDocumentCount
    frmD.Show
End Sub
Public Sub 打开()
Dim sFile As String
    If ActiveForm Is Nothing Then 新建
    With CDg
        .DialogTitle = "打开"
        .CancelError = False
        .Filter = "所有文件 (*.*)|*.*"
        .ShowOpen
        If Len(.Filename) = 0 Then
            Exit Sub
        End If
        sFile = .Filename
    End With
    ActiveForm.rtfText.LoadFile sFile
    ActiveForm.Caption = sFile
End Sub
Public Sub 保存()
Dim sFile As String
    If Left$(ActiveForm.Caption, 2) = "新建" Then
        With CDg
            .DialogTitle = "保存"
            .CancelError = False
            .Filter = "所有文件 (*.*)|*.*"
            .ShowSave
            If Len(.Filename) = 0 Then
                Exit Sub
            End If
            sFile = .Filename
        End With
        ActiveForm.rtfText.SaveFile sFile
    Else
        sFile = ActiveForm.Caption
        ActiveForm.rtfText.SaveFile sFile
    End If
End Sub
Public Sub 另存为()
Dim sFile As String
    If ActiveForm Is Nothing Then Exit Sub
    With CDg
        .DialogTitle = "另存为"
        .CancelError = False
        .Filter = "所有文件 (*.*)|*.*"
        .ShowSave
        If Len(.Filename) = 0 Then
            Exit Sub
        End If
        sFile = .Filename
    End With
    ActiveForm.Caption = sFile
    ActiveForm.rtfText.SaveFile sFile
End Sub
Public Sub 打印设置()
On Error Resume Next
    With CDg
        .DialogTitle = "页面设置"
        .CancelError = True
        .ShowPrinter
    End With
End Sub
Public Sub 打印()
On Error Resume Next
    If ActiveForm Is Nothing Then Exit Sub
    With CDg
        .DialogTitle = "Print"
        .CancelError = True
        .flags = cdlPDReturnDC + cdlPDNoPageNums
        If ActiveForm.rtfText.SelLength = 0 Then
            .flags = .flags + cdlPDAllPages
        Else
            .flags = .flags + cdlPDSelection
        End If
        .ShowPrinter
        If Err <> MSComDlg.cdlCancel Then
            ActiveForm.rtfText.SelPrint .hdc
        End If
    End With
End Sub

Private Sub Picture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    shpMenu.Visible = False
End Sub
Public Sub Meun_Label_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    shpMenu.BackColor = &H3B175
End Sub
Public Sub Meun_Label_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If shpMenu.Visible = False Then
        shpMenu.Top = Meun_Label(Index).Top - 30
        shpMenu.Left = Meun_Label(Index).Left - 30
        shpMenu.Width = Meun_Label(Index).Width + 60
        shpMenu.Height = Meun_Label(Index).Height + 60
        shpMenu.Visible = True
    ElseIf LastMnuIndex <> Index Then
        shpMenu.Visible = False
    End If
    LastMnuIndex = Index
End Sub
Public Sub Meun_Label_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not Button = 1 Then If LastMnuOpenIndex = Index Then LastMnuOpenIndex = -1: GoTo NoMnuPop
    shpMenu.BackColor = &HBF7D35: Meun_Label(Index).ForeColor = vbWhite
    LastMnuOpenIndex = Index
    Select Case Meun_Label(Index).Caption
        Case "文件": PopupMenu 文件_File, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "编辑": PopupMenu 编辑_Edit, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "搜索": PopupMenu 搜索_Find, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "设置": PopupMenu 设置_Set, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "编译": PopupMenu 编译_Comp, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "其他": PopupMenu 其他_Other, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "工具": PopupMenu 工具_Tools, , shpMenu.Left, shpMenu.Top + shpMenu.Height
        Case "帮助": PopupMenu 帮助_help, , shpMenu.Left, shpMenu.Top + shpMenu.Height
    End Select
NoMnuPop:
    If LastMnuOpenIndex = -2 Then LastMnuOpenIndex = -1
    shpMenu.Visible = False
    shpMenu.BackColor = &HD5F2&
    Meun_Label(Index).ForeColor = vbBlack
End Sub