frmmain.frm

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

With MfrmProgram.tbrEdit 'Refresh the Edit Bar first
    
    EditBarCheck .Buttons("bold"), DECMD_BOLD
    EditBarCheck .Buttons("italic"), DECMD_ITALIC
    EditBarCheck .Buttons("underline"), DECMD_UNDERLINE
    EditBarCheck .Buttons("left"), DECMD_JUSTIFYLEFT
    EditBarCheck .Buttons("center"), DECMD_JUSTIFYCENTER
    EditBarCheck .Buttons("right"), DECMD_JUSTIFYRIGHT
    EditBarCheck .Buttons("number"), DECMD_ORDERLIST
    EditBarCheck .Buttons("bullet"), DECMD_UNORDERLIST
    EditBarCheck .Buttons("outdent"), DECMD_OUTDENT
    EditBarCheck .Buttons("indent"), DECMD_INDENT
    
End With
With MfrmProgram 'Refresh other element
    On Error Resume Next
    If .Font1.Text <> DHTML1.ExecCommand(DECMD_GETFONTNAME) Then .Font1.Text = DHTML1.ExecCommand(DECMD_GETFONTNAME)
    If .cpBack.Color <> HTML2RGB(DHTML1.ExecCommand(DECMD_GETBACKCOLOR)) Then .cpBack.Color = HTML2RGB(DHTML1.ExecCommand(DECMD_GETBACKCOLOR))
    If .cpFore.Color <> HTML2RGB(DHTML1.ExecCommand(DECMD_GETFORECOLOR)) Then .cpFore.Color = HTML2RGB(DHTML1.ExecCommand(DECMD_GETFORECOLOR))
    If .cobFormat.Text <> DHTML1.ExecCommand(DECMD_GETBLOCKFMT) Then .cobFormat.Text = DHTML1.ExecCommand(DECMD_GETBLOCKFMT)
    If .cobSize.Text <> DHTML1.ExecCommand(DECMD_GETFONTSIZE) Then .cobSize.Text = DHTML1.ExecCommand(DECMD_GETFONTSIZE)
End With

End Sub

Private Sub DHTML1_DocumentComplete()
If Me.Job = "gethtml" Then
    'Get document HTML
    CStatus(CIndex).HTMLString = DHTML1.DocumentHTML
    Me.Job = ""
End If
End Sub

Private Sub DHTML1_onclick()
    
    If GetOption("showtoolbox", True) = True Then
        Set frmToolBox.Element = GetActiveElement
    End If
    
End Sub

Private Sub DHTML1_onmousemove()
On Error Resume Next
Set e = DHTML1.DOM.parentWindow.event
x = e.clientX
y = e.clientY
End Sub

Private Sub DHTML1_ShowContextMenu(ByVal xPos As Long, ByVal yPos As Long)

PopupMenu MfrmProgram.mnuExt
End Sub

Public Sub Form_Activate()
'DoEvents
CheckAcc
On Error Resume Next
MfrmProgram.FileTab.Tabs("key" & CInt(Me.Tag)).Selected = True

    If GetOption("showtoolbox", True) = True Then
        Set frmToolBox.Element = Nothing
        frmToolBox.Code1.Text = ""
    End If
    
End Sub

Public Sub UpdateTabCaption()

On Error GoTo NextStep
MfrmProgram.FileTab.Tabs(CInt(Me.Tag)).Caption = Me.Caption
NextStep:

End Sub

Public Sub CheckAcc()

Select Case FStatus.OpenFromROM

    Case True
        
        MfrmProgram.mnuSave = False
        tbrQuick.Buttons("editcode").Enabled = False
    
    Case False
        
        MfrmProgram.mnuSave = True
        tbrQuick.Buttons("editcode").Enabled = True
        
End Select

End Sub

Private Sub Form_Load()
Me.Show
DoEvents
    With DHTML1
        .ShowDetails = GetOption("ShowDetails", False)
        tbrQuick.Buttons(6).Value = IIf(.ShowDetails = True, 1, 0)
        .SnapToGrid = GetOption("SnapToGrid", True)
        tbrQuick.Buttons(7).Value = IIf(.SnapToGrid = True, 1, 0)
    End With

    With Code1
        .SetColor cmClrLeftMargin, &H808080
        .SetColor cmClrLineNumberBk, &H808080
        .SetColor cmClrLineNumber, vbWhite
        .HighlightedLine = 0
    End With

End Sub

Private Sub Form_Resize()

