path: root/testautomation/graphics/tools/id_tools.inc

'encoding UTF-8  Do not remove or change this line!
'**************************************************************************
'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
'* 
'* Copyright 2008 by Sun Microsystems, Inc.
'*
'* OpenOffice.org - a multi-platform office productivity suite
'*
'* $RCSfile: id_tools.inc,v $
'*
'* $Revision: 1.1 $
'*
'* last change: $Author: jsi $ $Date: 2008-06-16 10:43:16 $
'*
'* This file is part of OpenOffice.org.
'*
'* OpenOffice.org is free software: you can redistribute it and/or modify
'* it under the terms of the GNU Lesser General Public License version 3
'* only, as published by the Free Software Foundation.
'*
'* OpenOffice.org is distributed in the hope that it will be useful,
'* but WITHOUT ANY WARRANTY; without even the implied warranty of
'* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'* GNU Lesser General Public License version 3 for more details
'* (a copy is included in the LICENSE file that accompanied this code).
'*
'* You should have received a copy of the GNU Lesser General Public License
'* version 3 along with OpenOffice.org.  If not, see
'* <http://www.openoffice.org/license.html>
'* for a copy of the LGPLv3 License.
'*
'/************************************************************************
'*
'* Owner : wolfram.garten@sun.com
'*
'* short description : some tools (Functions)
'*
'******************************************************************

'Functions:
' #1 hFindSpellHypLanguage
' #1 GetDecimalSeperator
' #1 LiberalMeasurement
' #1 GetMeasUnit
' #1 StrToDouble
' #1 fGetPositionX
' #1 setStartCurrentPage
' #1 fIsDocumentWritable
' #1 fIsDocumentWritable
' #1 fGetSizeXY
' #1 hCallExport
' #1 checkexppdfwaitmax10sec
' #1 fCompareTwoValues
' #1 fConvertBackslashToSlash
' #1 hScreenFontAntialiasing
' #1 fSaveLoadAllFormats
' #1 setCharacterLanguage
' #1 toggleGermanSpellchecking
' #1 sAnalyseContextMenu
' #1 sLongToBinary
' #1 sBinaryToLong
' #1 fGetIntoDictionary
' #1 hSelectInList
' #1 hWalkTheStyles2
' #1 fGetSlideNumber
' #1 fGetSlideCount
' #1 fGetSlideName
' #1 fGetSetPageBackground
' #1 CreateTextSetEffectAndAngle
' #1 fGetPresentationStyle
' #1 hPrepareSearchBUG
' #1 makeNumOutOfText
' #1 wIgnorierenlisteLoeschen
' #1 optionstest
' #1 optionstest2


'\*****************************************************************

function hFindSpellHypLanguage (optional sBooks()) as string
'/// print all available languages that have a 'language module' ///'
    dim iListLength as integer
    dim i as integer
    dim sTemp as string

    '/// only necessarry for asian languages ///'
    if (bAsianLan or (iSprache=55)) then
        '/// Tools->Options ///'
        ToolsOptions
        '/// select from section 'Language Settings' the item 'Writing Aids' ///'
        hToolsOptions ("LANGUAGESETTINGS","WRITINGAIDS")
        '/// click button 'Edit...' in section 'Available language modules' ///'
        SprachmoduleBearbeiten.click
        kontext "ModuleBearbeiten"
        '/// print all entries from listbox 'Language' ///'
        for i = 1 to Sprache.GetItemCount
            sTemp = Sprache.GetItemText(i)
            if (NOT isMissing(sBooks())) then
                listAppend(sBooks(), sTemp)
            endif
            '/// return the first entry in the listbox ///'
            if i = 1 then hFindSpellHypLanguage = sTemp
        next i
        '/// close dialog 'Edit Modules' ///'
        ModuleBearbeiten.Close
        Kontext "ExtrasOptionenDlg"
        '/// close dialog 'Options - ' ///'
        ExtrasOptionenDlg.OK
        sleep 1
    endif
end function

'-------------------------------------------------------------------------------
function GetDecimalSeperator ( sDummy$ ) as String

'/// Input : number with fractionmark from 'NumericField' as String ///'
'///+ Output: '.' or ',' as String                                  ///'
   dim i1, i2 as integer

' get position of fraction mark / get IT
   i1 = instr (sDummy$, ",")
   i2 = instr (sDummy$, ".")
   if i1 > i2 then GetDecimalSeperator = "," else GetDecimalSeperator = "."
end function

'-------------------------------------------------------------------------------
function LiberalMeasurement ( sShould$, sActual$) as Boolean

    '/// Input : (1. Should, 2. Actual) as Number with or without MeasurementUnit 'NumericField' as String ///'
    '///+          if input has no MeasurementUnit i take it as 'cm' (was the default in old tests) ///'
    '///+ Output: Boolean are they likely the same?
    '/// NEEDED: mathematical proofment of iTolerance, by now just some guesses :-| ///'
    '/// reason for this function:///'
    '///+   because SO counts internaly in 'twip???s' 'twentieth of a point' there are some rounding errors ///'
    '///+ there are also some rounding errors because of the internal representatio of floating point numbers in computers ///'
    '///+   now lets try to get rid of them and have a nicer output in tests... ///'
    '/// measurement units are defined in http://gsl.openoffice.org/source/browse/gsl/vcl/source/src/units.src ///'
   
    dim iTolerance as Double

    LiberalMeasurement = False ' worst case

   'trivial
    if (sShould$ = sActual$) then
      LiberalMeasurement = True
    else
      ' check if measunit is the same !!
      if (GetMeasUnit(sShould$) <> GetMeasUnit(sActual$) ) then
         warnlog "In function LiberalMeasurement the measUnit is different, compare not possible yet"
      else
        ' set factor for liberality ;-)
        ' took units from http://gsl.openoffice.org/source/browse/gsl/vcl/source/src/units.src
         select case GetMeasUnit(sShould$)
            case "mm", "ミリ", "公厘" : iTolerance = 2.0             '01, 81,     88
            case "cm","センチ","厘米","公分"  : iTolerance = 0.5       '01, 81, 86, 88
            case chr$(34) : iTolerance = 2.5
            case "pi","ピクセル" : iTolerance = 2.5                 '01, 81
            case "pt",  "ポイント" : iTolerance = 2.5                '01, 81
            case "" : iTolerance = 1.5 ' cm is presubposition in old functions
         case else
            iTolerance = 2.5
            qaErrorLog "This Unit is not available in this function. '" + GetMeasUnit(sShould$) + "'"
         end select
         ' have to get the measurem unit, cause the offset is different for each :-(
         ' !!! val(str()) is important because of double calculating actions !!! #110996#
         if ( val(str(StrToDouble(sShould$)+iTolerance)) >= StrToDouble(sActual$) ) AND (val(str(StrToDouble ( sShould$ )-iTolerance)) <= StrToDouble ( sActual$ )) then
             LiberalMeasurement = True
         else
            LiberalMeasurement = False
            'printlog "LM: ---------------------------: "+sShould$ +":"+sActual$
         end if
         'printlog "### LibMeas: "+ (StrToDouble(sShould$) + iTolerance) +" - "+ StrToDouble(sShould$) +" - "+ (StrToDouble ( sShould$ ) - iTolerance)+" ; '"+GetMeasUnit(sShould$)+"'"
      end if
    end if
    'Printlog "+++++++++++++++++++++++++++++++++++++meas lib was here: "+LiberalMeasurement
