mfrmprogram.frm

非常有用得编辑器软件源码

    cpBack.MakeMeFlat
    FlatControls Me
    Flatten Me
    FileTab.Tabs.Clear
    SetIconMenu Me, Me.imlMenu, PM
    SetMenuBackground
    
For i = 1 To 7
    cobSize.AddItem i
Next

DisplayFormats

End Sub

Private Sub DisplayFormats()
'Dim fmt As DEGetBlockFmtNamesParam
'    Set f = CreateObject("DEGetBlockFmtNamesParam.DEGetBlockFmtNamesParam")
'    On Error Resume Next
'    DHTMLEdit1.execCommand DECMD_GETBLOCKFMTNAMES, , f
'    For Each fmtName In f.Names
'       cobFormat.AddItem fmtName
'    Next
    
        Dim fmt As DEGetBlockFmtNamesParam
        Dim i As Long
        Dim fmtName As Variant
        
        ' Create the block fmt names holder
        Set fmt = CreateObject("DEGetBlockFmtNamesParam.DEGetBlockFmtNamesParam.1")
        
        ' Get the localized strings for the DECMD_SETBLOCKFMT command
        DE1.ExecCommand DECMD_GETBLOCKFMTNAMES, OLECMDEXECOPT_DONTPROMPTUSER, fmt
        
        ' Put the strings into the Format menu
        i = 0
        For Each fmtName In fmt.Names
        cobFormat.AddItem fmtName
'            FormatSub(i).Caption = fmtName
'            i = i + 1
        Next
End Sub

Sub SetMenuBackground()
    Dim i As Integer
    i = GetOption("MenuStyle", 2)
    
    If i = 0 Then
        On Error Resume Next
        Dim s As String
        s = GetOption("MenuBackground")
        Set PM.BackgroundPicture = LoadPicture(s)
    Else
        Set PM.BackgroundPicture = imlMenuBack.ListImages(i).Picture
    End If
    
    With PM
        .ForeColor = GetOption("mnuFore", &H0&)
        .BorderColor = GetOption("mnuBorder", &H800000)
        .HighlightColor = GetOption("mnuHighlight", &HFFC0C0)
        .HighlightForeColor = GetOption("mnuHighFore", &H0&)
    End With
    
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

'TerminateProcess -1, 4

'Unload all forms
Dim f As Form
For Each f In Forms
    On Error Resume Next
    f.Job = "kill"
    Unload f
Next

End Sub

Private Sub mnuAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub mnuISTimage_Click()
    Dim i As Integer
    Dim B As Boolean
    B = CStatus(CInt(ActiveForm.Tag)).Saved
    
With frmInsertElement
    .SavedMode = IIf(B = True, "true", "false")
    If B = True Then .FilePath = CStatus(CInt(ActiveForm.Tag)).OriginalFilename
    .IsCreator = True
    Set .TheDOM = ActiveForm.DHTML1.DOM
    
    If LCase(ActiveForm.DHTML1.DOM.selection.Type) = "text" Then
    .InsertMode = "true"
    Else
    .InsertMode = "false"
    End If
    
    .ElementMode = "image"
    
    .SSTab1.TabEnabled(0) = True
    .SSTab1.Tab = 0
    For i = 1 To 3
        .SSTab1.TabEnabled(i) = False
    Next
    
    .Show vbModal, Me
End With
End Sub

Private Sub mnuISTlink_Click()
    Dim i As Integer
    Dim B As Boolean
    B = CStatus(CInt(ActiveForm.Tag)).Saved
    
With frmInsertElement
    .SavedMode = IIf(B = True, "true", "false")
    If B = True Then .FilePath = CStatus(CInt(ActiveForm.Tag)).OriginalFilename
    .IsCreator = True
    Set .TheDOM = ActiveForm.DHTML1.DOM
    .InsertMode = "true"
    .ElementMode = "hyperlink"
    
    For i = 0 To 3
        .SSTab1.TabEnabled(i) = False
    Next
    
    .SSTab1.TabEnabled(1) = True
    .SSTab1.Tab = 1
    
    .Show vbModal, Me
End With
End Sub

Private Sub mnuISTtarget_Click()
    Dim i As Integer
    Dim B As Boolean
    B = CStatus(CInt(ActiveForm.Tag)).Saved
    
With frmInsertElement
    .SavedMode = IIf(B = True, "true", "false")
    If B = True Then .FilePath = CStatus(CInt(ActiveForm.Tag)).OriginalFilename
    .IsCreator = True
    Set .TheDOM = ActiveForm.DHTML1.DOM
    .InsertMode = "true"
    .ElementMode = "target"
    

    For i = 0 To 3
        .SSTab1.TabEnabled(i) = False
    Next
    
    .SSTab1.TabEnabled(2) = True
    .SSTab1.Tab = 2
    
    .Show vbModal, Me
End With
End Sub

Private Sub mnuISTvideo_Click()
    Dim i As Integer
    Dim B As Boolean
    B = CStatus(CInt(ActiveForm.Tag)).Saved
    
With frmInsertElement
    .SavedMode = IIf(B = True, "true", "false")
    If B = True Then .FilePath = CStatus(CInt(ActiveForm.Tag)).OriginalFilename
    .IsCreator = True
    Set .TheDOM = ActiveForm.DHTML1.DOM
    .InsertMode = "true"
    .ElementMode = "video"
    
    .SSTab1.TabEnabled(3) = True
    .SSTab1.Tab = 3
    For i = 0 To 2
        .SSTab1.TabEnabled(i) = False
    Next
    
    .Show vbModal, Me
