Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/recurs1a/domtable.frm

Visual Basic Form | 1999-08-27 | 25.2 KB | 686 lines

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Begin VB.Form frmDOMTable
   Caption         =   "DOM Demo"
   ClientHeight    =   3885
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   5940
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3885
   ScaleWidth      =   5940
   WindowState     =   2  'Maximized
   Begin SHDocVwCtl.WebBrowser wbr
      Height          =   3675
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5715
      ExtentX         =   10081
      ExtentY         =   6482
      ViewMode        =   1
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   1
      AutoArrange     =   -1  'True
      NoClientEdge    =   0   'False
      AlignLeft       =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin VB.Menu mnuFileMenu
      Caption         =   "&File"
      Begin VB.Menu mnuFile
         Caption         =   "&HTML"
         Index           =   0
      End
      Begin VB.Menu mnuFile
         Caption         =   "&Recurse"
         Index           =   1
      End
      Begin VB.Menu mnuFile
         Caption         =   "S&tructure"
         Index           =   2
      End
      Begin VB.Menu mnuFile
         Caption         =   "St&yle"
         Index           =   3
      End
      Begin VB.Menu mnuFile
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu mnuFile
         Caption         =   "Save &As..."
         Index           =   5
      End
      Begin VB.Menu mnuFile
         Caption         =   "-"
         Index           =   6
      End
      Begin VB.Menu mnuFile
         Caption         =   "Page Set&up..."
         Index           =   7
      End
      Begin VB.Menu mnuFile
         Caption         =   "&Print..."
         Index           =   8
      End
      Begin VB.Menu mnuFile
         Caption         =   "-"
         Index           =   9
      End
      Begin VB.Menu mnuFile
         Caption         =   "&Close"
         Index           =   10
      End
   End
   Begin VB.Menu mnuDemoMenu
      Caption         =   "Demo"
      Begin VB.Menu mnuDemo
         Caption         =   "Progress Display"
         Index           =   0
      End
      Begin VB.Menu mnuDemo
         Caption         =   "Load Table"
         Enabled         =   0   'False
         Index           =   1
      End
      Begin VB.Menu mnuDemo
         Caption         =   "Show Table"
         Enabled         =   0   'False
         Index           =   2
      End
      Begin VB.Menu mnuDemo
         Caption         =   "Format"
         Enabled         =   0   'False
         Index           =   3
      End
      Begin VB.Menu mnuDemo
         Caption         =   "-"
         Index           =   4
      End
      Begin VB.Menu mnuDemo
         Caption         =   "All"
         Index           =   5
      End
   End
   Begin VB.Menu mnuOptMenu
      Caption         =   "&Options"
      Begin VB.Menu mnuOpt
         Caption         =   "&Format"
         Index           =   0
      End
      Begin VB.Menu mnuOpt
         Caption         =   "&Background"
         Index           =   1
         Begin VB.Menu mnuBGround
            Caption         =   "&Blue binder"
            Index           =   1
         End
         Begin VB.Menu mnuBGround
            Caption         =   "&Green binder"
            Index           =   2
         End
      End
      Begin VB.Menu mnuOpt
         Caption         =   "&Caption"
         Index           =   2
      End
      Begin VB.Menu mnuOpt
         Caption         =   "-"
         Index           =   3
      End
      Begin VB.Menu mnuOpt
         Caption         =   "Scroll Bar"
         Index           =   4
      End
      Begin VB.Menu mnuOpt
         Caption         =   "-"
         Index           =   5
      End
      Begin VB.Menu mnuOpt
         Caption         =   "Context Menu"
         Index           =   6
         Begin VB.Menu mnuContext
            Caption         =   "&Default"
            Checked         =   -1  'True
            Index           =   0
         End
         Begin VB.Menu mnuContext
            Caption         =   "&File"
            Index           =   1
         End
         Begin VB.Menu mnuContext
            Caption         =   "&Options"
            Index           =   2
         End
      End
   End
