testautomation/writer/tools/includes/w_tool6.inc

   1 'encoding UTF-8  Do not remove or change this line!
   2 '*******************************************************************************
   3 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 '*
   5 '* Copyright 2008 by Sun Microsystems, Inc.
   6 '*
   7 '* OpenOffice.org - a multi-platform office productivity suite
   8 '*
   9 '* $RCSfile: w_tool6.inc,v $
  10 '*
  11 '* $Revision: 1.2 $
  12 '*
  13 '* last change: $Author: vg $ $Date: 2008-08-18 12:44:06 $
  14 '*
  15 '* This file is part of OpenOffice.org.
  16 '*
  17 '* OpenOffice.org is free software: you can redistribute it and/or modify
  18 '* it under the terms of the GNU Lesser General Public License version 3
  19 '* only, as published by the Free Software Foundation.
  20 '*
  21 '* OpenOffice.org is distributed in the hope that it will be useful,
  22 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 '* GNU Lesser General Public License version 3 for more details
  25 '* (a copy is included in the LICENSE file that accompanied this code).
  26 '*
  27 '* You should have received a copy of the GNU Lesser General Public License
  28 '* version 3 along with OpenOffice.org.  If not, see
  29 '* <http://www.openoffice.org/license.html>
  30 '* for a copy of the LGPLv3 License.
  31 '*
  32 '/******************************************************************************
  33 '*
  34 '* owner : helge.delfs@sun.com
  35 '*
  36 '* short description : Tools for writer tests.
  37 '*
  38 '\******************************************************************************
  39
  40 sub wOfficeRestart
  41
  42     hFileCloseAll()
  43     ' Close the backing windows
  44     FileExit "SynchronMode", TRUE
  45
  46     Call hStartTheOffice
  47 end sub
  48
  49 '--------------------------------------------------------------
  50 ' end of temporaly functions
  51 '--------------------------------------------------------------
  52
  53 function LiberalMeasurement ( sShould$, sActual$) as Boolean
  54     '/// Input : (1. Should, 2. Actual) as Number with or without MeasurementUnit 'NumericField' as String ///'
  55     '///+ if input has no MeasurementUnit i take it as 'cm' (was the default in old tests) ///'
  56     '///+ Output: Boolean are they likely the same?
  57     '/// NEEDED: mathematical proofment of iTolerance, by now just some guesses :-| ///'
  58     '/// reason for this function:///'
  59     '///+ because SO counts internaly in 'twip┤s' 'twentieth of a point' there are some rounding errors ///'
  60     '///+ there are also some rounding errors because of the internal representatio of floating point numbers in computers ///'
  61     '///+ now lets try to get rid of them and have a nicer output in tests... ///'
  62     dim iTolerance as Double
  63
  64     LiberalMeasurement = False ' worst case
  65
  66     if (sShould$ = sActual$) then
  67         LiberalMeasurement = True
  68     else
  69         ' check if measunit is the same !!
  70         if (GetMeasUnit(sShould$) <> GetMeasUnit(sActual$) ) then
  71             warnlog "in function LiberalMeasurement the measUnit is different, compare not possible yet :-("
  72         else
  73             ' set factor for liberality ;-)
  74             iTolerance = 0.04
  75             if ( (StrToDouble(sShould$) + iTolerance) >= StrToDouble(sActual$) ) AND ((StrToDouble ( sShould$ ) - iTolerance) <= StrToDouble ( sActual$ )) then
  76                 LiberalMeasurement = True
  77             else
  78                 LiberalMeasurement = False
  79             end if
  80         end if
  81     end if
  82 end function
  83
  84 '--------------------------------------------------------------
  85
  86 function GetMeasUnit ( sWert$ ) as String
  87     '/// Input : Number with or without MeasurementUnit 'NumericField' as String ///'
  88     '///+ Output: Initials of MeasurementUnit as String or "" when only a number ///'
  89
  90     '/// first lets check, if there is a number -> no unit there ///
  91     if isNumeric (right (sWert$, 1)) then
  92         GetMeasUnit = ""
  93     else
  94         '/// the only single character is '"' all others are two chars ///
  95         if (  StrComp (right (sWert$, 1), chr$(34) ) = 0 ) then
  96             GetMeasUnit = right (sWert$, 1)
  97         else
  98             GetMeasUnit = right (sWert$, 2)
  99         end if
 100     end if
 101 end function
 102
 103 '--------------------------------------------------------------
 104
 105 function StrToDouble ( sWert$ ) as Double
 106     Dim sDummy$, test
 107     dim i, i1, i2 as integer
 108     dim a as integer
 109     dim b as integer
 110     dim c as double
 111     dim n as integer
 112
 113     '/// Input : {'a[. ,]b[mm cm " pi pt]' with a, b as integer} as String ///'
 114     '///+ Output: a[. , ]b as double ///'
 115
 116     ' get rid of measure unit, the only single character is '"' all others are two chars
 117     ' there was a problem, if there is NO meas.unit!!!
 118     if Len(sWert$) > Len(mUnit) then
 119         test = Left$(sWert$, (len(sWert$) - Len(mUnit)))
 120         StrToDouble = cDbl(rtrim(test))
 121         exit function
 122         if (isNumeric (sWert$) = FALSE) then
 123             if (  StrComp (right (sWert$, 1), chr$(34) ) = 0 ) then
 124                 sDummy$ = Left$ ( sWert$, Len(sWert$)-1 )
 125             else
 126                 sDummy$ = Left$ ( sWert$, Len(sWert$)-2 )
 127             end if
 128         else
 129             sDummy$ = sWert$
 130         end if
 131         ' get position of fraction mark
 132         i1 = instr (sDummy$, ",")  ' wrong output
 133         i2 = instr (sDummy$, ".")
 134         if i1 > i2 then i = i1 else i = i2
 135         ' vorkommateil
 136         try
 137             a = val (left$ (sDummy$,i-1))
 138         catch
 139         endcatch
 140         n = (len (sDummy$)-i)
 141         b = val (right$ (sDummy$, n) )
 142         c = b * 10 ^ -n
 143         StrToDouble = a + c
 144     else
 145         StrToDouble = 0
 146     end if
 147 end function
 148
 149 '--------------------------------------------------------------
 150
 151 function wKillUpcomingActives(optional sDocument as string)
 152     ' primary used in import/export tests
 153     '/// to get any aktive killed & print the content of the aktive ///'
 154     ' to catch errors during loading document
 155     Kontext "Active"
 156     if Active.Exists then
 157         if Strcomp(Left(Active.GetText,42),"Saving in external formats may have caused") = 0 then
 158             printlog "info loss, messg!! OK??"
 159         end if
 160         try
 161             Active.Yes
 162         catch
 163             printLog Active.GetText
 164         endcatch
 165         sleep(2)
 166         Kontext "Active"
 167         if Active.Exists then
 168             if IsMissing(sDocument) then
 169                 Warnlog "(1/2): " + Active.GetText ' Changed from Warn to print.
 170             else
 171                 Select case sDocument
 172                 Case "sw31.sdw", "sw31.vor"
 173                     warnlog "Saving sdw-file as sxw fails"
 174                 Case else
 175                     Warnlog Active.Gettext
 176                 end select
 177             end if
 178             try
 179                 Active.Ok ' Read Error
 180             catch
 181                 Active.No ' Style is different ...
 182             endcatch
 183         end if
 184     end if
 185     ' catching style after read error :-)
 186     sleep(2)
 187     Kontext "Active"
 188     if Active.Exists then
 189         WarnLog "(2/2): "+Active.GetText
 190         try
 191             Active.No ' Style is different ...
 192         catch
 193             Active.Ok ' maybe...
 194         endcatch
 195     end if
 196 end function
 197
 198 '--------------------------------------------------------------
 199
 200 function wGetCharacterFont as String
 201     Dim wasAsianLan as boolean
 202     '/// Input : nothing ///'
 203     '///+ Output: Fontname at cursor position as String ///'
 204     FormatCharacter
 205     Kontext
 206     sleep (1)
 207     Active.SetPage TabFont
 208     Kontext "TabFont"
 209     sleep (1)
 210     try
 211         if gAsianSup = True then
 212             wGetCharacterFont = FontWest.GetSelText
 213         else
 214             wGetCharacterFont = Font.GetSelText
 215         end if
 216         TabFont.Cancel
 217         sleep (1)
 218     catch
 219         TabFont.Cancel
 220         wasAsianLan = ActiveDeactivateAsianSupport (True)
 221         FormatCharacter
 222         Kontext
 223         sleep (1)
 224         Active.SetPage TabFont
 225         Kontext "TabFont"
 226         sleep (1)
 227         wGetCharacterFont = FontWest.GetSelText
 228         TabFont.Cancel
 229         sleep (1)
 230         wasAsianLan = ActiveDeactivateAsianSupport (True)
 231     endcatch
 232 end function
 233
 234 '--------------------------------------------------------------
 235
 236 function wGetCharacterFontSize as String
 237     Dim wasAsianLan as boolean
 238     '/// Input : nothing ///'
 239     '///+ Output: FontSize at cursor position as String ///'
 240     FormatCharacter
 241     Kontext
 242     sleep (1)
 243     Active.SetPage TabFont
 244     Kontext "TabFont"
 245     sleep (1)
 246     try
 247         if gAsianSup = True then
 248             wGetCharacterFontSize = SizeWest.GetSelText
 249         else
 250             wGetCharacterFontSize = Size.GetSelText
 251         end if
 252         TabFont.Cancel
 253         sleep (1)
 254     catch
 255         TabFont.Cancel
 256         wasAsianLan = ActiveDeactivateAsianSupport (True)
 257         FormatCharacter
 258         Kontext
 259         sleep (1)
 260         Active.SetPage TabFont
 261         Kontext "TabFont"
 262         sleep (1)
 263         wGetCharacterFontSize = SizeWest.GetSelText
 264         TabFont.Cancel
 265         sleep (1)
 266         wasAsianLan = ActiveDeactivateAsianSupport (True)
 267     endcatch
 268 end function
 269
 270 '--------------------------------------------------------------
 271
 272 function ZeilenHoeheHolen as Double
 273     '/// input: nothing///'
 274     '///+ output: FormatRowHeight as double///'
 275     Dim zWert as Double : Dim Ausgabe$
 276     FormatRowHeight
 277     Wait 100
 278     Kontext "ZellenHoehe"
 279     Ausgabe$ = Hoehe.GetText
 280     zWert = ZahlAusSpinnfield ( Ausgabe$ )
 281     if zWert = 0.01 then
 282         ZeilenHoeheHolen = 0.00
 283     else
 284         ZeilenHoeheHolen = zWert
 285     end if
 286     ZellenHoehe.OK
 287 end function
 288
 289 '--------------------------------------------------------------
 290
 291 sub ZeilenHoeheTesten ( Wert as Double )
 292     '/// input: FormatRowHeight as double///'
 293     '///+ output: warnlog, if not eaqual ///'
 294     '/// LiberalMeasurement enabled///'
 295     Dim zWert as Double
 296     FormatRowHeight
 297     Kontext "ZellenHoehe"
 298     zWert = ZahlAusSpinnfield ( Hoehe.GetText )
 299     if (LiberalMeasurement (Wert, zWert) <> TRUE) then QAErrorlog "#i94556# - Die Zeilenhöhe ist nicht "+ Wert + " sondern "+ zWert + "."
 300     ZellenHoehe.OK
 301 end sub
 302
 303 '--------------------------------------------------------------
 304
 305 function SpaltenBreiteHolen as Double
 306     FormatColumnWidthWriter
 307     Kontext "SpaltenBreite"
 308     SpaltenBreiteHolen = ZahlAusSpinnfield (Breite.GetText )
 309     SpaltenBreite.OK
 310 end function
 311
 312 '--------------------------------------------------------------
 313
 314 sub SpaltenBreiteTesten ( Wert as Double )
 315     Dim zWert as Double
 316     FormatColumnWidthWriter
 317     Kontext "SpaltenBreite"
 318     zWert = ZahlAusSpinnfield ( Breite.GetText )
 319     if Not Wert = zWert then
 320         Warnlog "Die Spaltenbreite ist nicht "+ Wert +" sondern "+ zWert
 321     end if
 322     SpaltenBreite.OK
 323 end sub
 324
 325 '--------------------------------------------------------------
 326
 327 sub SeitenAbstaendeHolen ( ZweiWerte() as Double )
 328     FormatTable
 329     Kontext
 330     Active.SetPage TabTabelle
 331     Kontext "TabTabelle"
 332     ZweiWerte(1) = ZahlAusSpinnfield ( NachLinks.GetText )
 333     ZweiWerte(2) = ZahlAusSpinnfield ( NachRechts.GetText )
 334     TabTabelle.Cancel
 335 end sub
 336
 337 '--------------------------------------------------------------
 338
 339 sub SeitenAbstaendeTesten ( WertLi as Double, WertRe as Double )
 340     '/// liberalMeasurement implemented ///'
 341     Dim zWert1 as Double : Dim zWert2 as Double
 342     FormatTable
 343     Kontext
 344     Active.SetPage TabTabelle
 345     Kontext "TabTabelle"
 346     zWert1 = ZahlAusSpinnfield ( NachLinks.GetText )
 347     zWert2 = ZahlAusSpinnfield ( NachRechts.GetText )
 348
 349     if (LiberalMeasurement (zWert1, WertLi) <> TRUE) then Warnlog "Left distance not " + WertLi + "  but " + zWert1
 350     if (LiberalMeasurement (zWert2, WertRe) <> TRUE) then Warnlog "Right distance not " + WertRe + "  but " + zWert2
 351     wait 300
 352     TabTabelle.Cancel
 353 end sub
 354
 355 '--------------------------------------------------------------
 356
 357 function ZahlAusSpinnfield ( sWert$ ) as Double
 358     ZahlAusSpinnfield = StrToDouble ( sWert$)
 359     printlog ZahlAusSpinnfield
 360 end function
 361
 362 '--------------------------------------------------------------
 363
 364 sub ZeilenTesten ( Anzahl% )
 365     dim temp(10) as string
 366     Dim i as Integer
 367     Dim Dummy as Integer
 368     Kontext "DocumentWriter"
 369     DocumentWriter.TypeKeys "<Up>", 5 ' Move out of table ????!!!!
 370     for i=2 to Anzahl% +4   ' might work, but if there are some more tables, it doesn't!!
 371         try
 372             Call wTypeKeys "<Down>"
 373             FormatRowHeight       'This is OK; but different evaluation is necessary
 374             Kontext "ZellenHoehe"
 375             ZellenHoehe.Cancel
 376             dummy = i
 377         catch
 378             i = Anzahl% +20
 379         endcatch
 380     next i
 381     if dummy <> Anzahl% then Warnlog "Die Tabelle hat wohl mehr Zeilen als erwartet: soll => "+ Anzahl% +" sind "+ dummy
 382     Kontext "DocumentWriter"
 383     DocumentWriter.TypeKeys "<Up><Left>", 10
 384 end sub
 385
 386 '--------------------------------------------------------------
 387
 388 sub SpaltenTesten ( Anzahl% )
 389     FormatColumnWidthWriter
 390     Kontext "SpaltenBreite"
 391     Spalte.More Anzahl%
 392     if Anzahl% <> Spalte.GetText then Warnlog "Table has mohl column then expected: should => "+ Anzahl% +" is "+ Spalte.GetText
 393     SpaltenBreite.Cancel
 394 end sub
 395
 396 '--------------------------------------------------------------
 397
 398 sub TBOhTabelleEinfuegen (optional tName as string, optional tHeader as boolean, optional tRepeat as boolean, optional tSeperate as boolean, optional tBorder as boolean, optional tWidth as string, optional tHeight as string )
 399     '///   TBOhTabelleEinfuegen ("Garfield",0,1,0,1,"10",tHeight:="7") ///'
 400     ' maybe TODO: return of an array, that tells you the state of an existing / name table/ cause, you create a table in a tabl÷e :-)
 401     ' try with switching tabpage
 402     InsertTableWriter
 403     Sleep 2
 404     Kontext "TabelleEinfuegenWriter"
 405     wait 500
 406
 407     ' Default had been changed. Not to rewrite the whole test I decided to changed the row-number
 408     Spalten.Settext "5"
 409     wait 500
 410
 411     if (IsMissing (tName) <> True) then TabellenName.SetText tName
 412     if (IsMissing (tHeader) <> True) then
 413         if tHeader then
 414             Ueberschrift.Check
 415             if (IsMissing (tRepeat) <> True) then if tRepeat then UeberschriftWiederholen.Check else UeberschriftWiederholen.UnCheck
 416         else
 417             Ueberschrift.UnCheck
 418         end if
 419     end if
 420
 421     if IsMissing (tSeperate) <> True then
 422         if tSeperate then
 423             TabelleNichtTrennen.Check
 424         else
 425             TabelleNichtTrennen.UnCheck
 426         end if
 427     end if
 428
 429     if IsMissing(tBorder) <> True then
 430         if tBorder then
 431             Umrandung.check
 432         else
 433             Umrandung.check
 434         end if
 435     end if
 436
 437     if IsMissing(tWidth) <> True then
 438         Spalten.SetText tWidth
 439     else
 440         Spalten.Settext "5"
 441     end if
 442     if IsMissing(tHeight) <> True then Zeilen.SetText tHeight
 443
 444     TabelleEinfuegenWriter.OK
 445     Sleep 1
 446
 447     Kontext "TableObjectbar"
 448     Sleep 1
 449     if TableObjectbar.NotExists then
 450         Kontext "TextObjectbar"
 451         TextObjectbar.SetNextToolBox
 452     end if
 453
 454     Select Case gApplication
 455     Case "WRITER"
 456         Kontext "DocumentWriter"
 457
 458     Case "MASTERDOCUMENT"
 459         Kontext "DocumentMasterDoc"
 460
 461     Case "HTML"
 462         Kontext "DocumentWriterWeb"
 463
 464     end select
 465     Sleep 1
 466 end sub
 467
 468 '--------------------------------------------------------------
 469
 470 function hGetTableName () as string
 471     hGetTableName = "" ' Worst Case
 472     TableTableProperties                ' get into existing table
 473     Sleep (1)
 474     try
 475         Kontext
 476         Active.SetPage TabTabelle
 477         Sleep (1)
 478         Kontext "TabTabelle"
 479         Sleep (1)
 480         hGetTableName = TabellenName.GetText
 481         TabTabelle.Cancel
 482     catch
 483         Kontext "TabelleEinfuegenWriter"
 484         if TabelleEinfuegenWriter.Exists then
 485             hGetTableName = TabellenName.Gettext
 486             TabelleEinfuegenWriter.Ok
 487         else
 488             hGetTableName = ""
 489         end if
 490     endcatch
 491     Sleep (1)
 492 end function
 493
 494 '--------------------------------------------------------------
 495
 496 function dec(Ref as integer)
 497     ' ----------------------------------------
 498     ' to give this func a var as ref: call without ANNY brackets => 'dec Variable'
 499     ' opposite of this to call it via value ! WE DON'T WANT THIS !
 500     ' (would be 'dec (Variable)' or in declaration 'function dec (ByVal x)')
 501     Ref = Ref - 1
 502 end function
 503
 504 '--------------------------------------------------------------
 505
 506 function inc(Ref as integer)
 507     'printlog "inc:"+ref
 508     Ref = Ref + 1
 509 end function
 510
 511 '--------------------------------------------------------------
 512
 513 function hGetColumn() as integer
 514     try
 515         FormatColumnWidthWriter
 516     catch
 517         printlog "func1.inc->hGetColumn asks for table."
 518         hTypeKeys "<left>"
 519         try
 520             FormatColumnWidthWriter
 521         catch
 522             print "giving up to find a table: func1 hgetcolumn 2"
 523         endcatch
 524     endcatch
 525     Kontext "SpaltenBreite"
 526     if SpaltenBreite.exists then
 527         hGetColumn = Spalte.GetText
 528         SpaltenBreite.Cancel
 529     else
 530         hGetColumn = 0
 531     end if
 532 end function
 533
 534 '--------------------------------------------------------------
 535
 536 function hNavigatorOpenWindows() as Integer
 537     hNavigatorOpenWindows = 0
 538
 539     goto ENDE
 540     '/// Input: (); Output: 0: for the usual started SO first window / +1 for each other open Window ///'
 541     '///+                    -2 if no window is open :-) (i think then there is another problem ...)///'
 542     '///+ this fuunction depends on navigator-fuunction:  ///'
 543     '///+ NO nav avail in: Formular; NOT CATCHED UPTONOW ///'
 544     '///+ count classes - only windows in this class are visible in their nav ///'
 545     '///+ Spreadsheet ///'
 546     '///+ Presentation, Drawing///'
 547     '///+ Text Doc, HTML Doc, Labels, Business cards, AND ///'
 548     '///+ !Master Doc! in his nav are no windows countable!; NOT CATCHED UPTONOW ///'
 549
 550     '/// usually it counts 2 windows; 1. the window, that results in starting office ///'
 551     '///+ 2. The entry 'Active Window', is always there (entries in navigator changes automatical ///'
 552     '///+    to the visible window ->  2 this is the minima! ///'
 553     '///+ so i give back a count of x-2 everything below 0 is an error !///'
 554
 555     dim j as integer, WelcherEintrag as integer
 556     ' Navigator zur├�?cksetzen
 557     Kontext "NavigatorWriter"
 558     if NavigatorWriter.NotExists then ViewNavigator
 559     sleep (1)
 560     Kontext
 561     do while (Active.Exists)
 562         printlog Active.GetText
 563         try
 564             active.yes ' ....
 565         catch
 566             active.ok ' ...new since 638a5 7001 :-(
 567         endcatch
 568         Kontext
 569     loop
 570     Kontext "NavigatorWriter"
 571     sleep (3)
 572     hNavigatorOpenWindows = DokumentListe.GetItemCount - 2  ' couldn' see dokumentliste :-( reason:: active that prevents it :-(
 573     sleep (3)
 574     '   printlog " hnow: "+DokumentListe.GetItemCount +" "+DokumentListe.GetSelText
 575     if (DokumentListe.GetItemCount = 0) then print "waassss o ??!!?!??!?!"
 576     '   close Navigator
 577     ViewNavigator
 578     Kontext "DocumentWriter"
 579     ENDE:
 580 end function
 581
 582 '--------------------------------------------------------------
 583
 584 function hIsNamedDocLoaded (ShouldFile as String) as Boolean
 585     '/// Input: name of loaded file; Output: True/False///'
 586     '///+ Several checks may be combined: ///'
 587     '///+ disabled: Plan A: requires clippboard: check, if not untitled 1 window... ///'
 588     '///+ Plan B: SaveAs Dialog ///'
 589     '///+ not used now: Plan C: check if hNavigatorOpenWindows() > 0 ///'
 590
 591     '///' Plan A :-( ///
 592     ''///+ to be able to check, that document was loaded, print something before opening new doc ///'
 593     ''///+ during test, check if it is readable ... ///'
 594     '   Kontext "DocumentWriter"
 595     '   DocumentWriter.TypeKeys "<Mod1 home>"
 596     '   DocumentWriter.TypeKeys "TBOlastWindow"
 597     '   DocumentWriter.TypeKeys "<Return>"
 598
 599     '   Kontext "DocumentWriter"
 600     '   DocumentWriter.TypeKeys "<Mod1 Home>"
 601     '   DocumentWriter.TypeKeys "<Shift End>"
 602     '   EditCopy
 603     '   DocumentWriter.TypeKeys "<Home>"
 604     '   if GetClipboardText <> "TBOlastWindow" Then ///'
 605
 606     '///      ' Plan B :-) ///
 607     '///+' if a doc got loaded, the filename in a 'SaveAs' Dlg is different from "" ///
 608     '///+' usually the file name of the loaded document with an changed extension chosen from SO ///
 609
 610     hIsNamedDocLoaded  = False      ' Let's  start WorstCase :-(
 611     FileSaveAs                   ' (Plan B)
 612     Kontext "SpeichernDlg"
 613     If DateiOhneExt(DateiExtract(Dateiname.GetSelText)) = DateiOhneExt(DateiExtract(ShouldFile)) Then
 614         hIsNamedDocLoaded = True
 615         '       Printlog "Filename: " + Dateiname.GetSelText+"; "+ShouldFile
 616         '       Printlog "--------------------------------------------------Loaded as: " + Dateityp.GetSelText
 617     Else
 618         'exception! for templates
 619         if lcase(right(ShouldFile,3)) = "vor" or lcase(right(ShouldFile,3)) = "dot" then hIsNamedDocLoaded = True
 620     End If
 621     SpeichernDlg.Cancel
 622
 623     '/ remove text of last window test text ///'
 624     '   Kontext "DocumentWriter"
 625     '   DocumentWriter.TypeKeys "<Mod1 home>"
 626     '   DocumentWriter.TypeKeys "TBOlastWindow"
 627     '   DocumentWriter.TypeKeys "<delete>"
 628 end function
 629
 630 '--------------------------------------------------------------
 631
 632 sub hSetSpellHypLanguage
 633     dim sTrieit
 634     if bAsianLan then
 635         Printlog " to get it to work, ihave to change the default languge in the options! FOR CURRENT DOCUMENT ONLY!!!!!"
 636         ToolsOptions
 637         Call hToolsOptions ("LANGUAGESETTINGS","LANGUAGES")
 638         AktuellesDokument.Check
 639         if glLocale (4) = "" then
 640             warnlog "choose a spellbokk from the list below and insert it into the file <\testtool\input\impress\locale_1.txt> on position (4) (only enabled for asiann languages!) - '"+glLocale(4)+"'"
 641             Kontext "ExtrasOptionenDlg"
 642             ExtrasOptionenDlg.Cancel
 643             sTrieit = hFindSpellHypLanguage
 644             ToolsOptions
 645             Call hToolsOptions ("LANGUAGESETTINGS","LANGUAGES")
 646             AktuellesDokument.Check
 647             if sTrieit <> "" then
 648                 Westlich.Select sTrieit
 649             else
 650                 warnlog "SOrry no spellbook found :-("
 651             end if
 652         else
 653             Westlich.Select glLocale (4)
 654         end if
 655         printlog "selected: "+Westlich.GetSelText
 656         Kontext "ExtrasOptionenDlg"
 657         ExtrasOptionenDlg.OK
 658     end if
 659 end sub
 660
 661 '--------------------------------------------------------------
 662
 663 sub hFindSpellHypLanguage as string
 664     dim iListLength as integer
 665     dim i as integer
 666
 667     if bAsianLan then
 668         ToolsOptions                                             ' take length of list
 669         Call hToolsOptions ("LANGUAGESETTINGS","WRITINGAIDS")
 670         SprachmoduleBearbeiten.click
 671         Kontext "ModuleBearbeiten"
 672         for i = 1 to Sprache.GetItemCount
 673             Sprache.Select i
 674             sleep 1
 675             Printlog " "+i+": '"+Sprache.GetSelText +"'"
 676             if i = 1 then hFindSpellHypLanguage = Sprache.GetSelText
 677         next i
 678         ModuleBearbeiten.Close
 679         Kontext "ExtrasOptionenDlg"
 680         ExtrasOptionenDlg.OK
 681         sleep 1
 682     end if
 683 end sub
 684
 685 '--------------------------------------------------------------
 686
 687 function wCheckRowHeight ( ShouldValue as string ) as boolean
 688     FormatRowHeight
 689     Kontext "ZellenHoehe"
 690     if Hoehe.Gettext <> ShouldValue then
 691         Warnlog "Height is not " + ShouldValue + " but " + Hoehe.Gettext
 692         wCheckRowHeight = False
 693     else
 694         wCheckRowHeight = True
 695     end if
 696     ZellenHoehe.Cancel
 697 end function
 698
 699 '--------------------------------------------------------------
 700
 701 sub wSearchWriteableArea ()
 702     Dim PageDownNow as boolean, NowWriteable as boolean
 703     Dim i as integer
 704     ' This sup has not been properly worked
 705     ' Looks complicated but isn't
 706     ' Searches for messagebox, if found makes a PageDown in document 5 times
 707     ' if writeable then, the moves curors up 1000 times. Hope it helps
 708     ' Document is completely writeprotected the sup would loop endless
 709     NowWriteable = False
 710     PageDownNow = True
 711     Do until NowWriteable = True
 712         Call wTypeKeys " "
 713         Kontext "Active"
 714         if Active.Exists then
 715             if Active.GetRT = 304 then
 716                 Active.Ok
 717                 if PageDownNow = True then
 718                     for i = 1 to 10
 719                         Call wTypeKeys "<Down>", 5
 720                         Call wTypeKeys " "
 721                         Kontext "Active"
 722                         if Active.Exists then
 723                             if Active.GetRT = 304 then
 724                                 Active.Ok
 725                             end if
 726                         else
 727                             NowWriteable = True
 728                             i = 11
 729                         end if
 730                     next i
 731                 else
 732                     for i = 1 to 1000
 733                         Call wTypeKeys "<Up>", 1
 734                         Call wTypeKeys " "
 735                         Kontext "Active"
 736                         if Active.Exists then
 737                             if Active.GetRT = 304 then
 738                                 Active.Ok
 739                             end if
 740                         else
 741                             NowWriteable = True
 742                             i = 1002
 743                         end if
 744                     next i
 745                 end if
 746             else
 747                 NowWriteable = True
 748                 Exit Do
 749             end if
 750         else
 751             NowWriteable = True
 752             Exit Do
 753         end if
 754     Loop
 755 end sub
 756
 757 '---------------------------------------------------
 758
 759 function fInsertFrame (x1 as Integer , y1 as Integer , x2 as Integer , y2 as Integer)
 760     'This function will insert a frame with the coordinate
 761
 762     Call wDocSetContext
 763
 764     Call hToolbarSelect("INSERT", true )
 765     Sleep 1
 766     Kontext "Insertbar"
 767     Rahmen.Click
 768     Sleep 1
 769
 770     Call gMouseDown ( x1,y1 )
 771     Call gMouseMove ( x1,y1,x2,y2 )
 772     Call gMouseUp( x2,y2 )
 773     wait 500
 774
 775 end function