| blob | 24912b76983ccae6491319673833e9c93d5488b2 |
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: id_tools.inc,v $
10 '*
11 '* $Revision: 1.1 $
12 '*
13 '* last change: $Author: jsi $ $Date: 2008-06-16 10:43:16 $
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 : wolfram.garten@sun.com
35 '*
36 '* short description : some tools (Functions)
37 '*
38 '\******************************************************************************
40 'Functions:
41 ' #1 hFindSpellHypLanguage
42 ' #1 GetDecimalSeperator
43 ' #1 LiberalMeasurement
44 ' #1 GetMeasUnit
45 ' #1 StrToDouble
46 ' #1 fGetPositionX
47 ' #1 setStartCurrentPage
48 ' #1 fIsDocumentWritable
49 ' #1 fIsDocumentWritable
50 ' #1 fGetSizeXY
51 ' #1 hCallExport
52 ' #1 checkexppdfwaitmax10sec
53 ' #1 fCompareTwoValues
54 ' #1 fConvertBackslashToSlash
55 ' #1 hScreenFontAntialiasing
56 ' #1 fSaveLoadAllFormats
57 ' #1 setCharacterLanguage
58 ' #1 toggleGermanSpellchecking
59 ' #1 sAnalyseContextMenu
60 ' #1 sLongToBinary
61 ' #1 sBinaryToLong
62 ' #1 fGetIntoDictionary
63 ' #1 hSelectInList
64 ' #1 hWalkTheStyles2
65 ' #1 fGetSlideNumber
66 ' #1 fGetSlideCount
67 ' #1 fGetSlideName
68 ' #1 fGetSetPageBackground
69 ' #1 CreateTextSetEffectAndAngle
70 ' #1 fGetPresentationStyle
71 ' #1 hPrepareSearchBUG
72 ' #1 makeNumOutOfText
73 ' #1 wIgnorierenlisteLoeschen
74 ' #1 optionstest
75 ' #1 optionstest2
78 '\*****************************************************************
79 function hFindSpellHypLanguage (optional sBooks()) as string
80 printlog "print all available languages that have a language module"
81 dim iListLength as integer
82 dim i as integer
83 dim sTemp as string
85 printlog "only necessary for asian languages"
86 if (bAsianLan or (iSprache=55)) then
87 printlog "Tools->Options"
88 ToolsOptions
89 printlog "select from section 'Language Settings' the item 'Writing Aids'"
90 hToolsOptions ("LANGUAGESETTINGS","WRITINGAIDS")
91 printlog "click button 'Edit...' in section 'Available language modules'"
92 SprachmoduleBearbeiten.click
93 kontext "ModuleBearbeiten"
94 printlog "print all entries from listbox 'Language'"
95 for i = 1 to Sprache.GetItemCount
96 sTemp = Sprache.GetItemText(i)
97 if (NOT isMissing(sBooks())) then
98 listAppend(sBooks(), sTemp)
99 endif
100 printlog " return the first entry in the listbox "
101 if i = 1 then hFindSpellHypLanguage = sTemp
102 next i
103 printlog "close dialog 'Edit Modules'"
104 ModuleBearbeiten.Close
105 Kontext "ExtrasOptionenDlg"
106 printlog "close dialog 'Options - '"
107 ExtrasOptionenDlg.OK
108 sleep 1
109 endif
110 end function
112 '-------------------------------------------------------------------------------
113 function GetDecimalSeperator ( sDummy$ ) as String
115 printlog "Input : number with fractionmark from 'NumericField' as String "
116 printlog "+ Output: '.' or ',' as String "
117 dim i1, i2 as integer
119 printlog "get position of fraction mark / get IT"
120 i1 = instr (sDummy$, ",")
121 i2 = instr (sDummy$, ".")
122 if i1 > i2 then GetDecimalSeperator = "," else GetDecimalSeperator = "."
123 end function
125 '-------------------------------------------------------------------------------
126 function LiberalMeasurement ( sShould$, sActual$) as Boolean
128 printlog " Input : (1. Should, 2. Actual) as Number with or without MeasurementUnit 'NumericField' as String "
129 printlog "+ if input has no MeasurementUnit i take it as 'cm' (was the default in old tests) "
130 printlog "+ Output: Boolean are they likely the same?"
131 printlog " NEEDED: mathematical proofment of iTolerance, by now just some guesses :-| "
132 printlog " reason for this function:"
133 printlog "+ because SO counts internaly in 'twip???s' 'twentieth of a point' there are some rounding errors "
134 printlog "+ there are also some rounding errors because of the internal representatio of floating point numbers in computers "
135 printlog "+ now lets try to get rid of them and have a nicer output in tests... "
136 printlog " measurement units are defined in http://gsl.openoffice.org/source/browse/gsl/vcl/source/src/units.src "
138 dim iTolerance as Double
140 LiberalMeasurement = False
142 if (sShould$ = sActual$) then
143 LiberalMeasurement = True
144 else
145 printlog "check if measunit is the same"
146 if (GetMeasUnit(sShould$) <> GetMeasUnit(sActual$) ) then
147 warnlog "In function LiberalMeasurement the measUnit is different, compare not possible yet"
148 else
149 printlog "set factor for liberality"
150 printlog "took units from http://gsl.openoffice.org/source/browse/gsl/vcl/source/src/units.src"
151 select case GetMeasUnit(sShould$)
152 case "mm", "ミリ", "公厘" : iTolerance = 2.0 '01, 81, 88
153 case "cm","センチ","厘米","公分" : iTolerance = 0.5 '01, 81, 86, 88
154 case chr$(34) : iTolerance = 2.5
155 case "pi","ピクセル" : iTolerance = 2.5 '01, 81
156 case "pt", "ポイント" : iTolerance = 2.5 '01, 81
157 case "" : iTolerance = 1.5 ' cm is presubposition in old functions
158 case else
159 iTolerance = 2.5
160 qaErrorLog "This Unit is not available in this function. '" + GetMeasUnit(sShould$) + "'"
161 end select
162 printlog "have to get the measurem unit, cause the offset is different for each"
163 printlog "!!! val(str()) is important because of double calculating actions !!! #110996#"
164 if ( val(str(StrToDouble(sShould$)+iTolerance)) >= StrToDouble(sActual$) ) AND (val(str(StrToDouble ( sShould$ )-iTolerance)) <= StrToDouble ( sActual$ )) then
165 LiberalMeasurement = True
166 else
167 LiberalMeasurement = False
168 end if
169 end if
170 end if
171 end function
173 '-------------------------------------------------------------------------------
174 function GetMeasUnit ( sWert$ ) as String
176 dim iBounder as integer
177 printlog " Input : Number with or without MeasurementUnit 'NumericField' as String "
178 printlog "+ Output: Initials of MeasurementUnit as String or "" when only a number "
180 iBounder = -1
181 do
182 inc iBounder
183 loop until ( isNumeric(mid (sWert$, len(sWert$)-iBounder, 1)) OR (len(sWert$) <= (iBounder + 1)) )
185 if (len(sWert$) <= (iBounder + 1)) then
186 if isNumeric(left (sWert$, 1)) then
187 GetMeasUnit = right (sWert$, iBounder)
188 else
189 GetMeasUnit = sWert$
190 endif
191 else
192 GetMeasUnit = right (sWert$, iBounder)
193 endif
194 end function
196 '-------------------------------------------------------------------------------
197 function StrToDouble ( sWert$ ) as Double
199 Dim sDummy$
200 dim i, i1, i2 as integer
201 dim a as integer
202 dim b as integer
203 dim c as double
204 dim n as integer
206 printlog " Input : {'a[. ,]b[mm cm pi pt]' with a, b as integer} as String "
207 printlog "+ Output: a[. , ]b as double "
209 printlog "get rid of measure unit, the only single character is '' all others are two chars"
210 printlog "there was a problem, if there is NO meas.unit!!"
211 if (isNumeric (sWert$) = FALSE) then
212 if ( StrComp (right (sWert$, 1), chr$(34) ) = 0 ) then
213 sDummy$ = Left ( sWert$, Len(sWert$)-1 )
214 else
215 sDummy$ = Left ( sWert$, Len(sWert$)-2 )
216 endif
217 else
218 sDummy$ = sWert$
219 endif
220 printlog "get position of fraction mark"
221 i1 = instr (sDummy$, ",") ' wrong output
222 i2 = instr (sDummy$, ".")
223 if i1 > i2 then i = i1 else i = i2
224 printlog " in front of decimal seperator:"
225 try
226 a = val (left (sDummy$,i-1))
227 catch
228 'printlog sWert$ + ":" + sDummy$ + ":" + i + ":" + i1+ ":" + i2
229 endcatch
230 printlog "after the decimal seperator"
231 n = (len (sDummy$)-i)
232 b = val (right (sDummy$, n) )
233 c = b * 10 ^ -n
234 'printlog "-------------- :"+sWert$ +" :'"+a+"' :"+n+" :"+b+" :'"+c+"':"
235 ' !!! val(str()) is important because of double calculating actions !!! #110996#
236 StrToDouble = val(str(a + c))
237 end function
239 '-------------------------------------------------------------------------------
240 function fGetPositionX () as string
242 fGetPositionX = ""
243 try
244 ContextPositionAndSize
245 catch
246 warnlog "couldn't call 'ContextPositionAndSize' no object selected ?"
247 endcatch
248 kontext
249 active.SetPage TabPositionAndSize
250 kontext "TabPositionAndSize"
251 if TabPositionAndSize.exists (5) then
252 fGetPositionX = PositionX.GetText
253 TabPositionAndSize.OK
254 else
255 warnlog "Couldn't switch tab page :-( "
256 endif
257 end function
259 '-------------------------------------------------------------------------------
260 function setStartCurrentPage(optional bState as boolean) as boolean
262 printlog " tools->options "
263 ToolsOptions
264 printlog "+ select in section 'Presentation' tabpage 'general' "
265 hToolsOptions ("IMPRESS","General")
266 printlog "+ check the checkbox 'Always with current page' "
267 setStartCurrentPage = MitAktuellerSeite.isChecked
268 if bState then
269 MitAktuellerSeite.Check
270 else
271 MitAktuellerSeite.UnCheck
272 endif
273 Kontext "ExtrasOptionenDlg"
274 printlog "+ close dialog 'Options - Presenation - General' with OK "
275 ExtrasOptionenDlg.OK
276 end function
278 '-------------------------------------------------------------------------------
279 function fIsDocumentWritable() as boolean
281 printlog " check if a document is writeable"
282 printlog " <u>parameter:</u>"
283 printlog " <u>return:</u>"
284 printlog " true if the document is writeable otherwise false"
286 Kontext "Standardbar"
287 if Bearbeiten.GetState(2) <> 1 then
288 fIsDocumentWritable = false
289 else
290 fIsDocumentWritable = true
291 endif
293 end function
295 '-------------------------------------------------------------------------------
296 function fMakeDocumentWritable() as boolean
298 printlog " make a document is writeable"
299 printlog " <u>parameter:</u>"
300 printlog " <u>return:</u>"
301 printlog " true if the document can make writeable otherwise false"
303 Kontext "Standardbar"
304 sleep (1)
305 if Bearbeiten.GetState(2) <> 1 then
306 Bearbeiten.Click
307 Kontext
308 if Active.Exists(1) then
309 Active.Yes
310 fMakeDocumentWritable = true
311 else
312 warnlog "No messagebox after making document editable?"
313 fMakeDocumentWritable = false
314 endif
315 else
316 printlog "Document is allready writable."
317 fMakeDocumentWritable = true
318 endif
320 end function
322 '-------------------------------------------------------------------------------
324 function fGetSizeXY (sX as string, sY as string, bGet as boolean) as Boolean
325 dim sTx as string
326 dim sTy as string
327 dim bReturn as boolean
329 bReturn = True
330 try
331 ContextPositionAndSize
332 catch
333 warnlog "couldn't call 'ContextPositionAndSize' no object selected ?"
334 endcatch
335 kontext
336 active.SetPage TabPositionAndSize
337 kontext "TabPositionAndSize"
338 if TabPositionAndSize.exists (5) then
339 sTx = Width.GetText
340 sTy = Height.GetText
341 TabPositionAndSize.OK
342 else
343 warnlog "Couldn't switch tab page :-( "
344 endif
345 if bGet then ' Get the Values only
346 sY = sTy
347 sX = sTx
348 else ' Get the Values and COMPARE them
349 if (LiberalMeasurement (sX,sTx) <> TRUE) then
350 warnlog "width is different :-( should: '"+sX+"' is: '"+sTx+"'" + "eventually a result of i35519"
351 bReturn = False
352 endif
353 if (LiberalMeasurement (sY,sTy) <> TRUE) then
354 warnlog "hight is different :-( should: '"+sY+"' is: '"+sTy+"'" + "eventually a result of i35519"
355 bReturn = False
356 endif
357 bGet = bReturn
358 endif
359 end function
361 '-------------------------------------------------------------------------
363 function hCallExport ( HyWhatsYourName as String , sFilter as String, optional bSelection as boolean ) as Boolean
364 hCallExport = TRUE
365 Printlog "Will try to select export filter: '" + sFilter + "'" + ""
366 try
367 FileExport
368 catch
369 Sleep 10
370 Warnlog "It takes to much time to export the graphic (>10 sec.). Please check the problem, maybe it's a bug!"
371 FileExport
372 endcatch
374 Sleep (3)
375 Kontext "ExportierenDlg"
376 try
377 Dateityp.Select sFilter
378 catch
379 Warnlog "'" + sFilter + "' is missing!"
380 dim iAll, counter as integer
381 iAll = Dateityp.GetItemCount
382 printlog " List of entries in the menu:"
383 for counter = 1 to iAll
384 printlog " " + counter + "/" + iAll + ": " + Dateityp.GetItemText(counter)
385 next counter
386 hCallExport = FALSE
387 ExportierenDlg.Cancel
388 exit function
389 endcatch
390 if ((IsMissing(bSelection) = FALSE) AND (bSelection = TRUE)) then
391 sleep 2
392 Selektion.Check
393 else
394 if (Selektion.isEnabled) then
395 Selektion.UnCheck
396 endif
397 endif
399 if AutomatischeDateinamenserweiterung.Exists then
400 QAErrorLog "OBSOLETE: Automatic file extension check-box in file dialog will be removed soon!"
401 AutomatischeDateinamenserweiterung.check
402 endif
404 Dateiname.SetText ( HyWhatsYourName )
405 sleep 2
406 Speichern.Click
407 sleep 2
408 kontext "AlienWarning"
409 if AlienWarning.exists(5) then
410 warnlog "#i41983# Alien Warning on export not allowed"
411 AlienWarning.OK
412 endif
413 Kontext "Active"
414 if Active.Exists then Active.Yes
415 Sleep 3
416 end function
418 '-------------------------------------------------------------------------
419 function checkexppdfwaitmax10sec
421 dim i as integer
422 kontext "Standardbar"
423 i = 0
424 do
425 i = i + 1
426 sleep 1
427 if (ExportAsPDF.isEnabled = TRUE) then i = 15
428 loop while ((i < 15))
429 if (ExportAsPDF.isEnabled = FALSE) then
430 Warnlog "ExportAsPDF was NOT ok. Waited " + i + " seconds."
431 endif
432 sleep (3)
433 end function
435 '-------------------------------------------------------------------------------
436 function fCompareTwoValues(a as string, b as string) as boolean
438 dim c as boolean
440 c = val(str(StrToDouble(a))) <> val(str(StrToDouble(b)))
441 c = c AND (GetMeasUnit(a) <> GetMeasUnit(b))
442 fCompareTwoValues = c
443 end function
445 '-------------------------------------------------------------------------------
446 function fConvertBackslashToSlash (sInput as string) as string
448 dim i as integer
449 dim sTemp as string
450 dim sI as string
451 dim x as integer
453 sTemp = ""
454 x = len (sInput)
455 for i = 1 to x
456 sI = mid(sInput, i, 1)
457 if (sI = "\") then
458 sI = "/"
459 endif
460 sTemp = sTemp + sI
461 next i
462 fConvertBackslashToSlash = sTemp
463 end function
465 '-------------------------------------------------------------------------------
466 function hScreenFontAntialiasing (bEnable as boolean) as boolean
468 ToolsOptions
469 hToolsOptions ("STAROFFICE", "VIEW")
470 hScreenFontAntialiasing = FontAntiAliasing.IsChecked
471 if (bEnable) then
472 FontAntiAliasing.Check
473 else
474 FontAntiAliasing.Uncheck
475 endif
476 Kontext "ExtrasOptionenDlg"
477 ExtrasOptionenDlg.OK
478 end function
480 '-------------------------------------------------------------------------------
481 function fSaveLoadAllFormats (NewFileDir as String)
483 Dim iFileTypeCounter as Integer
484 Dim SavedFile(30) as String
485 Dim iCounter as Integer
487 printlog "Save the document in different formats..."
488 FileSaveAs
489 kontext "ExportierenDlg"
490 For iFileTypeCounter = 1 to Dateityp.GetItemCount
491 sleep (1)
492 if iFileTypeCounter > 1 then
493 WaitSlot (2000)
494 FileSaveAs
495 kontext "ExportierenDlg"
496 endif
497 Dateiname.SetText (ConvertPath (NewFileDir) + "file" + iFileTypeCounter)
498 Dateityp.Select (iFileTypeCounter)
499 sleep (1)
500 Printlog " Saving file: " + (ConvertPath (NewFileDir) + ("file" + (iFileTypeCounter) + "." + left(right(Dateityp.GetSelText,4),3)))
501 SavedFile(iFileTypeCounter) = ("file" + (iFileTypeCounter) + "." + left(right(Dateityp.GetSelText,4),3))
502 Speichern.Click
503 Kontext "Active"
504 if Active.Exists(2) then Active.Yes ' File already exists, overwrite?
505 'printlog " Saved file ( SavedFile(" + iFileTypeCounter + ") ) as: '" + SavedFile(iFileTypeCounter) +"'."
506 Kontext "AlienWarning"
507 if AlienWarning.Exists(2) then AlienWarning.OK
508 kontext "DocumentImpress"
509 Next iFileTypeCounter
510 printlog "Close the file."
511 FileClose
513 printlog "Load the different files."
514 iCounter = 0
515 For iCounter = 1 to (iFileTypeCounter-1)
516 Printlog " Will try to open: " + (ConvertPath (NewFileDir) + SavedFile(iCounter))
517 CALL hFileOpen(ConvertPath (NewFileDir) + SavedFile(iCounter))
518 CALL hCloseDocument
519 printlog " Will try to delete: " + (ConvertPath (NewFileDir) + SavedFile(iCounter))
520 app.Kill (ConvertPath (NewFileDir) + SavedFile(iCounter))
521 Next iCounter
523 end function
524 '-------------------------------------------------------------------------------
525 function setCharacterLanguage(sLanguage as string) as boolean
527 setCharacterLanguage = FALSE
528 FormatCharacter
529 WaitSlot (1000)
530 Kontext
531 Messagebox.SetPage TabFont
532 kontext "TabFont"
533 sleep 1
534 printlog "sLanguage = " + sLanguage
535 if (bAsianLan) then 'Eastern languages 'OR
536 try
537 printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
538 LanguageWest.select (sLanguage) 'East
539 catch
540 printlog "Language.GetSelText = " + Language.GetSelText
541 Language.select (sLanguage) 'East
542 endcatch
544 setCharacterLanguage = TRUE
545 elseif (iSprache = 07) then
546 printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
547 LanguageWest.select (sLanguage)
548 else
549 try
550 printlog "LanguageWest.GetSelText = " + LanguageWest.GetSelText
551 LanguageWest.select (sLanguage)
552 catch
553 printlog "Language.GetSelText = " + Language.GetSelText
554 Language.select (sLanguage)
555 endcatch
556 setCharacterLanguage = TRUE
557 end if
558 TabFont.Ok
559 sleep 1
560 end function
562 '-------------------------------------------------------------------------------
563 function toggleGermanSpellchecking as string
565 printlog " activate old german spellchecking "
566 printlog "+ Tools->Options "
567 ToolsOptions
568 printlog "+ select tabpage 'writing aids' in category 'Languagesettings' "
569 hToolsOptions("LANGUAGESETTINGS","WRITINGAIDS")
570 kontext "TabLinguistik"
571 printlog "+ hopefully it never changes for any reason between the languages!: select the 8th entry 'German spelling - old' "
572 printlog " - 'German Spelling - old' ?= " + Optionen.getItemText(8)
573 Optionen.select(8)
574 printlog "+ default is 'unselected' - i can't check it automatically - so i depend on it! "
575 printlog "+ press [space] to select it"
576 Optionen.typeKeys "<space>"
577 Kontext "ExtrasOptionenDlg"
578 printlog "+ close options with OK button "
579 ExtrasOptionenDlg.OK
580 end function
582 '-------------------------------------------------------------------------------
583 function sAnalyseContextMenu(iItems as integer, optional iError as long) as integer
585 dim i as integer
586 dim y as integer
587 dim w as integer
588 dim x as integer
589 dim z as integer
590 dim f as string
591 dim iSlot as integer
592 dim iSpecialCharacterEntry as integer
593 dim bNoContextMenu as boolean
594 dim iTemp as long
595 dim sCandidates(5) as string
596 dim bDifferent as boolean
597 dim iInternError as long
598 dim iError1 as long ' misplaced
599 'i22192: context menu opens not on cursor position
600 dim iError2 as long ' no context menu
602 printlog "goto start of textbox "
603 call hTypeKeys "<mod1 home>"
604 printlog "for every word, check the context menu to get suggestions for correction "
605 for i = 0 to (iItems-1)
606 printlog " copy current word to clipboard "
607 call hTypeKeys "<Shift mod1 right>"
608 EditCopy
609 sCandidates(1) = getClipboardText()
610 if (" " = right(sCandidates(1),1)) then
611 sCandidates(1) = left(sCandidates(1),len(sCandidates(1))-1)
612 end if
613 call hTypeKeys "<mod1 left>"
614 printlog " open context menu "
615 printlog " About to call the ContextMenu."
616 call hOpenContextMenu()
617 sleep 3
618 printlog " Just opened ContextMenu."
619 ' collecting criteria for underlining:
620 ' 1st one: is word selected? yes: underlined;
622 printlog " If the string vnd.sun.search:SubMenu (the SunSearch-menu) is found in the menu, we'll skip that word. "
624 'Get first entry.
625 f = MenuGetItemCommand (MenuGetItemID (1))
626 printlog "f = '" + f + "'."
627 'If it's "vnd.sun.search:SubMenu" , then skip the word. Printlog "Word not underlined, Search-Toolbar active."
628 if f <> "vnd.sun.search:SubMenu" then
629 try ' WorkAround ##
630 editcopy
631 sCandidates(2) = getClipboardText()
632 ' printlog "******************* " + getclipboardtext()
633 catch
634 sCandidates(2) = ""
635 ' printlog "###################################################"
636 endcatch
637 ' if (1) is different from nonempty (2) then the wrong word is selected
638 if (sCandidates(1) <> sCandidates(2)) then
639 if ("" <> sCandidates(2)) then
640 ' printlog "############ " + sCandidates(1) + " ################## " + sCandidates(2) + " #####################"
641 bDifferent = TRUE
642 iError1 = iError1 + (2^i)
643 else
644 bDifferent = false
645 ' no word is selected... a) not underlined b) no context menu open
646 end if
647 else
648 ' printlog "******************* " + sCandidates(1)
649 bDifferent = FALSE
650 end if
651 ' check if context menu opened
652 try
653 x = hMenuItemGetCount
654 ' successfully opened context menu
655 bNoContextMenu = false
656 catch
657 ' context menu not open
658 bNoContextMenu = true
659 iError2 = iError2 + (2^i)
660 ' in writer it would work... :-( #i23568#
661 ' warnlog ""+i+" C: " + x + ";------ " + getClipboardText + " -------- "
662 endcatch
663 ' if context menu open do....
664 if (not bNoContextMenu) then
665 ' printlog ""+i+" C: " + x + ";------ " + getClipboardText + " -------- " + hMenuItemGetText(1)
666 printlog " analyze context menu entries "
667 for y = 1 to x
668 z = hMenuGetItemId(y)
669 if (1 = y) then iSlot = z ' criteria for WorkAround
670 if (z = 27019) then iSpecialCharacterEntry = y ' entry to select for WorkAround
671 Printlog ("---i: "+ y +"; " + z + " ; " +hMenuItemGetText(y) + " ; " + hMenuGetItemCommand(y))
672 next y
673 printlog " if first slot not a spelling suggestion -> WorkAround 112919 "
674 printlog " close Context Menu "
675 if (iSlot <> 10456) then
676 if (not bDifferent) then ' WorkAround ##
677 ' qaerrorlog "" + iSlot + " UNDERLINED"
678 iTemp = iTemp + (2^i)
679 end if
680 call hMenuClose()
681 else
682 ' printlog "" + iSlot + " not underlined"
683 'InsertSpecialCharacterDraw
684 hMenuSelectNr(iSpecialCharacterEntry) ' because of bug #112919#
685 kontext "Sonderzeichen"
686 Sonderzeichen.Cancel '
687 end if
688 end if
689 else
690 Printlog "Word not underlined, Search-Toolbar active."
691 call hMenuClose()
692 end if
693 Sleep (1)
694 printlog " goto next word with keys [strg]+[right] "
695 call hTypeKeys "<mod1 right>"
696 next i
697 printlog " leave textbox edit mode "
699 iInternError = iError1 OR iError2
700 if (iError1 > 0) then
701 qaErrorLog "#i22192#: context menu opens not on cursor position"
702 printlog "" + sLongToBinary(iError1, 11)
703 end if
704 if (iError2 > 0) then
705 qaErrorLog "#i23568# context menu doesn't open in redlining mode before a punctuation mark"
706 printlog "" + sLongToBinary(iError2, 11)
707 end if
708 if (not isMissing(iError)) then
709 iError = iInternError
710 end if
711 sAnalyseContextMenu = iTemp
712 end function
714 '-------------------------------------------------------------------------------
715 function sLongToBinary(iTempIn as long, iCount as integer) as string
717 ' lsb left !
718 dim sTemp as string
719 dim i as integer
720 dim iMask as long
721 dim itemp as long
723 itemp = itempin
725 for i = 1 to iCount
726 iMask = iMask + (2^(i-1))
727 next i
729 sTemp = ""
730 iTemp = Itemp AND iMask
731 for i = 1 to iCount
732 if ((iTemp MOD 2) = 1) then
733 sTemp = sTemp + "1"
734 else
735 sTemp = sTemp + "0"
736 end if
737 iTemp = INT (iTemp / 2)
738 next i
739 sLongToBinary = sTemp
740 end function
742 '-------------------------------------------------------------------------------
743 function sBinaryToLong(sTempIn as String) as long
745 ' lsb left !
746 dim iTemp as long
747 dim i as integer
748 dim sTemp as string
750 sTemp = sTempin
752 for i = 1 to len(sTemp)
753 if (mid(sTemp, i, 1) = "1") then
754 iTemp = itemp + (2^(i-1))
755 end if
756 next i
757 sBinaryToLong = iTemp
758 end function
760 '-------------------------------------------------------------------------------
761 function fGetIntoDictionary as boolean
762 dim bFound as boolean
763 dim iBooks as integer
764 dim i as integer
766 iBooks = Benutzerwoerterbuch.GetItemCount
767 i=0
768 bFound=TRUE
769 while (bFound AND (i < iBooks))
770 inc i
771 Benutzerwoerterbuch.select i
772 printlog Benutzerwoerterbuch.getSelText + i
773 try
774 Bearbeiten.Click
775 bFound = FALSE
776 catch
777 printLog "wIgLi" + i
778 endcatch
779 wend
780 fGetIntoDictionary = bFound
781 end function
783 '-------------------------------------------------------------------------------
784 function hSelectInList (window, sEntry as String) as Boolean
786 printlog " alternativ method to 'hDoubleClickInList' (without mouse) "
787 printlog "+ window: name of list "
788 printlog "+ sEntry: string to find in list "
789 printlog "+ ReturnValue: if found: TRUE; else FALSE "
790 Dim i as Integer
791 Dim sTemp as String
792 Dim sLastTemp as String
794 printlog " go through list from bottom and stop on the entry sEntry "
795 window.TypeKeys "<End>"
796 sTemp = ""
797 do
798 sLastTemp = sTemp
799 sTemp = window.GetText
800 window.TypeKeys "<Up>"
801 loop while ((sEntry <> sTemp) AND (sLastTemp <> sTemp))
802 printlog " press key [Return] "
803 if (sEntry = sTemp) then
804 window.TypeKeys "<Return>"
805 hSelectInList = TRUE
806 else
807 hSelectInList = FALSE
808 endif
809 end function
811 '-------------------------------------------------------------------------------
812 function hWalkTheStyles2 (atemp)
814 'function hWalkTheStyles2 (bSet as boolean, aSettings(), atemp as variant) as string
815 dim i as integer
816 dim x as integer
817 dim itemp
818 dim bSet
819 dim aSettings(5,5)
820 ' dim atemp
822 printlog " Organizer "
823 i=1
824 Kontext
825 printlog aSettings(i,3)
826 printlog aSettings(i,2)
827 printlog val(aSettings(i,1))
828 printlog atemp
829 Messagebox.SetPage TabArea
830 kontext "TabArea"
831 atemp = Hatching
832 printlog atemp
834 if aSettings(i,3) then
835 itemp = val(aSettings(i,1))
836 printlog isobject(atemp)
837 printlog isNumeric(atemp)
838 Hatching.check
839 atemp.check
841 else
842 ' aSettings(i,1).Uncheck
843 endif
844 i=2
845 Kontext
846 Messagebox.SetPage TabSchatten
847 kontext "TabSchatten"
849 Kontext
850 Messagebox.SetPage TabVerwalten
851 kontext "TabVerwalten"
852 printlog " Line "
853 i=2
854 Kontext
855 Messagebox.SetPage TabLinie
856 kontext "TabLinie"
857 'Context: *Line; Line Styles; Arrow Styles
858 printlog " Area "
859 i=3
860 Kontext
861 Messagebox.SetPage TabArea
862 kontext "TabArea"
863 'Context: *Area; *Shadow; Transparency; Colors; Gradients; Hatching; Bitmaps
864 printlog " Shadowing "
865 i=4
866 Kontext
867 Messagebox.SetPage TabSchatten
868 kontext "TabSchatten"
869 printlog " Transparency "
870 i=5
871 Kontext
872 Messagebox.SetPage TabTransparenz
873 kontext "TabTransparenz"
874 printlog " Font "
875 i=6
876 Kontext
877 Messagebox.SetPage TabFont
878 kontext "TabFont"
879 'Context: *Font; *Font Effect; Position
880 printlog " Font Effect "
881 i=7
882 Kontext
883 Messagebox.SetPage TabFontEffects
884 kontext "TabFontEffects"
885 printlog " Indents & Spacing "
886 i=8
887 Kontext
888 Messagebox.SetPage TabEinzuegeUndAbstaende
889 kontext "TabEinzuegeUndAbstaende"
890 'Context: *Indents & Spacing; *Alignment; *Tabs
891 printlog " Text "
892 i=9
893 Kontext
894 Messagebox.SetPage TabText
895 Kontext "TabText"
896 'Context: *Text; *Text Animation
897 printlog " Text Animation "
898 i=10
899 Kontext
900 Messagebox.SetPage TabLauftext
901 Kontext "TabLauftext"
902 printlog " Dimensioning "
903 i=11
904 Kontext
905 Messagebox.SetPage TabBemassung
906 Kontext "TabBemassung"
907 printlog " Connector "
908 i=12
909 Kontext
910 Messagebox.setpage TabVerbinder
911 Kontext "TabVerbinder"
912 printlog " Alignment "
913 i=13
914 Kontext
915 Messagebox.setpage TabAusrichtungAbsatz
916 Kontext "TabAusrichtungAbsatz"
917 printlog " Tabs "
918 i=14
919 Kontext
920 Messagebox.setpage TabTabulator
921 Kontext "TabTabulator"
923 ' printlog " switch to tabpage 'Bullets' "
924 ' Messagebox.SetPage TabBullet
925 ' Kontext "TabBullet"
926 ' sleep 1
927 ' Call DialogTest (TabBullet)
928 ' sleep 1
929 ' Kontext
930 ' printlog " switch to tabpage 'Numbering Type' "
931 ' Messagebox.SetPage TabNumerierungsart
932 ' Kontext "TabNumerierungsart"
933 ' sleep 1
934 ' Call DialogTest (TabNumerierungsart)
935 ' sleep 1
936 ' Kontext
937 ' printlog " switch to tabpage 'Graphics' "
938 ' Messagebox.SetPage TabGrafiken
939 ' Kontext "TabGrafiken"
940 ' sleep 1
941 ' Call DialogTest (TabGrafiken)
942 ' sleep 1
943 ' Kontext
944 ' printlog " switch to tabpage 'Customize' "
945 ' Messagebox.SetPage TabOptionenNumerierung
946 ' Kontext "TabOptionenNumerierung"
947 ' sleep 1
948 ' Call DialogTest (TabOptionenNumerierung)
949 ' sleep 1
950 end function
952 '-------------------------------------------------------------------------------
953 function fGetSlideNumber (optional sCompare as integer) as integer
955 printlog " PRESUPPOSITION: open Navigator "
956 printlog "+ ENTRY: with or without a string "
957 printlog "+ if string is given, it is compared with the actual selected slidename in the navigator, if not equal print warnlog "
958 printlog "+ RETURN: selected slidename in the navigator / empty string if navvigator is not open "
959 printlog "+ EXIT: kontext on DocumentPresentation "
961 Kontext "NavigatorDraw"
962 printlog "Checking if navigator is open, closing and opening for updating.."
963 if NavigatorDraw.exists (5) then
964 ViewNavigator ' to Workaround not updated navi :-(
965 sleep 3
966 ViewNavigator
967 sleep 3
968 printlog " check in list, if the page changed "
970 else
971 printlog "If Navigator is not open, opening it now."
972 ViewNavigator
973 endif
974 sleep (1)
975 printlog "Getting current slide number from navigator."
976 fGetSlideNumber = val (right (Liste.GetSelText, 1))
977 printlog "fGetSlideNumber has the value " & fGetSlideNumber
978 printlog "Checking if slidenumber fits to Compare number, if this is given behind procedure call."
979 if (isMissing (sCompare) = False) then ' if optional parameter exists
980 if fGetSlideNumber <> sCompare then
981 printlog "Warnlog if Slidenumber is not what it should be."
982 Warnlog "Slide Number is '" + fGetSlideNumber + "'; should: '" + sCompare + "'"
983 endif
984 endif
985 Kontext "DocumentPresentation"
986 end function
988 '-------------------------------------------------------------------------------
989 function fGetSlideCount (optional iCount as integer) as integer
991 printlog " purpose: open navigator in impress and check/get number of slides from listbox "
992 printlog "+ input : optional number of slides, to compare to: if different warnlog "
993 printlog "+ output : number of slides in presentation "
994 dim i as integer
996 printlog " open navigator "
997 Kontext "Navigator"
998 if Navigator.exists then
999 Printlog "Navigator: open :-)"
1000 else
1001 Printlog "Navigator: NOT available :-( will be opened now!"
1002 ViewNavigator
1003 endif
1004 Sleep 1
1005 printlog " count rows in list of navigator: usually number of slides "
1006 Kontext "NavigatorDraw"
1007 i = Liste.GetItemCount
1008 if (isMissing(iCount) = FALSE) then
1009 if (i <> iCount) then
1010 Warnlog "Error! Expected slides: '" + iCount + "'; but are '" + i +"'"
1011 else
1012 Printlog "ok"
1013 endif
1014 endif
1015 printlog " close navigator "
1016 ViewNavigator
1017 fGetSlideCount = i
1018 end function
1020 '-------------------------------------------------------------------------------
1021 function fGetSlideName (optional sCompare as string) as string
1023 printlog " PRESUPPOSITION: open Navigator "
1024 printlog "+ ENTRY: with or without a string "
1025 printlog "+ if string is given, it is compared with the actual selected slidename in the navigator, if not equal print warnlog "
1026 printlog "+ RETURN: selected slidename in the navigator / empty string if navvigator is not open "
1027 printlog "+ EXIT: kontext on DocumentPresentation "
1029 Kontext "NavigatorDraw"
1030 if NavigatorDraw.exists (5) then
1031 sleep 3
1032 printlog "check in list, if the page changed"
1033 fGetSlideName = Liste.GetSelText
1034 else
1035 warnlog "Navigator not open! in function fGetSlideName TBO"
1036 Kontext "NavigatorDraw"
1037 fGetSlideName = ""
1038 endif
1039 if (isMissing (sCompare) = False) then ' if optional parameter exists
1040 printlog "fGetSlideName is: " & fGetSlideName
1041 printlog "sCompare is: " & sCompare
1042 if fGetSlideName <> sCompare then
1043 warnlog " Slide Name is '" + fGetSlideName + "'; should be: '" + sCompare + "'"
1044 endif
1045 endif
1046 Kontext "DocumentPresentation"
1047 end function
1049 '------------------------------------------------------------------------------
1050 function fGetSetPageBackground (iSelect as integer, iWhere as integer) as integer
1052 printlog " Get or Set the Page Background via stylist (iWhere = 0) or format menue (...= 1) "
1053 printlog "+ if iSelect > 0 then set, else get "
1054 printlog "+ return selected color number or -1 on error "
1056 if (iWhere = 0) then
1057 printlog " Stylist -> Background -> Kontext menu -> modify -> Area -> Color "
1058 fGetSetPageBackground = -1 ' worst case
1059 Kontext "Stylist"
1060 if Stylist.NotExists (5) then
1061 FormatStylist
1062 Kontext "Stylist"
1063 if Stylist.NotExists (5) then warnlog "Could not open stylist :-("
1064 end if
1065 Praesentationsvorlagen.Click
1066 sleep 1
1067 Vorlagenliste.TypeKeys "<PAGEDOWN>"
1068 hDoubleClickInList (vorlagenliste, glLocale(5), TRUE)
1069 sleep 1
1070 vorlagenliste.OpenContextMenu
1071 sleep 1
1072 hMenuSelectNr (1)
1073 else
1074 printlog " Format -> Page -> Background -> Color "'FormatPage
1075 sleep 1
1076 try ' this was just paranoia to find a not mentioned messagebox
1077 FormatSlideDraw
1078 catch
1079 warnlog "slooooow slot TBO :-("
1080 exit function
1081 endcatch
1082 sleep 1
1083 Kontext
1084 if (active.getrt = 373) then
1085 Active.SetPage TabArea
1086 else
1087 warnlog active.getrt
1088 if (active.getrt = 304) then
1089 warnlog active.gettext
1090 endif
1091 endif ' paranoia end ----------------------------------------------
1092 endif
1094 kontext "TabArea"
1095 if TabArea.exists then
1096 FillOptions.Select 2 ' Select "Colour"
1097 if (iSelect > 1) then ' Select the entry
1098 ' Color.Check
1099 if (iSelect < ColourList.GetItemCount) then
1100 ColourList.Select iSelect
1101 else
1102 warnlog "Select entry is larger than list :-("
1103 endif
1104 fGetSetPageBackground = ColourList.GetSelIndex
1105 if fGetSetPageBackground = 0 then
1106 warnlog "There were no color selected in the list."
1107 endif
1108 TabArea.OK
1109 sleep 2
1110 kontext
1111 if (active.exists (2)) then
1112 warnlog "active about <changing the background for all pages ?>: '" + active.gettext + "'"
1113 active.yes
1114 else
1115 printlog "No message about 'changing the background for all pages ?' :-("
1116 endif
1117 else ' yust read the selected entry
1118 if FillOptions.GetSelIndex = 2 then
1119 fGetSetPageBackground = ColourList.GetSelIndex
1120 TabArea.Cancel
1121 else
1122 warnlog "Can't get value, because something different than color is selected :-("
1123 endif
1124 endif
1125 else
1126 kontext "TabFont"
1127 if TabFont.exists then
1128 Warnlog "Something wrong with the word " + glLocale(5) + ". It was either not found or wrong."
1129 else
1130 warnlog "Error: Can't get context menu ?"
1131 endif
1132 endif
1134 if (iWhere = 0) then
1135 sleep 1 ' ABSOLUT NECESSARY !!! (TBO) else crash on UNIX on following command!!!!
1136 FormatStylist ' closing
1137 endif
1138 sleep 4
1139 end function
1141 '------------------------------------------------------------------------------
1142 function CreateTextSetEffectAndAngle
1144 kontext "DocumentImpress"
1145 SetClipBoard "Revenue"
1146 DocumentImpress.TypeKeys "<MOD1 V>"
1147 SlideShowCustomAnimation
1148 Kontext "Tasks"
1149 WaitSlot (1000)
1150 EffectAdd.Click
1151 kontext
1152 printlog " Switch to TabPage: Entrance "
1153 active.setPage(TabEntrance)
1154 kontext "TabEntrance"
1155 if TabEntrance.exists(5) then
1156 printlog " select in the listbox 'Effects' the second entry"
1157 Effects.select (24)
1158 printlog " select speed 'Fast' -> fourth item in list "
1159 Speed.Select 2
1160 TabEntrance.OK
1161 end if
1162 kontext "tasks"
1163 EffectStart.TypeKeys "<HOME><DOWN>" 'Select the second entry.
1165 kontext "DocumentImpress"
1166 FormatPositionAndSize
1167 WaitSlot (1000)
1168 kontext
1169 active.setPage(TabDrehung)
1170 kontext "TabDrehung"
1172 Winkel.TypeKeys "45"
1173 TabDrehung.OK
1174 WaitSlot (1000)
1175 kontext "DocumentImpress"
1176 end function
1178 '-------------------------------------------------------------------------------
1179 function fGetPresentationStyle (optional sCompare as integer) as integer
1181 printlog "+ ENTRY: with or without a string "
1182 printlog "+ if string is given, it is compared with the LAST CHARACTER of the actual selected style in the stylist, if not equal print warnlog "
1183 printlog "+ RETURN: LAST CHARACTER of the actual selected style in the stylist "
1184 dim sTemp as integer
1185 dim sTemp0 as string
1187 sTemp = (-1)
1188 printlog " open stylist if not already open: Format->Stylist "
1189 kontext "Stylist"
1190 if (Stylist.exists = FALSE) then
1191 try
1192 FormatStylist
1193 catch
1194 sleep 1
1195 endcatch
1196 endif
1197 kontext "Stylist"
1198 if Stylist.exists(5) then
1199 sTemp0 = Vorlagenliste.GetSeltext
1200 sTemp = val(right (sTemp0, 1))
1201 if (isMissing (sCompare) = False) then ' if optional parameter exists
1202 if sTemp <> sCompare then
1203 Warnlog "Style Name's last character is '" + sTemp + "'; should be: '" + sCompare + "'"
1204 endif
1205 endif
1206 FormatStylist
1207 else
1208 Warnlog "The Stylist could not be opened for unknown reasons :-("
1209 endif
1210 fGetPresentationStyle = sTemp
1211 end function
1213 '-------------------------------------------------------------------------------
1214 function hPrepareSearchBUG
1216 ' warnlog "TBO: WA for bug #101974#"
1217 ' Kontext "DocumentImpressOutlineView"
1218 ' DocumentImpressOutlineView.TypeKeys ("<mod1 home>")
1219 end function
1221 '-------------------------------------------------------------------------------
1222 function makeNumOutOfText ( sNum as String ) as String
1224 Dim sDummy as String
1225 Dim iComma as Integer
1227 iComma = Instr ( sNum, "," )
1228 if iComma <> 0 then
1229 sDummy = Left ( sNum, iComma-1 ) + "." + Mid ( sNum, iComma+1, len ( sNum )-2 )
1230 else
1231 sDummy = Left ( sNum, len (sNum)-2 )
1232 end if
1233 makeNumOutOfText = sDummy
1234 end function
1236 '-------------------------------------------------------------------------
1237 function wIgnorierenlisteLoeschen as boolean
1239 Dim i as integer
1240 Dim j as integer
1241 dim iBooks as integer
1243 ToolsOptions
1244 Call hToolsOptions("LANGUAGESETTINGS","WRITINGAIDS")
1245 Sleep 3
1246 if (fGetIntoDictionary) then
1247 qaErrorLog "wIgLi"
1248 wIgnorierenlisteLoeschen = FALSE
1249 exit function
1250 end if
1251 Kontext "BenutzerwoerterbuchBearbeiten"
1252 sleep 1
1253 iBooks = Buch.GetItemCount
1254 for i = 1 to iBooks
1255 Buch.Select i
1256 if Left$(Buch.GetSelText,13)="IgnoreAllList" then
1257 sleep 2
1258 while (Loeschen.IsEnabled)
1259 Loeschen.Click
1260 sleep 1
1261 wend
1262 end if
1263 next i
1264 Kontext "BenutzerwoerterbuchBearbeiten"
1265 BenutzerwoerterbuchBearbeiten.Cancel
1266 Kontext "ExtrasOptionenDlg"
1267 ExtrasOptionenDlg.OK
1268 wIgnorierenlisteLoeschen = TRUE
1269 end function
1271 '-------------------------------------------------------------------------------
1272 function optionstest
1274 dim filedialogue as boolean
1275 dim lala as integer
1276 dim optsound as integer
1277 dim os as integer
1278 dim oa as integer
1279 dim odc as integer
1280 dim ota as integer
1281 dim ets as integer
1282 dim etspeed as integer
1283 dim etrep as integer
1284 dim etshap as integer
1285 dim etgt as integer
1287 Kontext "Tasks"
1288 EffectOptions.Click
1289 kontext "TabEffect"
1290 if TabEffect.Exists(5) then
1291 optsound = Sound.GetItemCount
1292 for os = 1 to optsound
1293 Sound.Select os
1294 kontext "OeffnenDlg"
1295 if OeffnenDlg.Exists (5) then
1296 filedialogue = TRUE
1297 OeffnenDlg.Close
1298 kontext "TabEffect"
1299 else
1300 kontext "TabEffect"
1301 endif
1302 next os
1303 if AfterAnimation.isEnabled AND AfterAnimation.isVisible then
1304 for oa = 1 to AfterAnimation.GetItemCount
1305 AfterAnimation.Select oa
1306 if DimColor.isEnabled then
1307 for odc = 1 to DimColor.GetItemCount
1308 DimColor.Select odc
1309 next odc
1310 endif
1311 if DelayBetweenCharacters.isEnabled then
1312 for odc = 1 to DelayBetweenCharacters.GetItemCount
1313 DelayBetweenCharacters.Select odc
1314 next odc
1315 endif
1316 next oa
1317 else
1318 if DelayBetweenCharacters.isEnabled then
1319 for odc = 1 to DelayBetweenCharacters.GetItemCount
1320 DelayBetweenCharacters.Select odc
1321 next odc
1322 endif
1323 endif
1324 for ota = 1 to TextAnimation.GetItemCount
1325 TextAnimation.Select ota
1326 next ota
1327 printlog " switch to TabPage 'Timing' "
1328 Kontext
1329 Active.SetPage TabTiming
1330 kontext "TabTiming"
1331 if TabTiming.Exists(5) then
1332 for ets = 1 to TimingStart.GetItemCount
1333 TimingStart.Select ets
1334 next ets
1335 if Delay.isVisible AND Delay.isEnabled then
1336 Delay.GetText
1337 else
1338 Warnlog "Delay in Effect Options were not to be found."
1339 endif
1340 if Speed.isVisible AND Speed.isEnabled then
1341 for etspeed = 1 to Speed.GetItemCount
1342 Speed.Select etspeed
1343 next etspeed
1344 else
1345 printlog " No Speed-entry for this effect."
1346 endif
1347 if Repeat.isVisible AND Repeat.isEnabled then
1348 for etrep = 1 to Speed.GetItemCount
1349 Repeat.Select etrep
1350 next etrep
1351 else
1352 Printlog "Repeat in Effect Options were not to be found."
1353 endif
1354 Rewind.Check
1355 Rewind.UnCheck
1356 TriggerAnimate.IsChecked
1357 TriggerStart.IsChecked
1358 if Shape.isVisible AND Shape.isEnabled then
1359 for etshap = 1 to Shape.GetItemCount
1360 Shape.Select etshap
1361 next etshap
1362 else
1363 Warnlog "Shape in Effect Options were not to be found."
1364 endif
1365 else
1366 warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: Timing TabPage didn't work."
1367 endif
1368 printlog " switch to TabPage 'Timing' "
1369 Kontext
1370 active.setPage TabTextAnimation
1371 kontext "TabTextAnimation"
1372 if TabTextAnimation.Exists(5) then
1373 lala = GroupText.GetItemCount
1374 for etgt = 1 to lala
1375 GroupText.Select etgt
1376 if AutomaticallyAfter.IsEnabled then
1377 AutomaticallyAfter.Check
1378 AutomaticallyAfter.TypeKeys "<UP>"
1379 endif
1380 if AnimateAttachedShape.IsEnabled then
1381 AnimateAttachedShape.Check
1382 if AnimateAttachedShape.IsChecked = FALSE then
1383 Warnlog "AnimateAttachedShape should have been checked"
1384 endif
1385 endif
1386 if InreverseOrder.IsEnabled then
1387 InreverseOrder.Check
1388 if InreverseOrder.IsChecked = FALSE then
1389 Warnlog "InreverseOrder should have been checked"
1390 endif
1391 endif
1392 next etgt
1393 TabTextAnimation.Cancel
1394 else
1395 warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: TextAnimation TabPage didn't work."
1396 endif
1397 else
1398 warnlog "Impress:Tasks Pane:Custom Animation:... button didn't work."
1399 endif
1400 Kontext "Tasks"
1402 end function
1404 '-------------------------------------------------------------------------------
1405 function optionstest2
1407 dim filedialogue as boolean
1408 dim lala as integer
1409 dim optsound as integer
1410 dim os as integer
1411 dim oa as integer
1412 dim odc as integer
1413 dim ota as integer
1414 dim ets as integer
1415 dim etspeed as integer
1416 dim etrep as integer
1417 dim etshap as integer
1418 dim etgt as integer
1420 Kontext "Tasks"
1421 EffectOptions.Click
1422 kontext "TabEffect"
1423 if TabEffect.Exists(5) then
1424 Sound.Select 5
1425 sleep 4
1426 if Play.IsEnabled then
1427 Play.Click
1428 else
1429 warnlog "Play should have been enabled after selecting a sound."
1430 endif
1431 AfterAnimation.Select 2
1432 if DimColor.isEnabled then
1433 DimColor.Select 5
1434 else
1435 Warnlog "DimColor should have been enabled"
1436 endif
1437 TextAnimation.Select 3
1438 if DelayBetweenCharacters.isEnabled then
1439 DelayBetweenCharacters.More 5
1440 else
1441 Warnlog "DelayBetweenCharacters should have been enabled"
1442 endif
1443 printlog " switch to TabPage 'Timing' "
1444 Kontext
1445 Active.SetPage TabTiming
1446 kontext "TabTiming"
1447 if TabTiming.Exists(5) then
1448 TimingStart.Select 2
1449 if Delay.isVisible AND Delay.isEnabled then
1450 Delay.More 5
1451 else
1452 Warnlog "Delay in Effect Options were not to be found."
1453 endif
1454 if Speed.isVisible AND Speed.isEnabled then
1455 Speed.Select 3
1456 else
1457 Printlog "Speed in Effect Options were not to be found."
1458 endif
1459 if Repeat.isVisible then
1460 if Repeat.isEnabled then
1461 for etrep = 1 to Speed.GetItemCount
1462 Repeat.Select etrep
1463 next etrep
1464 else
1465 Warnlog "Repeat in Effect Options were not enabled."
1466 endif
1467 else
1468 Warnlog "Repeat in Effect Options were not visible."
1469 endif
1470 if Rewind.isVisible then
1471 if Rewind.isEnabled then
1472 Rewind.Check
1473 else
1474 Printlog "Rewind in Effect Options were not to be found."
1475 endif
1476 else
1477 Printlog "Rewind in Effect Options were not to be found."
1478 endif
1479 if Rewind.isVisible then
1480 if Rewind.isEnabled then
1481 Rewind.Check
1482 Rewind.UnCheck
1483 else
1484 Warnlog "Rewind in Effect Options were not enabled."
1485 endif
1486 else
1487 Warnlog "Rewind in Effect Options were not visible."
1488 endif
1489 TriggerAnimate.IsChecked
1490 TriggerStart.IsChecked
1491 if Shape.isVisible then
1492 if Shape.isEnabled then
1493 for etshap = 1 to Shape.GetItemCount
1494 Shape.Select etshap
1495 next etshap
1496 else
1497 Warnlog "Shape in Effect Options were not to be found."
1498 endif
1499 else
1500 Warnlog "Shape in Effect Options were not to be found."
1501 endif
1502 else
1503 warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: Timing TabPage didn't work."
1504 endif
1505 printlog " switch to TabPage 'Timing' "
1506 Kontext
1507 active.setPage TabTextAnimation
1508 kontext "TabTextAnimation"
1509 if TabTextAnimation.Exists(5) then
1510 lala = GroupText.GetItemCount
1511 for etgt = 1 to lala
1512 GroupText.Select etgt
1513 if AutomaticallyAfter.IsEnabled then
1514 AutomaticallyAfter.Check
1515 AutomaticallyAfter.TypeKeys "<UP>"
1516 endif
1517 if AnimateAttachedShape.IsEnabled then
1518 AnimateAttachedShape.Check
1519 if AnimateAttachedShape.IsChecked = FALSE then
1520 Warnlog "AnimateAttachedShape should have been checked"
1521 endif
1522 endif
1523 if InreverseOrder.IsEnabled then
1524 InreverseOrder.Check
1525 if InreverseOrder.IsChecked = FALSE then
1526 Warnlog "InreverseOrder should have been checked"
1527 endif
1528 endif
1529 next etgt
1530 TabTextAnimation.Cancel
1531 else
1532 warnlog "Impress:Tasks Pane:Custom Animation:Effect Options: TextAnimation TabPage didn't work."
1533 endif
1534 else
1535 warnlog "Impress:Tasks Pane:Custom Animation:... button didn't work."
1536 endif
1537 Kontext "Tasks"
1539 end function
1540 '-------------------------------------------------------------------------------