end function

'-------------------------------------------------------------------------------
function GetMeasUnit ( sWert$ ) as String

    dim iBounder as integer
    '/// Input : Number with or without MeasurementUnit 'NumericField' as String ///'
    '///+ Output: Initials of MeasurementUnit as String or "" when only a number ///'

    iBounder = -1
    do
        inc iBounder
    loop until ( isNumeric(mid (sWert$, len(sWert$)-iBounder, 1)) OR (len(sWert$) <= (iBounder + 1)) )

   ' printlog right (sWert$, iBounder)
    if (len(sWert$) <= (iBounder + 1)) then
        if isNumeric(left (sWert$, 1)) then
            GetMeasUnit = right (sWert$, iBounder)
        else
            GetMeasUnit = sWert$
        endif
    else
        GetMeasUnit = right (sWert$, iBounder)
    endif
end function

'-------------------------------------------------------------------------------
function StrToDouble ( sWert$ ) as Double

    Dim sDummy$
    dim i, i1, i2 as integer
    dim a as integer
    dim b as integer
    dim c as double
    dim n as integer

    '/// Input : {'a[. ,]b[mm cm " pi pt]' with a, b as integer} as String ///'
    '///+ Output: a[. , ]b as double ///'

    ' get rid of measure unit, the only single character is '"' all others are two chars
    ' there was a problem, if there is NO meas.unit!!!
      if (isNumeric (sWert$) = FALSE) then
         if (  StrComp (right (sWert$, 1), chr$(34) ) = 0 ) then
            sDummy$ = Left ( sWert$, Len(sWert$)-1 )
         else
            sDummy$ = Left ( sWert$, Len(sWert$)-2 )
         endif
      else
         sDummy$ = sWert$
      endif
   ' get position of fraction mark
      i1 = instr (sDummy$, ",")  ' wrong output
      i2 = instr (sDummy$, ".")
      if i1 > i2 then i = i1 else i = i2
        ' in front of decimal seperator
         try
            a = val (left (sDummy$,i-1))
         catch
            'printlog sWert$ + ":" + sDummy$ + ":" + i + ":" + i1+ ":" + i2
         endcatch
      ' after the decimal seperator
         n = (len (sDummy$)-i)
         b = val (right (sDummy$, n) )
         c = b * 10 ^ -n
         'printlog "-------------- :"+sWert$ +" :'"+a+"' :"+n+" :"+b+" :'"+c+"':"
         ' !!! val(str()) is important because of double calculating actions !!! #110996#
         StrToDouble = val(str(a + c))
end function

'-------------------------------------------------------------------------------
function fGetPositionX () as string

   fGetPositionX = ""
   try
      ContextPositionAndSize
   catch
      warnlog "couldn't call 'ContextPositionAndSize' no object selected ?"
   endcatch
   kontext
   active.SetPage TabPositionAndSize
   kontext "TabPositionAndSize"
   if TabPositionAndSize.exists (5) then
      fGetPositionX = PositionX.GetText
      TabPositionAndSize.OK
   else
      warnlog "Couldn't switch tab page :-( "
   endif
end function

'-------------------------------------------------------------------------------
function setStartCurrentPage(optional bState as boolean) as boolean

    '/// tools->options ///'
    ToolsOptions
    '///+ select in section 'Presentation' tabpage 'general' ///'
    hToolsOptions ("Presentation","General")
        '///+ check the checkbox 'Always with current page' ///'
        setStartCurrentPage = MitAktuellerSeite.isChecked
        if bState then
            MitAktuellerSeite.Check
        else
            MitAktuellerSeite.UnCheck
        endif
    Kontext "ExtrasOptionenDlg"
    '///+ close dialog 'Options - Presenation - General' with OK ///'
    ExtrasOptionenDlg.OK
end function

'-------------------------------------------------------------------------------
function fIsDocumentWritable() as boolean

    '/// check if a document is writeable
    '/// <u>parameter:</u>
    '/// <u>return:</u>
    '/// true if the document is writeable otherwise false

    Kontext "Standardbar"
        if Bearbeiten.GetState(2) <> 1 then
            fIsDocumentWritable = false
        else
            fIsDocumentWritable = true
        endif

end function

'-------------------------------------------------------------------------------
function fMakeDocumentWritable() as boolean

    '/// make a document is writeable
    '/// <u>parameter:</u>
    '/// <u>return:</u>
    '/// true if the document can make writeable otherwise false

    Kontext "Standardbar"
    sleep (1)
        if Bearbeiten.GetState(2) <> 1 then
            Bearbeiten.Click
            Kontext
                if Active.Exists(1) then
                    Active.Yes
                    fMakeDocumentWritable = true
                else
                    warnlog "No messagebox after making document editable?"
                    fMakeDocumentWritable = false
                endif
        else
            printlog "Document is allready writable."
            fMakeDocumentWritable = true
        endif

end function

'-------------------------------------------------------------------------------

function fGetSizeXY (sX as string, sY as string, bGet as boolean) as Boolean
   dim sTx as string
   dim sTy as string
   dim bReturn as boolean

   bReturn = True
   try
      ContextPositionAndSize
   catch
      warnlog "couldn't call 'ContextPositionAndSize' no object selected ?"
   endcatch
   kontext
   active.SetPage TabPositionAndSize
   kontext "TabPositionAndSize"
   if TabPositionAndSize.exists (5) then
      sTx = Width.GetText
      sTy = Height.GetText
      TabPositionAndSize.OK
   else
      warnlog "Couldn't switch tab page :-( "
   endif
   if bGet then  ' Get the Values only
      sY = sTy
      sX = sTx
   else          ' Get the Values and COMPARE them
      if (LiberalMeasurement (sX,sTx) <> TRUE) then
         warnlog "width is different :-( should: '"+sX+"' is: '"+sTx+"'" + "eventually a result of i35519"
         bReturn = False
      endif
      if (LiberalMeasurement (sY,sTy) <> TRUE) then
         warnlog "hight is different :-( should: '"+sY+"' is: '"+sTy+"'" + "eventually a result of i35519"
         bReturn = False
      endif
      bGet = bReturn
   endif
end function

'-------------------------------------------------------------------------

function hCallExport ( HyWhatsYourName as String , sFilter as String, optional bSelection as boolean ) as Boolean
   hCallExport = TRUE
   Printlog "Will try to select export filter: '" + sFilter + "'" + ""
   try
      FileExport
   catch
      Sleep 10
      Warnlog "It takes to much time to export the graphic (>10 sec.). Please check the problem, maybe it's a bug!"
      FileExport
   endcatch

   Sleep (3)
   Kontext "ExportierenDlg"
   try
      Dateityp.Select sFilter
   catch
      Warnlog "'" + sFilter + "' is missing!"
      dim iAll, counter as integer
      iAll = Dateityp.GetItemCount
      printlog "   List of entries in the menu:"
      for counter = 1 to iAll
          printlog "   " + counter + "/" + iAll + ": " + Dateityp.GetItemText(counter)
      next counter
      hCallExport = FALSE
      ExportierenDlg.Cancel
      exit function
   endcatch
   if ((IsMissing(bSelection) = FALSE) AND (bSelection = TRUE)) then
      sleep 2
      Selektion.Check
   else
      if (Selektion.isEnabled) then
         Selektion.UnCheck
      endif
   endif

   if AutomatischeDateinamenserweiterung.Exists then
       QAErrorLog "OBSOLETE: Automatic file extension check-box in file dialog will be removed soon!"
       AutomatischeDateinamenserweiterung.check
   endif

   Dateiname.SetText ( HyWhatsYourName )
   sleep 2
   Speichern.Click
   sleep 2
   kontext "AlienWarning"
      if AlienWarning.exists(5) then
         warnlog "#i41983# Alien Warning on export not allowed"
         AlienWarning.OK
      endif
   Kontext "Active"
   if Active.Exists then Active.Yes
   Sleep 3
end function

'-------------------------------------------------------------------------
function checkexppdfwaitmax10sec

 dim i as integer
    kontext "Standardbar"
       i = 0
       do
         i = i + 1
	 sleep 1
         if (ExportAsPDF.isEnabled = TRUE) then i = 15
	 loop while ((i < 15))
       if (ExportAsPDF.isEnabled = FALSE) then
          Warnlog "ExportAsPDF was NOT ok. Waited " + i + " seconds."
       endif
       sleep (3)
end function

'-------------------------------------------------------------------------------
function fCompareTwoValues(a as string, b as string) as boolean

    dim c as boolean

    c = val(str(StrToDouble(a))) <> val(str(StrToDouble(b)))
    c = c AND (GetMeasUnit(a) <> GetMeasUnit(b))
    fCompareTwoValues = c
end function

'-------------------------------------------------------------------------------
function fConvertBackslashToSlash (sInput as string) as string

   dim i as integer
   dim sTemp as string
   dim sI as string
   dim x as integer

   sTemp = ""
   x = len (sInput)
   for i = 1 to x
      sI = mid(sInput, i, 1)
      if (sI = "\") then
         sI = "/"
      endif
      sTemp = sTemp + sI
   next i
   fConvertBackslashToSlash = sTemp
end function

'-------------------------------------------------------------------------------
function hScreenFontAntialiasing (bEnable as boolean) as boolean

   ToolsOptions
   hToolsOptions ("STAROFFICE", "VIEW")
   hScreenFontAntialiasing = FontAntiAliasing.IsChecked
   if (bEnable) then
      FontAntiAliasing.Check
   else
      FontAntiAliasing.Uncheck
   endif
   Kontext "ExtrasOptionenDlg"
   ExtrasOptionenDlg.OK
end function

'-------------------------------------------------------------------------------
function fSaveLoadAllFormats (NewFileDir as String)

    Dim iFileTypeCounter as Integer
    Dim SavedFile(30) as String
    Dim iCounter as Integer
   
    printlog "Save the document in different formats..."
    FileSaveAs
    kontext "ExportierenDlg"
    For iFileTypeCounter = 1 to Dateityp.GetItemCount
        sleep (1)
        if iFileTypeCounter > 1 then 
            WaitSlot (2000)
            FileSaveAs
            kontext "ExportierenDlg"
        endif
        Dateiname.SetText (ConvertPath (NewFileDir) + "file" + iFileTypeCounter)
            Dateityp.Select (iFileTypeCounter)
            sleep (1)
            Printlog "   Saving file: " + (ConvertPath (NewFileDir) + ("file" + (iFileTypeCounter) + "." + left(right(Dateityp.GetSelText,4),3)))
            SavedFile(iFileTypeCounter) = ("file" + (iFileTypeCounter) + "." + left(right(Dateityp.GetSelText,4),3))
            Speichern.Click
            Kontext "Active"
            if Active.Exists(2) then Active.Yes ' File already exists, overwrite?
            '        printlog " Saved file ( SavedFile(" + iFileTypeCounter + ") ) as: '" + SavedFile(iFileTypeCounter) +"'."
            Kontext "AlienWarning"
            if AlienWarning.Exists(2) then AlienWarning.OK
            kontext "DocumentImpress"
    Next iFileTypeCounter
    printlog "Close the file."
    FileClose

    printlog "Load the different files."
    iCounter = 0
    For iCounter = 1 to (iFileTypeCounter-1)
        Printlog "   Will try to open: " + (ConvertPath (NewFileDir) + SavedFile(iCounter))
        CALL hFileOpen(ConvertPath (NewFileDir) + SavedFile(iCounter))
        CALL hCloseDocument
        printlog "   Will try to delete: " + (ConvertPath (NewFileDir) + SavedFile(iCounter))
        app.Kill (ConvertPath (NewFileDir) + SavedFile(iCounter))
    Next iCounter

end function
'-------------------------------------------------------------------------------
function setCharacterLanguage(sLanguage as string) as boolean

    setCharacterLanguage = FALSE
    FormatCharacter
    WaitSlot (1000)
    Kontext
    Messagebox.SetPage TabFont
    kontext "TabFont"
        sleep 1
        printlog "sLanguage = " + sLanguage
        if (bAsianLan) then  'Eastern languages  'OR 
            try
                printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
                LanguageWest.select (sLanguage) 'East
            catch
                printlog "Language.GetSelText = " + Language.GetSelText
                Language.select (sLanguage) 'East
            endcatch

            setCharacterLanguage = TRUE
        elseif (iSprache = 07) then 
            printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
            LanguageWest.select (sLanguage)
        else
            try
                printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
                LanguageWest.select (sLanguage)
            catch
                printlog "Language.GetSelText = " + Language.GetSelText
                Language.select (sLanguage)
            endcatch
            setCharacterLanguage = TRUE
        end if
    TabFont.Ok
    sleep 1
end function

'-------------------------------------------------------------------------------
function toggleGermanSpellchecking as string

    '/// activate old german spellchecking ///'
    '///+ Tools->Options ///'
    ToolsOptions
    '///+ select tabpage 'writing aids' in category 'Languagesettings' ///'
    hToolsOptions("LANGUAGESETTINGS","WRITINGAIDS")
    kontext "TabLinguistik"
        '///+ hopefully it never changes for any reason between the languages!: select the 8th entry 'German spelling - old' ///'
        printlog " - 'German Spelling - old' ?= " + Optionen.getItemText(8)
        Optionen.select(8)
    '///+ default is 'unselected' - i can't check it automatically - so i depend on it! ///'
    '///+ press [space] to select it///'
    Optionen.typeKeys "<space>"
    Kontext "ExtrasOptionenDlg"
        '///+ close options with OK button ///'
        ExtrasOptionenDlg.OK
end function

'-------------------------------------------------------------------------------
function sAnalyseContextMenu(iItems as integer, optional iError as long) as integer

    dim i as integer
    dim y as integer
    dim w as integer
    dim x as integer
    dim z as integer
    dim f as string
    dim iSlot as integer
    dim iSpecialCharacterEntry as integer
    dim bNoContextMenu as boolean
    dim iTemp as long
    dim sCandidates(5) as string
    dim bDifferent as boolean
    dim iInternError as long
    dim iError1 as long  ' misplaced
'    i22192: context menu opens not on cursor position
    dim iError2 as long  ' no context menu

    '/// goto start of textbox ///'
    call hTypeKeys "<mod1 home>"
    '/// for every word, check the context menu to get suggestions for correction ///'
    for i = 0 to (iItems-1)
        '/// copy current word to clipboard ///'
        call hTypeKeys "<Shift mod1 right>"
        EditCopy
        sCandidates(1) = getClipboardText()
        if (" " = right(sCandidates(1),1)) then
            sCandidates(1) = left(sCandidates(1),len(sCandidates(1))-1)
        end if
        call hTypeKeys "<mod1 left>"
        '/// open context menu ///'
        printlog "   About to call the ContextMenu."
        call hOpenContextMenu()
        sleep 3
        printlog "   Just opened ContextMenu."
        ' collecting criteria for underlining:
        ' 1st one: is word selected? yes: underlined;

        '/// If the string "vnd.sun.search:SubMenu" (the SunSearch-menu) is found in the menu, we'll skip that word. ///'

        'Get first entry. 
        f = MenuGetItemCommand (MenuGetItemID (1))
        printlog "f = '" + f + "'."
        'If it's "vnd.sun.search:SubMenu" , then skip the word. Printlog "Word not underlined, Search-Toolbar active."
        if f <> "vnd.sun.search:SubMenu" then 
            try          ' WorkAround ##
                editcopy
                sCandidates(2) = getClipboardText()
    '            printlog "******************* " + getclipboardtext()
            catch
                sCandidates(2) = ""
    '            printlog "###################################################"
            endcatch
            ' if (1) is different from nonempty (2) then the wrong word is selected
            if (sCandidates(1) <> sCandidates(2)) then
                if ("" <> sCandidates(2)) then
    '                printlog "############ " + sCandidates(1) + " ################## " + sCandidates(2) + " #####################"
                    bDifferent = TRUE
                    iError1 = iError1 + (2^i)
                else
                    bDifferent = false
                    ' no word is selected... a) not underlined b) no context menu open
                end if
            else
        '        printlog "******************* " + sCandidates(1)
                bDifferent = FALSE
            end if
            ' check if context menu opened
            try
                x = hMenuItemGetCount
                ' successfully opened context menu
                bNoContextMenu = false
            catch
                ' context menu not open
                bNoContextMenu = true
                iError2 = iError2 + (2^i)
                ' in writer it would work... :-( #i23568#
        '       warnlog ""+i+" C: " + x + ";------ " + getClipboardText + " -------- "
            endcatch
            ' if context menu open do....
            if (not bNoContextMenu) then
        '        printlog ""+i+" C: " + x + ";------ " + getClipboardText + " -------- " + hMenuItemGetText(1)
                '/// analyze context menu entries ///'
                for y = 1 to x
                    z = hMenuGetItemId(y)
                    if (1 = y) then iSlot = z  ' criteria for WorkAround
                    if (z = 27019) then iSpecialCharacterEntry = y    ' entry to select for WorkAround
                    Printlog ("---i: "+ y +"; " + z + "  ; " +hMenuItemGetText(y) + " ; " + hMenuGetItemCommand(y))
                next y
                '/// if first slot not a spelling suggestion -> WorkAround 112919 ///'
                '/// close Context Menu ///'
                if (iSlot <> 10456) then
                    if (not bDifferent) then  ' WorkAround ##
    '                qaerrorlog "" + iSlot + " UNDERLINED"
                        iTemp = iTemp + (2^i)
                    end if
                    call hMenuClose()
                else
    '                printlog "" + iSlot + " not underlined"
                    'InsertSpecialCharacterDraw
                    hMenuSelectNr(iSpecialCharacterEntry)  ' because of bug #112919#
                    kontext "Sonderzeichen"
                    Sonderzeichen.Cancel '
                end if
            end if
        else
            Printlog "Word not underlined, Search-Toolbar active."
            call hMenuClose()
        end if
        Sleep (1)
        '/// goto next word with keys [strg]+[right] ///'
        call hTypeKeys "<mod1 right>"
    next i
    '/// leave textbox edit mode ///'

    iInternError = iError1 OR iError2
    if (iError1 > 0) then
        qaErrorLog "#i22192#: context menu opens not on cursor position"
        printlog "" + sLongToBinary(iError1, 11)
    end if
    if (iError2 > 0) then
        qaErrorLog "#i23568# context menu doesn't open in redlining mode before a punctuation mark"
        printlog "" + sLongToBinary(iError2, 11)
    end if
    if (not isMissing(iError)) then
        iError = iInternError
    end if
    sAnalyseContextMenu = iTemp
end function

'-------------------------------------------------------------------------------
function sLongToBinary(iTempIn as long, iCount as integer) as string

    ' lsb left !
    dim sTemp as string
    dim i as integer
    dim iMask as long
    dim itemp as long

    itemp = itempin

    for i = 1 to iCount
        iMask = iMask + (2^(i-1))
    next i

    sTemp = ""
    iTemp = Itemp AND iMask
    for i = 1 to iCount
        if ((iTemp MOD 2) = 1) then
            sTemp = sTemp + "1"
        else
            sTemp = sTemp + "0"
        end if
        iTemp = INT (iTemp / 2)
    next i
    sLongToBinary = sTemp
end function

'-------------------------------------------------------------------------------
function sBinaryToLong(sTempIn as String) as long

    ' lsb left !
    dim iTemp as long
    dim i as integer
    dim sTemp as string

    sTemp = sTempin

    for i = 1 to len(sTemp)
        if (mid(sTemp, i, 1) = "1") then
            iTemp = itemp + (2^(i-1))
        end if
    next i
    sBinaryToLong = iTemp
end function

'-------------------------------------------------------------------------------
function fGetIntoDictionary as boolean
    dim bFound as boolean
    dim iBooks as integer
    dim i as integer

    iBooks = Benutzerwoerterbuch.GetItemCount
    i=0
    bFound=TRUE
    while (bFound AND (i < iBooks))
        inc i
        Benutzerwoerterbuch.select i
        printlog Benutzerwoerterbuch.getSelText + i
        try
            Bearbeiten.Click
            bFound = FALSE
        catch
            printLog "wIgLi" + i
        endcatch
    wend
    fGetIntoDictionary = bFound
end function

'-------------------------------------------------------------------------------
function hSelectInList (window, sEntry as String) as Boolean

'/// alternativ method to 'hDoubleClickInList' (without mouse) ///'
'///+ window: name of list ///'
'///+ sEntry: string to find in list ///'
'///+ ReturnValue: if found: TRUE; else FALSE ///'
    Dim i as Integer
    Dim sTemp as String
    Dim sLastTemp as String

    '/// go through list from bottom and stop on the entry sEntry ///'
    window.TypeKeys "<End>"
    sTemp = ""
    do
        sLastTemp = sTemp
        sTemp = window.GetText
        window.TypeKeys "<Up>"
    loop while ((sEntry <> sTemp) AND (sLastTemp <> sTemp))
    '/// press key [Return] ///'
    if (sEntry = sTemp) then
        window.TypeKeys "<Return>"
        hSelectInList = TRUE
    else
        hSelectInList = FALSE
    endif
end function

'-------------------------------------------------------------------------------
function hWalkTheStyles2 (atemp)

    'function hWalkTheStyles2 (bSet as boolean, aSettings(), atemp as variant) as string
    dim i as integer
    dim x as integer
    dim itemp
    dim bSet
    dim aSettings(5,5)
'    dim atemp

    '/// Organizer ///'
    i=1
    Kontext
    printlog aSettings(i,3)
    printlog aSettings(i,2)
    printlog val(aSettings(i,1))
    printlog atemp
    Messagebox.SetPage TabArea
        kontext "TabArea"
        'press button standard :-))))))
    atemp = Hatching
    printlog atemp

        if aSettings(i,3) then
        itemp = val(aSettings(i,1))
        printlog isobject(atemp)
        printlog isNumeric(atemp)
        Hatching.check
        atemp.check

    else
'        aSettings(i,1).Uncheck
    endif
    'print "baeh"
    i=2
    Kontext
    Messagebox.SetPage TabSchatten
        kontext "TabSchatten"

    Kontext
    Messagebox.SetPage TabVerwalten
        kontext "TabVerwalten"
        '/// Line ///'
    i=2
    Kontext
    Messagebox.SetPage TabLinie
        kontext "TabLinie"
        'Context: *Line; Line Styles; Arrow Styles
        '/// Area ///'
    i=3
    Kontext
    Messagebox.SetPage TabArea
        kontext "TabArea"
        'Context: *Area; *Shadow; Transparency; Colors; Gradients; Hatching; Bitmaps
        '/// Shadowing ///'
    i=4
    Kontext
    Messagebox.SetPage TabSchatten
        kontext "TabSchatten"
        '/// Transparency ///'
    i=5
    Kontext
    Messagebox.SetPage TabTransparenz
        kontext "TabTransparenz"
        '/// Font ///'
    i=6
    Kontext
    Messagebox.SetPage TabFont
        kontext "TabFont"
        'Context: *Font; *Font Effect; Position
        '/// Font Effect ///'
    i=7
    Kontext
    Messagebox.SetPage TabFontEffects
        kontext "TabFontEffects"
        '/// Indents & Spacing ///'
    i=8
    Kontext
    Messagebox.SetPage TabEinzuegeUndAbstaende
        kontext "TabEinzuegeUndAbstaende"
        'Context: *Indents & Spacing; *Alignment; *Tabs
        '/// Text ///'
    i=9
    Kontext
    Messagebox.SetPage TabText
        Kontext "TabText"
        'Context: *Text; *Text Animation
        '/// Text Animation ///'
    i=10
    Kontext
    Messagebox.SetPage TabLauftext
        Kontext "TabLauftext"
        '/// Dimensioning ///'
    i=11
    Kontext
    Messagebox.SetPage TabBemassung
        Kontext "TabBemassung"
        '/// Connector ///'
    i=12
    Kontext
    Messagebox.setpage TabVerbinder
        Kontext "TabVerbinder"
        '/// Alignment ///'
    i=13
    Kontext
    Messagebox.setpage TabAusrichtungAbsatz
        Kontext "TabAusrichtungAbsatz"
        '/// Tabs ///'
    i=14
    Kontext
    Messagebox.setpage TabTabulator
        Kontext "TabTabulator"

'    '/// switch to tabpage 'Bullets' ///'
'      Messagebox.SetPage TabBullet
'      Kontext "TabBullet"
'      sleep 1
'      Call DialogTest (TabBullet)
'      sleep 1
'      Kontext
'    '/// switch to tabpage 'Numbering Type' ///'
'      Messagebox.SetPage TabNumerierungsart
'      Kontext "TabNumerierungsart"
'      sleep 1
'      Call DialogTest (TabNumerierungsart)
'      sleep 1
'      Kontext
'    '/// switch to tabpage 'Graphics' ///'
'      Messagebox.SetPage TabGrafiken
'      Kontext "TabGrafiken"
'      sleep 1
'      Call DialogTest (TabGrafiken)
'      sleep 1
'      Kontext
'    '/// switch to tabpage 'Customize' ///'
'      Messagebox.SetPage TabOptionenNumerierung
'      Kontext "TabOptionenNumerierung"
'      sleep 1
'      Call DialogTest (TabOptionenNumerierung)
'      sleep 1
end function

'-------------------------------------------------------------------------------
function fGetSlideNumber (optional sCompare as integer) as integer

    '/// PRESUPPOSITION: open Navigator ///'
    '///+ ENTRY: with or without a string ///'
    '///+ if string is given, it is compared with the actual selected slidename in the navigator, if not equal print warnlog ///'
    '///+ RETURN:  selected slidename in the navigator / empty string if navvigator is not open ///'
    '///+ EXIT: kontext on  DocumentPresentation ///'

    Kontext "NavigatorDraw"
    printlog "Checking if navigator is open, closing and opening for updating.."
    if NavigatorDraw.exists (5) then
        ViewNavigator ' to Workaround not updated navi :-(
        sleep 3
        ViewNavigator
        sleep 3
        '/// check in list, if the page changed ///'
        
    else
        printlog "If Navigator is not open, opening it now."
        ViewNavigator
    endif
    WaitSlot (2000)
    printlog "Getting current slide number from navigator."
    fGetSlideNumber = val (right (Liste.GetSelText, 1))
    printlog "fGetSlideNumber has the value " & fGetSlideNumber
    printlog "Checking if slidenumber fits to Compare number, if this is given behind procedure call."
    if (isMissing (sCompare) = False) then ' if optional parameter exists
        if fGetSlideNumber <> sCompare then
            printlog "Warnlog if Slidenumber is not what it should be."
            Warnlog "Slide Number is '" + fGetSlideNumber + "'; should: '" + sCompare + "'"
        endif
    endif
    Kontext "DocumentPresentation"
end function

'-------------------------------------------------------------------------------
function fGetSlideCount (optional iCount as integer) as integer

    '/// purpose: open navigator in impress and check/get number of slides from listbox ///'
    '///+ input  : optional number of slides, to compare to: if different warnlog ///'
    '///+ output : number of slides in presentation ///'
    dim i as integer

   '/// open navigator ///'
   Kontext "Navigator"
   if Navigator.exists then
      Printlog "Navigator: open :-)"
   else
      Printlog "Navigator: NOT available :-( will be opened now!"
      ViewNavigator
   endif
   Sleep 1
   '/// count rows in list of navigator: usually number of slides ///'
   Kontext "NavigatorDraw"
   i = Liste.GetItemCount
   if (isMissing(iCount) = FALSE) then
      if (i <> iCount) then
         Warnlog "Error! Expected slides: '" + iCount + "'; but are '" + i +"'"
      else
         Printlog "ok"
      endif
   endif
   '/// close navigator ///'
   ViewNavigator
   fGetSlideCount = i
end function

'-------------------------------------------------------------------------------
function fGetSlideName (optional sCompare as string) as string

'/// PRESUPPOSITION: open Navigator ///'
'///+ ENTRY: with or without a string ///'
'///+ if string is given, it is compared with the actual selected slidename in the navigator, if not equal print warnlog ///'
'///+ RETURN:  selected slidename in the navigator / empty string if navvigator is not open ///'
'///+ EXIT: kontext on  DocumentPresentation ///'

   Kontext "NavigatorDraw"
   if NavigatorDraw.exists (5) then
      sleep 3
      printlog "check in list, if the page changed"
      fGetSlideName = Liste.GetSelText
   else
      warnlog "Navigator not open! in function fGetSlideName TBO"
      Kontext "NavigatorDraw"
      fGetSlideName = ""
   endif
   if (isMissing (sCompare) = False) then ' if optional parameter exists
   printlog "fGetSlideName is: " & fGetSlideName
   printlog "sCompare is: " & sCompare
      if fGetSlideName <> sCompare then
         warnlog "   Slide Name is '" + fGetSlideName + "'; should be: '" + sCompare + "'"
      endif
   endif
   Kontext "DocumentPresentation"
end function

'------------------------------------------------------------------------------
function fGetSetPageBackground (iSelect as integer, iWhere as integer) as integer

'/// Get or Set the Page Background via stylist (iWhere = 0) or format menue (...= 1) ///'
'///+ if iSelect > 0 then set, else get ///'
'///+ return selected color number or -1 on error ///'

   if (iWhere = 0) then
      '/// Stylist -> Background -> Kontext menu -> modify -> Area -> Color ///'
      fGetSetPageBackground = -1 ' worst case
      Kontext "Stylist"
      if Stylist.NotExists (5) then
         FormatStylist
        Kontext "Stylist"
        if Stylist.NotExists (5) then warnlog "Could not open stylist :-("
      end if
      Praesentationsvorlagen.Click
      sleep 1
      Vorlagenliste.TypeKeys "<PAGEDOWN>"
      hDoubleClickInList (vorlagenliste, glLocale(5), TRUE)
      sleep 1
      vorlagenliste.OpenContextMenu
      sleep 1
      hMenuSelectNr (1)
   else
      '/// Format -> Page -> Background -> Color ///''FormatPage
      sleep 1
      try          ' this was just paranoia to find a not mentioned messagebox
         FormatSlideDraw
      catch
         warnlog "slooooow slot TBO :-("
         exit function
      endcatch
      sleep 1
      Kontext
      if (active.getrt = 373) then
        Active.SetPage TabArea
      else
         warnlog active.getrt
         if (active.getrt = 304) then
         warnlog active.gettext
         endif
      endif        ' paranoia end ----------------------------------------------
   endif

   kontext "TabArea"
   if TabArea.exists then
      FillOptions.Select 2 ' Select "Colour"
      if (iSelect > 1) then   ' Select the entry
'         Color.Check
         if (iSelect < ColourList.GetItemCount) then
            ColourList.Select iSelect
         else
            warnlog "Select entry is larger than list :-("
         endif
         fGetSetPageBackground = ColourList.GetSelIndex
         if fGetSetPageBackground = 0 then
            warnlog "There were no color selected in the list."
         endif
         TabArea.OK
         sleep 2
         kontext
         if (active.exists (2)) then
            warnlog "active about <changing the background for all pages ?>: '" + active.gettext + "'"
            active.yes
         else
            printlog "No message about 'changing the background for all pages ?' :-("
         endif
      else ' yust read the selected entry
         if FillOptions.GetSelIndex = 2 then
            fGetSetPageBackground = ColourList.GetSelIndex
            TabArea.Cancel
         else
            warnlog "Can't get value, because something different than color is selected :-("
         endif
      endif
   else
   kontext "TabFont"
      if TabFont.exists then
         Warnlog "Something wrong with the word " + glLocale(5) + ". It was either not found or wrong."
      else
	 warnlog "Error: Can't get context menu ?"
      endif
   endif

   if (iWhere = 0) then
        sleep 1 ' ABSOLUT NECESSARRY !!! (TBO) else crash on UNIX on following command!!!!
        FormatStylist ' closing
   endif
   sleep 4
end function

'------------------------------------------------------------------------------
function CreateTextSetEffectAndAngle

    kontext "DocumentImpress"
    SetClipBoard "Revenue"
    DocumentImpress.TypeKeys "<MOD1 V>"
    SlideShowCustomAnimation
        Kontext "Tasks"
        WaitSlot (1000)
        EffectAdd.Click
        kontext
        '/// Switch to TabPage: Entrance ///'
        active.setPage(TabEntrance)
        kontext "TabEntrance"
            if TabEntrance.exists(5) then
                '/// select in the listbox 'Effects' the second entry///'
                Effects.select (24)
                '/// select speed 'Fast' -> fourth item in list ///'
                Speed.Select 2
                TabEntrance.OK
            end if
        kontext "tasks"
        EffectStart.TypeKeys "<HOME><DOWN>" 'Select the second entry.

        kontext "DocumentImpress"
        FormatPositionAndSize
        WaitSlot (1000)
        kontext
        active.setPage(TabDrehung)
        kontext "TabDrehung"

        Winkel.TypeKeys "45"
    TabDrehung.OK
    WaitSlot (1000)
    kontext "DocumentImpress"
end function

'-------------------------------------------------------------------------------
function fGetPresentationStyle (optional sCompare as integer) as integer

    '///+ ENTRY: with or without a string ///'
    '///+ if string is given, it is compared with the LAST CHARACTER of the actual selected style in the stylist, if not equal print warnlog ///'
    '///+ RETURN:  LAST CHARACTER of the actual selected style in the stylist ///'
    dim sTemp as integer
    dim sTemp0 as string
    
    sTemp = (-1)
    '/// open stylist if not already open: Format->Stylist ///'
    kontext "Stylist"
    if (Stylist.exists = FALSE) then
      try
         FormatStylist
      catch
         sleep 1
      endcatch
    endif
    kontext "Stylist"
    if Stylist.exists(5) then
      sTemp0 = Vorlagenliste.GetSeltext
      sTemp = val(right (sTemp0, 1))
      if (isMissing (sCompare) = False) then ' if optional parameter exists
         if sTemp <> sCompare then
            Warnlog "Style Name's last character is '" + sTemp + "'; should be: '" + sCompare + "'"
         endif
      endif
      FormatStylist
    else
      Warnlog "The Stylist could not be opened for unknown reasons  :-("
    endif
    fGetPresentationStyle = sTemp
end function

'-------------------------------------------------------------------------------
function hPrepareSearchBUG

    '   warnlog "TBO: WA for bug #101974#"
    '      Kontext "DocumentImpressOutlineView"
    '      DocumentImpressOutlineView.TypeKeys ("<mod1 home>")
end function

'-------------------------------------------------------------------------------
function makeNumOutOfText ( sNum as String ) as String

    Dim sDummy as String
    Dim iComma as Integer

    iComma = Instr ( sNum, "," )
    if iComma <> 0 then
        sDummy = Left ( sNum, iComma-1 ) + "." + Mid ( sNum, iComma+1, len ( sNum )-2 )
    else
        sDummy = Left ( sNum, len (sNum)-2 )
    end if
    makeNumOutOfText = sDummy
end function

'-------------------------------------------------------------------------
function wIgnorierenlisteLoeschen as boolean

    Dim i as integer
    Dim j as integer
    dim iBooks as integer

    ToolsOptions
    Call hToolsOptions("LANGUAGESETTINGS","WRITINGAIDS")
    Sleep 3
    if (fGetIntoDictionary) then
        qaErrorLog "wIgLi"
        wIgnorierenlisteLoeschen = FALSE
        exit function
    end if
    Kontext "BenutzerwoerterbuchBearbeiten"
        sleep 1
        iBooks = Buch.GetItemCount
        for i = 1 to iBooks
            Buch.Select i
            if Left$(Buch.GetSelText,13)="IgnoreAllList" then
                sleep 2
                while (Loeschen.IsEnabled)
                    Loeschen.Click
                    sleep 1
                wend
            end if
        next i
    Kontext "BenutzerwoerterbuchBearbeiten"
        BenutzerwoerterbuchBearbeiten.Cancel
    Kontext "ExtrasOptionenDlg"
        ExtrasOptionenDlg.OK
        wIgnorierenlisteLoeschen = TRUE
end function

'-------------------------------------------------------------------------------
function optionstest

    dim filedialogue as boolean
    dim lala as integer
    dim optsound as integer
    dim os as integer
    dim oa as integer
    dim odc as integer
    dim ota as integer
    dim ets as integer
    dim etspeed as integer
    dim etrep as integer
    dim etshap as integer
    dim etgt as integer

     Kontext "Tasks"
        EffectOptions.Click
        kontext "TabEffect"
        if TabEffect.Exists(5) then
           optsound = Sound.GetItemCount
           for os = 1 to optsound
               Sound.Select os
               kontext "OeffnenDlg"
               if OeffnenDlg.Exists (5) then
                  filedialogue = TRUE
                  OeffnenDlg.Close
                  kontext "TabEffect"
               else
                  kontext "TabEffect"
               endif
           next os
           if AfterAnimation.isEnabled AND AfterAnimation.isVisible then
              for oa = 1 to AfterAnimation.GetItemCount
                  AfterAnimation.Select oa
                  if DimColor.isEnabled then
                     for odc = 1 to DimColor.GetItemCount
                         DimColor.Select odc
                     next odc
                  endif
                  if DelayBetweenCharacters.isEnabled then
                     for odc = 1 to DelayBetweenCharacters.GetItemCount
                         DelayBetweenCharacters.Select odc
                     next odc
                  endif
              next oa
           else
              if DelayBetweenCharacters.isEnabled then
                 for odc = 1 to DelayBetweenCharacters.GetItemCount
                     DelayBetweenCharacters.Select odc
                 next odc
              endif
           endif
           for ota = 1 to TextAnimation.GetItemCount
               TextAnimation.Select ota
           next ota
           '/// switch to TabPage 'Timing' ///'
           Kontext
           Active.SetPage TabTiming
           kontext "TabTiming"
           if TabTiming.Exists(5) then
              for ets = 1 to TimingStart.GetItemCount
                  TimingStart.Select ets
              next ets
              if Delay.isVisible AND Delay.isEnabled then
                 Delay.GetText
              else
                 Warnlog "Delay in Effect Options were not to be found."
              endif
              if Speed.isVisible AND Speed.isEnabled then
                 for etspeed = 1 to Speed.GetItemCount
                     Speed.Select etspeed
                 next etspeed
              else
                 printlog " No Speed-entry for this effect."
              endif
              if Repeat.isVisible AND Repeat.isEnabled then
                 for etrep = 1 to Speed.GetItemCount
                 Repeat.Select etrep
                 next etrep
              else
                 Printlog "Repeat in Effect Options were not to be found."
              endif
              Rewind.Check
              Rewind.UnCheck
              TriggerAnimate.IsChecked
              TriggerStart.IsChecked
              if Shape.isVisible AND Shape.isEnabled then
                 for etshap = 1 to Shape.GetItemCount
                 Shape.Select etshap
                 next etshap
              else
                 Warnlog "Shape in Effect Options were not to be found."
              endif
           else
              warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: Timing TabPage didn't work."
           endif
           '/// switch to TabPage 'Timing' ///'
           Kontext
           active.setPage TabTextAnimation
           kontext "TabTextAnimation"
           if TabTextAnimation.Exists(5) then
              lala = GroupText.GetItemCount
              for etgt = 1 to lala
                  GroupText.Select etgt
                  if AutomaticallyAfter.IsEnabled then
                     AutomaticallyAfter.Check
                     AutomaticallyAfter.TypeKeys "<UP>"
                  endif
                  if AnimateAttachedShape.IsEnabled then
                     AnimateAttachedShape.Check
                     if AnimateAttachedShape.IsChecked = FALSE then
                        Warnlog "AnimateAttachedShape should have been checked"
                     endif
                  endif
                  if InreverseOrder.IsEnabled then
                     InreverseOrder.Check
                     if InreverseOrder.IsChecked = FALSE then
                        Warnlog "InreverseOrder should have been checked"
                     endif
                  endif
              next etgt
              TabTextAnimation.Cancel
           else
              warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: TextAnimation TabPage didn't work."
           endif
        else
           warnlog "Impress:Tasks Pane:Custom Animation:... button didn't work."
        endif
        Kontext "Tasks"
        
end function

'-------------------------------------------------------------------------------
function optionstest2

    dim filedialogue as boolean
    dim lala as integer
    dim optsound as integer
    dim os as integer
    dim oa as integer
    dim odc as integer
    dim ota as integer
    dim ets as integer
    dim etspeed as integer
    dim etrep as integer
    dim etshap as integer
    dim etgt as integer

     Kontext "Tasks"
        EffectOptions.Click
        kontext "TabEffect"
        if TabEffect.Exists(5) then
           Sound.Select 5
           sleep 4
           if Play.IsEnabled then
              Play.Click
           else
              warnlog "   Play should have been enabled after selecting a sound."
           endif
           AfterAnimation.Select 2
           if DimColor.isEnabled then
              DimColor.Select 5
           else
              Warnlog "DimColor should have been enabled"
           endif
           TextAnimation.Select 3
           if DelayBetweenCharacters.isEnabled then
              DelayBetweenCharacters.More 5
           else
              Warnlog "DelayBetweenCharacters should have been enabled"
           endif
           '/// switch to TabPage 'Timing' ///'
           Kontext
           Active.SetPage TabTiming
           kontext "TabTiming"
           if TabTiming.Exists(5) then
              TimingStart.Select 2
              if Delay.isVisible AND Delay.isEnabled then
                 Delay.More 5
              else
                 Warnlog "Delay in Effect Options were not to be found."
              endif
              if Speed.isVisible AND Speed.isEnabled then
                 Speed.Select 3
              else
                 Printlog "Speed in Effect Options were not to be found."
              endif
              if Repeat.isVisible then
                 if Repeat.isEnabled then
                    for etrep = 1 to Speed.GetItemCount
                        Repeat.Select etrep
                    next etrep
                 else
                    Warnlog "Repeat in Effect Options were not enabled."
                 endif
              else
                 Warnlog "Repeat in Effect Options were not visible."
              endif
              if Rewind.isVisible then
                 if Rewind.isEnabled then
                    Rewind.Check
                 else
                    Printlog "Rewind in Effect Options were not to be found."
                 endif
              else
                 Printlog "Rewind in Effect Options were not to be found."
              endif
              if Rewind.isVisible then
                 if Rewind.isEnabled then
                    Rewind.Check
                    Rewind.UnCheck
                 else
                    Warnlog "Rewind in Effect Options were not enabled."
                 endif
              else
                 Warnlog "Rewind in Effect Options were not visible."
              endif
              TriggerAnimate.IsChecked
              TriggerStart.IsChecked
              if Shape.isVisible then
                 if Shape.isEnabled then
                    for etshap = 1 to Shape.GetItemCount
                        Shape.Select etshap
                    next etshap
                 else
                    Warnlog "Shape in Effect Options were not to be found."
                 endif
              else
                 Warnlog "Shape in Effect Options were not to be found."
              endif
           else
              warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: Timing TabPage didn't work."
           endif
           '/// switch to TabPage 'Timing' ///'
           Kontext
           active.setPage TabTextAnimation
           kontext "TabTextAnimation"
           if TabTextAnimation.Exists(5) then
              lala = GroupText.GetItemCount
              for etgt = 1 to lala
                  GroupText.Select etgt
                  if AutomaticallyAfter.IsEnabled then
                     AutomaticallyAfter.Check
                     AutomaticallyAfter.TypeKeys "<UP>"
                  endif
                  if AnimateAttachedShape.IsEnabled then
                     AnimateAttachedShape.Check
                     if AnimateAttachedShape.IsChecked = FALSE then
                        Warnlog "AnimateAttachedShape should have been checked"
                     endif
                  endif
                  if InreverseOrder.IsEnabled then
                     InreverseOrder.Check
                     if InreverseOrder.IsChecked = FALSE then
                        Warnlog "InreverseOrder should have been checked"
                     endif
                  endif
              next etgt
              TabTextAnimation.Cancel
           else
              warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: TextAnimation TabPage didn't work."
           endif
        else
           warnlog "Impress:Tasks Pane:Custom Animation:... button didn't work."
        endif
        Kontext "Tasks"
        
end function
'-------------------------------------------------------------------------------