Attribute VB_Name = "frmDOMTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' DOMTable.frm  July 1999   contact [e-mail]
' Demonstrates DOM manipulation from Vb6 including
'   build document in empty WebBrowser Control
'   build DIV element as progress display
'   build a Stylesheet
'   convert tab-deliited text to HTML Table with
'       Header, Footer, Caption, Column definitions
'   enable/disable formatting
'   replace standard context (right-click) popup menu
'   set document title, table caption
'   saving constructed document as HTML
' Requires Project/References entry for
'   Microsoft HTML Object Library (MSHTML.tlb)
'====================================================================================
' Module-level VARIABLES
Private mDefaultPath As String      ' set in Form_Load
Private mDataFileSpec As String     ' Name of tab-delimited data file
Private mvarMDIParent As MDIForm    ' useful to access parent form - see StatusText
Private mDemoDoc As MSHTML.HTMLDocument ' = wbr.document (see wbr_DocumentComplete)
Private mDemoBody As MSHTML.HTMLBody    ' = wbr.document.body
Private mTable As MSHTML.HTMLTable      ' returned from mListToHTML.FileToDOM
Private mStyleSheet As MSHTML.HTMLStyleSheet    ' returned from BuildStyleSheet
Private WithEvents mHTMLDocEvents As MSHTML.HTMLDocument    ' captures right-click
Attribute mHTMLDocEvents.VB_VarHelpID = -1
Private WithEvents mListToHTML As ListToHTML    ' converts mDataFileSpec to HTML
Attribute mListToHTML.VB_VarHelpID = -1
Private mContextOption As Long  ' current context menu selection
' Module-level variables for Progress Display
Private mProgressDisplay As MSHTML.HTMLDivElement
Private mProgressRow As MSHTML.IHTMLDOMTextNode
Private mProgressBarStyle As MSHTML.HTMLStyle
Private WithEvents mProgressCancel As MSHTML.HTMLButtonElement ' Life cycle = mListToHTML
Attribute mProgressCancel.VB_VarHelpID = -1
Private mTotalRows As Long  ' helps calculate percentage for progress Bar
' Module-level CONSTANTS
Private Const START_HTML = "<BODY style=overflow:auto></BODY>"
' File Menu Constants
Private Const FILE_HTML = 0
Private Const FILE_RECURSE = 1
Private Const FILE_STRUCTURE = 2
Private Const FILE_STYLE = 3
Private Const FILE_SAVEAS = 5
Private Const FILE_PAGESETUP = 7
Private Const FILE_PRINT = 8
Private Const FILE_CLOSE = 10
' Demo menu constants
Private Const DEMO_PROGRESS = 0
Private Const DEMO_LOAD = 1
Private Const DEMO_SHOW = 2
Private Const DEMO_FORMAT = 3
Private Const DEMO_ALL = 5
' Option menu constants
Private Const OPT_FORMAT = 0
Private Const OPT_BGROUND = 1
Private Const OPT_CAPTION = 2
Private Const OPT_SCROLL = 4
' Context menu constants
Private Const CTX_DEFAULT = 0
Private Const CTX_FILE = 1
Private Const CTX_OPT = 2
' Background menu constants
Private Const BG_BLUEBINDER = 1
Private Const BG_GREENBINDER = 2
' Module-level Constants
' Relevant nodeType constants
Private Const ELEMENT_NODE = 1
Private Const TEXT_NODE = 3
' Browser navigation constants
Private Const navNoHistory = 2
Public Property Let DataFileSpec(ByVal vData As String)
    mDataFileSpec = vData
End Property
Public Property Set MDIParent(vData As MDIForm) ' optional
   Set mvarMDIParent = vData
End Property
Private Property Let StatusText(ByVal vData As String)
    On Error Resume Next
    If Not (mvarMDIParent Is Nothing) Then  ' property is optional
        mvarMDIParent.StatusText = vData
    End If
End Property
Private Sub Form_Load()
    mDefaultPath = App.Path & "\"
    mnuDemoMenu.Visible = False
    mnuOptMenu.Visible = False
    mnuOptMenu = False
    wbr.Navigate URL:="about:" & START_HTML, Flags:=navNoHistory
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    wbr.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub mnuFileMenu_Click()
    Dim WbrDoc As MSHTML.HTMLDocument
    Set WbrDoc = wbr.Document
    mnuFile(FILE_STYLE) = WbrDoc.styleSheets.length
