modpc3.bas

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

Attribute VB_Name = "modPC3"

Public Creator() As New frmMain
Public Editor() As New frmCodeEditor
Public CStatus() As FormStatus

Public CIndex As Integer
Public EIndex As Integer

Function FindFreeCreator() As Integer

On Error GoTo errHandler
  Dim i As Integer
  Dim ArrayCount As Integer
    ArrayCount = UBound(Creator)
    
    ReDim Preserve Creator(1 To ArrayCount + 1)
    ReDim Preserve CStatus(1 To ArrayCount + 1)
    FindFreeCreator = UBound(Creator)

    Exit Function

errHandler:
    FindFreeCreator = 0

End Function

Function FindFreeEditor() As Integer

    On Error GoTo errHandler
  Dim i As Integer
  Dim ArrayCount As Integer
    ArrayCount = UBound(Editor)
    
    ReDim Preserve Editor(1 To ArrayCount + 1)
    FindFreeEditor = UBound(Editor)

    Exit Function

errHandler:
    FindFreeEditor = 0

End Function

Function ShowOpenBox(Filter As String, CommonDialog As CommonDialog) As String

With CommonDialog
    .CancelError = True
    .Filter = Filter
    .Flags = cdlOFNFileMustExist
    On Error GoTo 1
    .ShowOpen
    
    ShowOpenBox = .Filename
End With

Exit Function
1
Select Case Err.Number
    Case cdlCancel
        Err.Raise cdlCancel
    Case Else
         MsgErr
        Err.Raise Err.Number
End Select

End Function

Function SaveHistory(ByVal URL As String)
Dim HistoryCount As Currency
Dim HistoryFull As Boolean
Dim num As Long
Dim HistoryReg As Currency

HistoryCount = GetSet(App.ProductName, "history", "historycount", 0)

'Force number of history less than 30
HistoryReg = HistoryCount
Do Until HistoryReg < 100
HistoryReg = HistoryReg - 100
Loop

num = HistoryReg + 1
SaveSet App.ProductName, "history", "file" & num, URL

SaveSet App.ProductName, "history", "historycount", HistoryCount + 1

End Function

Sub InsertHTML(IsCreator As Boolean, ByVal Code As String, Optional HTMLDoc As IHTMLDocument2, Optional CodeBox As CodeMax)

On Error GoTo 1
If IsCreator = True Then
    Dim doc As IHTMLDocument2
    Dim sel As IHTMLSelectionObject
    Dim tr As IHTMLTxtRange
    
    ' get the DHTML Document object
    Set doc = HTMLDoc
    ' get the IE4 selection object
    Set sel = doc.selection
    ' create a TextRange from the current selection
    Set tr = sel.createRange
    
    ' paste our html into the range
    DoEvents
    tr.pasteHTML Code
    
Else
    CodeBox.SelText = Code
End If
Exit Sub
1 MsgBox "An unexpected error occured during inserting the HTML." & vbCrLf & "Please contact the writer Kenny Lai at <[e-mail]>", vbCritical
End Sub

Sub ToolBoxTab(IsCreator As Boolean, STab As SSTab)

If GetOption("showtoolbox") = False Then Exit Sub

With frmToolBox
If IsCreator = True Then
    .fam(0).Enabled = True  'Open
    .fam(1).Enabled = True  'Element HTML
    .fam(2).Enabled = True  'Insert
    .fam(3).Enabled = True  'Tree Edit
    .fam(4).Enabled = False 'Database
    .fam(5).Enabled = False 'HTML Tags
    .fam(6).Enabled = True  'Wizard
    .fam(7).Enabled = False 'Library
Else
    .fam(0).Enabled = False
    .fam(1).Enabled = False
    .fam(2).Enabled = True
    .fam(3).Enabled = False
    .fam(4).Enabled = True
    .fam(5).Enabled = True
    .fam(6).Enabled = True
    .fam(7).Enabled = True
End If
End With

With STab
If IsCreator = True Then
    .TabEnabled(0) = True   'Open
    .TabEnabled(1) = True   'Element HTML
    .TabEnabled(2) = True   'Insert
    .TabEnabled(3) = True   'Tree Edit
    .TabEnabled(4) = False  'Database
    .TabEnabled(5) = False  'HTML Tags
    .TabEnabled(6) = True   'Wizard
    .TabEnabled(7) = False  'Library
Else
    .TabEnabled(0) = False
    .TabEnabled(1) = False
    .TabEnabled(2) = True
    .TabEnabled(3) = False
    .TabEnabled(4) = True
    .TabEnabled(5) = True
    .TabEnabled(6) = True
    .TabEnabled(7) = True
End If
End With
End Sub