On Error Resume Next

DHTML1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 330

Code1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight - 330

End Sub

Private Function FStatus() As FormStatus
On Error GoTo 1
FStatus = CStatus(CInt(Me.Tag))
Exit Function
1
FStatus = CStatus(CIndex)
End Function

Private Sub Form_Unload(Cancel As Integer)

If Me.Job = "kill" Then GoTo UnloadCode

If FStatus.HTMLOpened = True Then
    MsgBox "Please close the Code Editor first.", vbInformation + vbMsgBoxSetForeground, "Closing..."
    Cancel = 1
    Exit Sub
End If

If FStatus.OpenFromROM = True Then
    If Trim(LCase(FStatus.HTMLString)) = Trim(LCase(DHTML1.DocumentHTML)) Then
        GoTo UnloadCode
    Else
        GoTo QuerySave
    End If
End If

On Error Resume Next
If Trim(LCase(FStatus.HTMLString)) = Trim(LCase(DHTML1.DocumentHTML)) Then
    'The document is clean
    GoTo UnloadCode
    
    Else
    'The document have been changed
QuerySave:

    Dim m As Integer
    m = MsgBox("You have made changes to this document. Do you want to save it?", vbQuestion + vbYesNoCancel, "Closing doucment...")
    
    Select Case m
        Case vbCancel
            Cancel = 1
            Exit Sub
            
        Case vbYes 'The most complicated part
            Dim s As Integer
            s = SaveFile(Me, MfrmProgram.Cd1, FStatus, IIf(FStatus.OpenFromROM = False, Not FStatus.Saved, True))
            If s = 0 Then
                GoTo UnloadCode
            ElseIf s = cdlCancel Then
                Cancel = 1
                Exit Sub
            Else
                MsgBox Error(s), vbCritical, "File saving error: " & s
                Cancel = 1
                Exit Sub
            End If
            
        Case vbNo
            GoTo UnloadCode
            
    End Select
    
End If

UnloadCode:
    DoEvents
    Screen.MousePointer = 11
    On Error Resume Next
    Kill FStatus.TempFilename
    Editor(CInt(Me.Tag)).Job = "kill"
    Unload Editor(CInt(Me.Tag))
    Set Editor(Me.Tag) = Nothing
    Me.Hide
    Screen.MousePointer = 0
    
    If MfrmProgram.FileTab.Tabs.Count = 1 Then MfrmProgram.FileTab.Tabs.Clear
    MfrmProgram.FileTab.Tabs.Remove "key" & CInt(Me.Tag)

End Sub


Private Sub tbrQuick_ButtonClick(ByVal Button As MSComctlLib.Button)

If Button.Index <> 6 And Button.Index <> 7 Then
    ChangeMode Button.Index
    Exit Sub
End If

Select Case Button.Index
    Case 6
        DHTML1.ShowDetails = Not DHTML1.ShowDetails
        SaveOption "ShowDetails", DHTML1.ShowDetails
        Button.Value = IIf(DHTML1.ShowDetails = True, 1, 0)
    Case 7
        DHTML1.SnapToGrid = Not DHTML1.SnapToGrid
        SaveOption "SnapToGrid", DHTML1.SnapToGrid
        Button.Value = IIf(DHTML1.SnapToGrid = True, 1, 0)
End Select

End Sub

Public Function GetActiveElement() As Object
DoEvents
Dim rg As IHTMLTxtRange
   Dim ctlRg As IHTMLControlRange
   On Error Resume Next
   Select Case DHTML1.DOM.selection.Type
      Case "None", "Text"
         ' This reduces the selection to just the insertion
         ' point. The parentElement method will then return the
         ' element directly under the mouse pointer.
         Set rg = DHTML1.DOM.selection.createRange
         rg.collapse False
         
         Set GetActiveElement = rg.parentElement
      Case "Control"
         ' A form or image is selected. The commonParentElement
         ' will return the site selected element.
         Set ctlRg = DHTML1.DOM.selection.createRange
         
         Set GetActiveElement = ctlRg.commonParentElement
         
         
   End Select
End Function

Private Function ElementP() As IHTMLElement
DoEvents
    On Error Resume Next
    'Set e = DHTML1.DOM.parentWindow.event
    Set ElementP = DHTML1.DOM.elementFromPoint(x, y)

End Function

Public Function CreatorHTML() As String
DHTML1.SaveDocument FStatus.TempFilename
CreatorHTML = ReadText(FStatus.TempFilename)
End Function