End Sub
Private Sub mnuFile_Click(Index As Integer)
    On Error Resume Next    ' Some 'ExecWB' generate error for 'Cancel'
    Dim strFileSpec As String
    Dim WbrDoc As MSHTML.HTMLDocument
    Set WbrDoc = wbr.Document   ' needed by most menu items
    Select Case Index

        Case FILE_HTML

            With New frmDOMHTML
                .Show
                DoEvents
                .DisplayHTML HTMLDoc:=WbrDoc
            End With

        Case FILE_RECURSE

            With New frmDOMRecurse
                .Show
                DoEvents
                .Recurse StartFromNode:=WbrDoc.getElementsByTagName("HTML")(0)
            End With

        Case FILE_STRUCTURE
            With New frmDOMTree
                Set .MDIParent = mvarMDIParent
                .Show
                DoEvents
                .DisplayDOMInfo HTMLDoc:=WbrDoc, InfoType:=domiTree
            End With

        Case FILE_STYLE

            With New frmDOMTree
                Set .MDIParent = mvarMDIParent
                .Show
                DoEvents
                .DisplayDOMInfo HTMLDoc:=WbrDoc, InfoType:=domiStyle
            End With


        Case FILE_SAVEAS

            If SetDocTitle(HTMLDoc:=WbrDoc) Then    ' makes Title mandatory
                strFileSpec = FileSaveAs(HTMLDoc:=WbrDoc, OwnerHwnd:=Me.hWnd)
                If Len(strFileSpec) Then
                    StatusText = "Document saved. Loading " & strFileSpec
                    wbr.Navigate strFileSpec, navNoHistory
                End If
            End If

        Case FILE_PAGESETUP

            wbr.ExecWB _
                cmdid:=OLECMDID_PAGESETUP, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER

        Case FILE_PRINT

            wbr.ExecWB _
                cmdid:=OLECMDID_PRINT, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER

        Case FILE_CLOSE

            Unload Me

    End Select
End Sub
Private Sub mnuDemo_Click(Index As Integer)
    On Error GoTo mnuDemo_Error
    StatusText = "mnuDemo(" & Index & ") - " & mnuDemo(Index).Caption
    Select Case Index
        Case DEMO_PROGRESS  ' Build Progress Display; note elements used in DEMO_LOAD

            Set mProgressDisplay = BuildProgressDisplay(HTMLDoc:=mDemoDoc)
            mDemoBody.appendChild mProgressDisplay
            With mDemoDoc
                Set mProgressRow = .getElementById("idRow").firstChild
                Set mProgressBarStyle = .getElementById("idBar").runtimeStyle
            End With
            mProgressDisplay.runtimeStyle.visibility = "visible"

        Case DEMO_LOAD  ' Load Table from DataFileSpec

            Set mListToHTML = New ListToHTML
            Set mProgressCancel = mDemoDoc.getElementById("idCancel")
            With mListToHTML
                .ProgressInterval = 10  ' default 5 - set low to test Cancel Button
                Set mTable = mListToHTML.FileToDOM( _
                                InFileName:=mDataFileSpec, _
                                HTMLDoc:=mDemoDoc, _
                                GetTotalRows:=True)
            End With
            Set mProgressCancel = Nothing   ' "de-activate" the cancel button
            Set mListToHTML = Nothing

        Case DEMO_SHOW  ' Show Table in place of Progress Display

            mProgressDisplay.replaceNode replacement:=mTable
            Set mProgressDisplay = Nothing

         Case DEMO_FORMAT  ' Create Stylesheet programmatically

            Set mStyleSheet = BuildStyleSheet(HTMLDoc:=mDemoDoc)
            mnuOptMenu = Not (mStyleSheet Is Nothing)
            mnuDemoMenu = Not mnuOptMenu
            If mnuOptMenu Then
                mnuOpt_Click OPT_FORMAT
                StatusText = " Ready"
            End If

       Case DEMO_ALL  ' All of the above

            AutoDemo

    End Select
mnuDemo_Exit:
' Manipulate demo sequence
    mnuDemo(Index) = False
    If Index < DEMO_ALL Then
        mnuDemo(Index + 1) = True
    End If
    mnuDemo(DEMO_ALL) = False
    Exit Sub