End With
End Sub

Private Sub mnuNew_Click()
mnuNew.Enabled = False
    DoEvents
        NewBlankPage
    DoEvents
mnuNew.Enabled = True
End Sub

Private Sub mnuOpen_Click()

mnuOpen = False
With Cd1
    .Flags = cdlOFNFileMustExist
    .Filter = "HTML Files *.htm,*.html|*.htm;*.html"
    On Error GoTo 1
    .ShowOpen
    OpenFile Cd1.Filename
End With

mnuOpen = True
Exit Sub
1
mnuOpen = True
End Sub

Private Sub mnuSave_Click()

Dim B As Long

If CStatus(CInt(ActiveForm.Tag)).OpenFromROM = True Then
    B = SaveFile(ActiveForm, Cd1, CStatus(CInt(ActiveForm.Tag)), True)
    If B <> 0 And B <> cdlCancel Then MsgBox Error(B), vbCritical, "File saving error: " & B
    
Else
    B = SaveFile(ActiveForm, Cd1, CStatus(CInt(ActiveForm.Tag)), False)
    If B <> 0 And B <> cdlCancel Then MsgBox Error(B), vbCritical, "File saving error: " & B
    
End If

End Sub

Private Sub mnuSaveAs_Click()
Dim B As Integer
    B = SaveFile(ActiveForm, Cd1, CStatus(CInt(ActiveForm.Tag)), True)
    If B <> 0 And B <> cdlCancel Then MsgBox Error(B), vbCritical, "File saving error: " & B
End Sub

Private Sub mnuStart_Click()
SaveOption "startup", "true"
frmStart.Show vbModal
End Sub

Private Sub mnuView_ProjectMan_Click()
frmProjectManager.Show
End Sub

Private Sub mnuView_style_Click(Index As Integer)
SaveOption "MenuStyle", Index
Set PM.BackgroundPicture = imlMenuBack.ListImages(Index).Picture
End Sub

Private Sub mnuView_Toolbox_Click()
mnuView_Toolbox.Checked = Not mnuView_Toolbox.Checked

frmToolBox.Visible = mnuView_Toolbox.Checked

SaveOption "showtoolbox", mnuView_Toolbox.Checked

If frmToolBox.Visible = True Then
    MfrmProgram.SetFocus
    ToolBoxTab True, frmToolBox.SSTab1
End If
End Sub

Private Sub picFileTab_Resize()
FileTab.Move 0, 0, picFileTab.ScaleWidth, picFileTab.ScaleHeight
End Sub

Private Sub STimer_ThatTime()
If FileTab.Tabs.Count = 0 Then
    LoadCreatorOption False
Else
    LoadCreatorOption True
End If
End Sub

Private Sub tbrEdit_ButtonClick(ByVal Button As MSComctlLib.Button)

On Error Resume Next
With ActiveForm.DHTML1

    Select Case Button.Key
        
        Case "bold"
            .ExecCommand DECMD_BOLD
        Case "italic"
            .ExecCommand DECMD_ITALIC
        Case "underline"
            .ExecCommand DECMD_UNDERLINE
        Case "left"
            .ExecCommand DECMD_JUSTIFYLEFT
        Case "center"
            .ExecCommand DECMD_JUSTIFYCENTER
        Case "right"
            .ExecCommand DECMD_JUSTIFYRIGHT
        Case "number"
            .ExecCommand DECMD_ORDERLIST
        Case "bullet"
            .ExecCommand DECMD_UNORDERLIST
        Case "outdent"
            .ExecCommand DECMD_OUTDENT
        Case "indent"
            .ExecCommand DECMD_INDENT
    End Select

End With

tbrEdit.Refresh

End Sub

Private Sub tbrGeneral_ButtonClick(ByVal Button As MSComctlLib.Button)

Select Case LCase(Button.Key)
    
    Case "new"
        If mnuNew = True Then mnuNew_Click
    Case "open"
        If mnuOpen = True Then mnuOpen_Click
    Case "save"
        If mnuSave = True Then mnuSave_Click
    Case "saveas"
        If mnuSaveAs = True Then mnuSaveAs_Click
    Case "startman"
        If mnuStart = True Then mnuStart_Click

End Select

End Sub

Public Sub LoadCreatorOption(CreatorExist As Boolean)
If CreatorExist = True Then
    tbrEdit.Enabled = True
    mnuSave = True
    mnuSaveAs = True
    mnuEdit_Top = True
    mnuInsert = True
    mnuFormat = True
    mnuTools = True
    mnuTable = True
    
    If GetOption("showtoolbox", True) = True Then
        frmToolBox.Code1.Enabled = True
        frmToolBox.cmdApply.Enabled = True
    End If
    
Else
    tbrEdit.Enabled = False
    mnuSave = False
    mnuSaveAs = False
    mnuEdit_Top = False
    mnuInsert = False
    mnuFormat = False
    mnuTools = False
    mnuTable = False
    
    If GetOption("showtoolbox", True) = True Then
        frmToolBox.Code1.Text = ""
        frmToolBox.Code1.Enabled = False
        frmToolBox.cmdApply.Enabled = False
    End If
    
    End If
End Sub