CD Actual Thematic 25: Programming/pc_actual_25.iso/Basic/GridOne/setup.EXE/BEEGD10.CHM/scripts.vbs

Text File | 2001-09-09 | 7.6 KB | 326 lines

Option Explicit

Dim mbSpanButtionActive

Function CheckLicense(grd)
   Dim sLic
   const GRID_LIC = "Free Edition"

   On Error Resume Next

   sLic = Trim(grd.License)
   sLic = Left(sLic, Len(GRID_LIC))

   If StrComp(GRID_LIC, sLic, vbTextCompare) = 0 Then
      window.navigate "NotInFree.htm"
      CheckLicense = False
   Else
      CheckLicense = True
   End If
End Function

Sub ToggleExample(divID)
   Dim example, example_body, example_head

    On Error Resume Next

   set example = document.all(divID)
   if not example is Nothing then

      set example_body = example.children("example_body")
      set example_head = example.children("example_head")
      if example_body.style.display = "block" then
         example_body.style.display = "none"
            example_head.children("idExamIcon").src = "fld.png"
            example_head.children("idExamCaption").innerText = " Show Example"
            document.all("idMenuExample").className = "clsMenuText"
      else
         example_body.style.display = "block"
            example_head.scrollIntoView
             example_head.style.fontWeight ="Bold"
            example_head.children("idExamIcon").src = "ofld.png"
            example_head.children("idExamCaption").innerText = " Hide Example"
            document.all("idMenuExample").className = "clsMenuTextDown"
      end if
   end if
End sub

Function ShowSeeAlso()
    dim elm,ieX,ieY,PopUp

    On error resume next

    set PopUp=document.all.idPopUp_idPUPDIV_SeeAlso

    set elm = window.event.srcElement

    window.event.returnValue = false
    window.event.cancelBubble = true

    If PopUp.style.visibility = "visible" Then
        HidePopUp
        elm.className = "clsMenuTextUp"
        set PopUp = Nothing
        set elm = Nothing
        Exit Function
    End If

    if elm is nothing then
        ieX = window.event.clientX
        ieY = window.event.clientY + document.body.scrollTop
    else
        ieX = elm.offsetLeft
        ieY = ((elm.offsetTop) + (elm.offsetHeight) + 1)
    end if

    PopUp.style.top = ieY
    PopUp.style.left = ieX

    PopUp.style.visibility = "visible"

End Function

Sub HidePopUp()
    dim divs

    On error resume next

    for each divs in document.all.tags("DIV")
        if StrComp(divs.classname,"clsEnumPopUp",vbTextCompare)=0 Or StrComp(divs.classname,"clsPopUp",vbTextCompare)=0 then
            divs.style.visibility = "hidden"
        end if
    next

    document.all("sapop").className = "clsMenuText"
End Sub


Sub InitPopUp()
    dim tbl,sPopUp,sHtml
    dim sPopUpId,div

    On error resume next
    For each tbl in document.all.tags("TABLE")
        if len(tbl.Id)>0 then
            if instr(1,tbl.id,"idEnumTable",vbTextCompare)>0 then
                sHtml=tbl.innerHTML
                sHtml=replace(sHtml,"width=" & chr(34) & "96","width=" & chr(34) & "100")
                sPopUpId="idPopUp_"  & tbl.id
                sPopUp="<DIV ID=" & sPopUpId & " CLASS=clsEnumPopUp>" & sHtml & "</DIV>"

                call document.body.insertAdjacentHTML("beforeEnd", sPopUp)
                document.all(sPopUpId).innerHTML =tbl.innerHTML

            end if
        end if
    next

    for each div in document.all.tags("DIV")
        if len(div.Id)>0 then
            if instr(1,div.id,"idPUPDIV",vbTextCompare)>0 Then
                sHtml=div.innerHTML
                sPopUpId="idPopUp_"  & div.id
                sPopUp="<DIV ID=" & sPopUpId & " CLASS=clsPopUp>" & sHtml & "</DIV>"
                call document.body.insertAdjacentHTML("beforeEnd", sPopUp)
                document.all(sPopUpId).innerHTML =div.innerHTML
            end if
        end if
    next

End Sub