mnuDemo_Error:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "ERROR in Demo Menu"
    mnuDemoMenu = False ' bale out
End Sub
Private Sub mnuOptMenu_Click()
    If Not (mTable.Caption Is Nothing) Then
        mnuOpt(OPT_CAPTION).Checked = mTable.Caption.runtimeStyle.display = "inline"
    End If
    mnuOpt(OPT_BGROUND) = mnuOpt(OPT_FORMAT).Checked
End Sub
Private Sub mnuOpt_Click(Index As Integer)
    On Error Resume Next
    Select Case Index
        Case OPT_FORMAT ' toggle application of stylesheet rules

            With mnuOpt(OPT_FORMAT)
                .Checked = Not .Checked
                mStyleSheet.disabled = Not .Checked
            End With

        Case OPT_CAPTION    ' toggle display of table caption

            With mnuOpt(OPT_CAPTION)
                If mTable.Caption Is Nothing Then   'one chance only for demo
                   .Checked = SetTableCaption(DOMTable:=mTable)
                Else
                    .Checked = Not .Checked
                    mTable.Caption.runtimeStyle.display = IIf(.Checked, "inline", "none")
                End If
            End With

        Case OPT_SCROLL ' Show/Hide scrollbar (how to detect on/off when 'auto'??)

            With mnuOpt(OPT_SCROLL)
                .Checked = Not .Checked
                mDemoBody.runtimeStyle.overflow = IIf(.Checked, "auto", "visible")
            End With

    End Select
End Sub
Private Sub mnuBGround_Click(Index As Integer)
    mnuBGround(BG_BLUEBINDER).Checked = Index = BG_BLUEBINDER
    mnuBGround(BG_GREENBINDER).Checked = Index = BG_GREENBINDER
    mDemoBody.className = Choose(Index, "BlueBinder", "GreenBinder")
End Sub
Private Sub mnuContext_Click(Index As Integer)
' Monitor document for right-click if required (see mHTMLDocEvents_oncontextmenu)
    mnuContext(CTX_DEFAULT).Checked = Index = CTX_DEFAULT
    mnuContext(CTX_FILE).Checked = Index = CTX_FILE
    mnuContext(CTX_OPT).Checked = Index = CTX_OPT
    mContextOption = Index
    Set mHTMLDocEvents = IIf(Index = CTX_DEFAULT, Nothing, mDemoDoc)
End Sub
Private Function BuildProgressDisplay( _
            HTMLDoc As MSHTML.HTMLDocument) As MSHTML.HTMLDivElement
' This kind of thing would normally be specified within an HTML Template.
' It is coded here only to demonstrate the functions involved
' in programmatically adding objects to a document.
' NOTE: To demonstrate the difference between "xRuntimeStyle" and "xStyle"
'       interchange them using ("x" prefix to prevent comment from changing)
'           Edit/Replace (Current Procedure, Find Whole Word Only)
'       and view results after "Demo/Progress Display" using the "File/HTML"
    On Error GoTo BuildProgressDisplay_Error
    Dim Result As MSHTML.HTMLDivElement    ' default function result = Nothing
    Dim oCenterDIV As MSHTML.HTMLDivElement
    Dim oIdSPAN As MSHTML.HTMLSpanElement   ' used for cloning
' Create node for cloning (TextNode has no ID property)
    Set oIdSPAN = HTMLDoc.createElement("SPAN")
    oIdSPAN.appendChild HTMLDoc.createTextNode("?")
' Create primary container for progress display (returned as function result)
    Set oCenterDIV = HTMLDoc.createElement("DIV")
    With oCenterDIV.runtimeStyle
        .TextAlign = "center"
        .visibility = "hidden"
    End With
' Text Display
    With oCenterDIV.appendChild(HTMLDoc.createElement("DIV"))
        With .runtimeStyle
            .Font = "16pt serif"
            .Color = "black"
        End With
        .appendChild HTMLDoc.createTextNode("Converting row ")
        With .appendChild(oIdSPAN.cloneNode(True))
            .id = "idRow"
            With .runtimeStyle
                .Color = "blue"
                .textDecorationUnderline = True
            End With
        End With
        .appendChild HTMLDoc.createTextNode(" of ")
        .appendChild(oIdSPAN.cloneNode(True)).id = "idRows"
        .appendChild HTMLDoc.createTextNode(" rows ( ")
        .appendChild(oIdSPAN.cloneNode(True)).id = "idCols"
        .appendChild HTMLDoc.createTextNode(" columns )")
    End With
    oCenterDIV.appendChild HTMLDoc.createElement("BR")
' Progress Bar
    With oCenterDIV.appendChild(HTMLDoc.createElement("DIV"))
        With .runtimeStyle
            .Width = "80%"
            .TextAlign = "left"
            .border = "3px outset"
        End With
        With .appendChild(HTMLDoc.createElement("SPAN"))
            .id = "idBar"
            With .runtimeStyle
                .Width = "1px"
                .backgroundColor = "blue"
            End With
        End With
    End With
    oCenterDIV.appendChild HTMLDoc.createElement("BR")
' Cancel Button
    With oCenterDIV.appendChild(HTMLDoc.createElement("BUTTON"))
        .id = "idCancel"
        .Value = " Cancel "
        With .runtimeStyle
            .backgroundColor = "red"
            .Color = "white"
            .fontWeight = "bold"
            .border = "3px outset"
        End With
    End With
    Set Result = oCenterDIV
BuildProgressDisplay_Exit:
    Set BuildProgressDisplay = Result
    Exit Function
BuildProgressDisplay_Error:
    Set oCenterDIV = Nothing
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "BuildProgressDisplay"
    Resume BuildProgressDisplay_Exit
End Function
Private Function BuildStyleSheet( _
            HTMLDoc As MSHTML.HTMLDocument) As MSHTML.HTMLStyleSheet

' A StyleSheet would normally be specified within an HTML Template.
'   It is coded here only to demonstrate the functions involved
'   in programmatically adding CSS rules to a document.
    On Error GoTo BuildStyleSheet_Error
    Dim Result As MSHTML.HTMLStyleSheet ' default function result = Nothing
    Dim strImgPath As String
    strImgPath = mDefaultPath & "Images\"
    Set Result = HTMLDoc.createStyleSheet
    With Result
        .disabled = True
        .addRule "BODY", "font:68% verdana,sans-serif;" _
                    & "color:black;" _
                    & "background-color:white;" _
                    & "margin:4;"
        .addRule "BODY.BlueBinder", "margin-left:80; " _
                    & "background-image:url(" & strImgPath & "BlueBinder.gif);"
        .addRule "BODY.GreenBinder", "margin-left:48;" _
                    & "background-image:url(" & strImgPath & "GreenBinder.gif);"
        .addRule "TABLE", "table-layout:auto"
        .addRule "CAPTION", "font:180% 'Comic Sans MS'; color:red"
        .addRule "COL.clText", "text-align:left"
        .addRule "COL.clNum", "text-align:right"
        .addRule "TR", "font-size:68%;vertical-align: text-top;" _
                    & "color:#003498; background-color:#F0ECF0"
        .addRule "TD", "padding:2 8"
        .addRule "THEAD TR", "font:bold small-caps; background-color:#98CCFF"
        .addRule "TFOOT TD", "background-color:#98CCFF; text-align:center"
        .addRule "TD.clNumNeg", "color:red"
    End With
BuildStyleSheet_Exit:
    Set BuildStyleSheet = Result
    Exit Function
BuildStyleSheet_Error:
    Set Result = Nothing
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "BuildStyleSheet"
    Resume BuildStyleSheet_Exit
End Function
Private Sub AutoDemo()
    On Error GoTo AutoDemo_Exit
    mnuDemoMenu = False
    mnuDemo_Click DEMO_PROGRESS
    mnuDemo_Click DEMO_LOAD
    mnuDemo_Click DEMO_SHOW
    mnuDemo_Click DEMO_FORMAT
AutoDemo_Exit:
End Sub
Private Function SetTableCaption(DOMTable As MSHTML.HTMLTable) As Boolean
    On Error GoTo SetTableCaption_Error
    Dim strCaption As String
    strCaption = InputBox( _
            prompt:="Please enter a Heading for the Table.", _
            Title:="HTML table heading?", _
            Default:="(DOM Demo)")
    If Len(strCaption) Then
        With DOMTable.createCaption
            .appendChild DOMTable.Document.createTextNode(strCaption)
            .runtimeStyle.display = "inline"
        End With
    End If