Sub ShowEnum(PopUpId)
    dim elm,ieX,ieY,PopUp
    dim par,lWidth
    const SCROLL_WIDTH = 24
    On error resume next

    HidePopUp

    set PopUp=document.all(PopUpId)

    If PopUp is nothing then exit sub

    set elm = window.event.srcElement

    window.event.returnValue = false
    window.event.cancelBubble = true

    if elm is nothing then
        ieX = window.event.clientX
        ieY = window.event.clientY + document.body.scrollTop
    else
        ieX = elm.offsetLeft
        lWidth = elm.offsetWidth
        ieY = ((elm.offsetTop) + (elm.offsetHeight) + 1)

        Set par = elm.offsetParent

        Do until par is Nothing
            lWidth = par.offsetWidth
            ieX = ieX + par.offsetLeft
            ieY = ieY + par.offsetTop
            Set par = par.offsetParent
        Loop
    end if

    If (PopUp.offsetWidth + SCROLL_WIDTH) > (lWidth - ieX) Then
        If (PopUp.offsetWidth + SCROLL_WIDTH) > lWidth Then
            ieX = 0
        Else
            ieX = lWidth - PopUp.offsetWidth - SCROLL_WIDTH
        End If
    End If

    PopUp.style.top = ieY
    PopUp.style.left = ieX

    PopUp.style.visibility = "visible"

    set PopUp=nothing
    set elm=nothing
End Sub

Sub ShowProperties(sObjectGUID)
    window.navigate "Properties_properties_" & sObjectGUID & ".htm"
End Sub

Sub ShowMethods(sObjectGUID)
    window.navigate "Methods_methods_" & sObjectGUID & ".htm"
End Sub

Sub ShowEvents(sObjectGUID)
    window.navigate "Events_events_" & sObjectGUID & ".htm"
End Sub
'buttons
Sub document_onmouseover()
    Dim eSrc

    On Error Resume Next

   mbSpanButtionActive = False

    set eSrc = window.event.srcElement

    If TypeName(eSrc) = "HTMLImg" Then
        Set eSrc = eSrc.parentElement
    End If

    If eSrc.className = "clsMenuText" Then
        eSrc.className = "clsMenuTextUp"
      mbSpanButtionActive = True
    ElseIf eSrc.className = "clsExamMenuText" Then
        eSrc.className = "clsExamMenuTextUp"
      mbSpanButtionActive = True
    End If
End Sub

Sub document_onmouseout()
    Dim eSrc

    On Error Resume Next

    set eSrc = window.event.srcElement

    If TypeName(eSrc) = "HTMLImg" Then
        Set eSrc = eSrc.parentElement
    End If

    If eSrc.className = "clsMenuTextUp" Or eSrc.className = "clsMenuTextDown" Then
        if eSrc.Id = "sapop" Or eSrc.Id = "idMenuExample" Then
            If eSrc.className = "clsMenuTextUp" Then
                eSrc.className = "clsMenuText"
            End If
        Else
            eSrc.className = "clsMenuText"
        End If
    ElseIf eSrc.className = "clsExamMenuTextUp" Or eSrc.className = "clsExamMenuTextDown" Then
        eSrc.className = "clsExamMenuText"
    End If
End Sub

Sub document_onmousedown()
    Dim eSrc

    On Error Resume Next
   'skip ie bug with disabled buttons
   If Not mbSpanButtionActive Then Exit sub

    set eSrc = window.event.srcElement

    If TypeName(eSrc) = "HTMLImg" Then
        Set eSrc = eSrc.parentElement
    End If

    If eSrc.className = "clsMenuTextUp" Then
        eSrc.className = "clsMenuTextDown"
    ElseIf eSrc.className = "clsExamMenuTextUp" Then
        eSrc.className = "clsExamMenuTextDown"
    End If
End Sub

Sub document_onmouseup()
    Dim eSrc

    On Error Resume Next
   'skip ie bug with disabled buttons
   If Not mbSpanButtionActive Then Exit sub

    set eSrc = window.event.srcElement

    If TypeName(eSrc) = "HTMLImg" Then
        Set eSrc = eSrc.parentElement
    End If

    If eSrc.className = "clsMenuTextDown" Then
      window.event.cancelBubble = true
        if eSrc.Id <> "sapop" Then
            eSrc.className = "clsMenuText"
        End If
    ElseIf eSrc.className = "clsExamMenuTextDown" Then
        window.event.cancelBubble = true
        eSrc.className = "clsExamMenuTextUp"
    End If
End Sub
'prevent button selection
Sub document_OnSelectStart()
   Dim eSrc,bCancle

    On Error Resume Next

    set eSrc = window.event.srcElement

    If TypeName(eSrc) = "HTMLImg" Then
        Set eSrc = eSrc.parentElement
    End If

   bCancle = (TypeName(eSrc) = "HTMLSpanElement")

   If not bCancle Then
      bCancle = (eSrc.Id = "example_body")
   End If

   If not bCancle Then
      bCancle = (eSrc.ClassName = "runninghead")
   End If

   If bCancle Then
      window.event.cancelBubble = True
      window.event.returnValue = False
   End If
End Sub
'end buttons

Function ReadXML(sFileName)
   Dim xmlDoc

   On Error Resume Next

   Set xmlDoc = CreateObject("microsoft.xmldom")

   xmlDoc.Load sFileName
   ReadXML = xmlDoc.xml

   Set xmlDoc = Nothing

End Function