SetTableCaption_Exit:
    SetTableCaption = Not (DOMTable.Caption Is Nothing)
    Exit Function
SetTableCaption_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "SetTableCaption"
    Resume SetTableCaption_Exit
End Function
Private Function SetDocTitle(HTMLDoc As MSHTML.HTMLDocument) As Boolean
    On Error GoTo SetDocTitle_Exit
    Dim strTitle As String
    strTitle = HTMLDoc.Title
    If Len(strTitle) = 0 Then
        strTitle = InputBox(prompt:="Please enter a Title for your HTML page.", _
                Title:="HTML page title?", _
                Default:=strTitle)
        If Len(strTitle) Then
            HTMLDoc.Title = strTitle
        End If
    End If
    SetDocTitle = CBool(Len(strTitle))
SetDocTitle_Exit:
End Function
Private Function FileSaveAs(HTMLDoc As MSHTML.HTMLDocument, _
                            OwnerHwnd As Long) As String
' Returns full path of saved file. Uses FileDlg.cls.
    On Error GoTo FileSaveAs_Error
    Dim Result As String    ' default function result = ""
    Dim strFileName As String
    Dim oHTML  As MSHTML.HTMLHtmlElement
    With New FileDlg
        .DefaultDir = mDefaultPath & "Work"
        .Owner = OwnerHwnd
        .AddFilter "HTML Documents (*.htm,*html):*.htm;*html"
        .DefaultFileExt = "htm"
        If .Show(DlgType:=SaveAsDialog) Then
            strFileName = .PathFile
        End If
    End With
    DoEvents
    If Len(strFileName) Then
        With HTMLDoc.body  ' fudge on location of background images
            If InStr(1, .className, "binder", vbTextCompare) Then
                .Style.backgroundImage = "url(..\Images\" & .className & ".gif)"
            End If
        End With

        Set oHTML = HTMLDoc.getElementsByTagName("HTML")(0)
        With New Scripting.FileSystemObject
            With .CreateTextFile(FileName:=strFileName)
                .Write oHTML.outerHTML
                .Close
            End With
        End With

    End If
    Result = strFileName
FileSaveAs_Exit:
    FileSaveAs = Result
    Exit Function
FileSaveAs_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, "FileSaveAs"
    Resume FileSaveAs_Exit
End Function
'   === Events ===
Private Sub wbr_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    If pDisp Is wbr.object Then
        If InStr(1, URL, "about:", vbTextCompare) Then
            Set mDemoDoc = wbr.Document
            Set mDemoBody = mDemoDoc.body
            mnuDemoMenu.Visible = True
            mnuOptMenu.Visible = True
        Else
            mnuDemoMenu.Visible = False
            mnuOptMenu.Visible = False
            Me.Caption = wbr.Document.Title
            StatusText = URL
        End If
    End If
End Sub
Private Function mHTMLDocEvents_oncontextmenu() As Boolean
' See mnuContext_Click. This Event Function is inactive (never called) while
'                       (mHTMLDocEvents is Nothing) and (mContextOption = 0)
    mHTMLDocEvents_oncontextmenu = False    ' cancel the default context menu
    Me.PopupMenu Choose(mContextOption, mnuFileMenu, mnuOptMenu)
End Function
Private Sub mListToHTML_RowsCols(NumRows As Long, NumCols As Long) ' Once only
    On Error Resume Next
    With mDemoDoc
        .getElementById("idRows").firstChild.nodeValue = NumRows
        .getElementById("idCols").firstChild.nodeValue = NumCols
    End With
    mTotalRows = NumRows    ' keep to calculate percentage for progress Bar
End Sub
Private Sub mListToHTML_RowProgress(RowNum As Long) ' Frequency is ProgressInterval
    On Error Resume Next
    mProgressRow.Data = RowNum
    mProgressBarStyle.Width = FormatPercent(RowNum / mTotalRows, 0)
    DoEvents
End Sub
Private Function mProgressCancel_onclick() As Boolean
    mListToHTML.Cancel = True   ' can be detected by ListToHTML instance
End Function