testautomation/writer/optional/includes/clipboard/clipbrd_func.inc

   1 '**************************************************************************
   2 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   3 '*
   4 '* Copyright 2008 by Sun Microsystems, Inc.
   5 '*
   6 '* OpenOffice.org - a multi-platform office productivity suite
   7 '*
   8 '* $RCSfile: clipbrd_func.inc,v $
   9 '*
  10 '* $Revision: 1.2 $
  11 '*
  12 '* last change: $Author: vg $ $Date: 2008-08-18 12:24:28 $
  13 '*
  14 '* This file is part of OpenOffice.org.
  15 '*
  16 '* OpenOffice.org is free software: you can redistribute it and/or modify
  17 '* it under the terms of the GNU Lesser General Public License version 3
  18 '* only, as published by the Free Software Foundation.
  19 '*
  20 '* OpenOffice.org is distributed in the hope that it will be useful,
  21 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 '* GNU Lesser General Public License version 3 for more details
  24 '* (a copy is included in the LICENSE file that accompanied this code).
  25 '*
  26 '* You should have received a copy of the GNU Lesser General Public License
  27 '* version 3 along with OpenOffice.org.  If not, see
  28 '* <http://www.openoffice.org/license.html>
  29 '* for a copy of the LGPLv3 License.
  30 '*
  31 '/************************************************************************
  32 '*
  33 '* owner : helge.delfs@sun.com
  34 '*
  35 '* short description : Functions for HTML-Test
  36 '*
  37 '************************************************************************
  38 '*
  39 ' #0 wPasteAvailableClipboardFormats(TheNumber as integer
  40 ' #0 wSetClipboardtestDefaults(ForWhat as string) as boolean
  41 ' #0 wInsertNewCalcSheet(SheetName as string) as booloean
  42 ' #0 wRenameCalcSheet(NewName as string) as boolean
  43 ' #0 wFilterSpecialCharacters(ToFilter as string) as string
  44 ' #0 ReplaceCharacter(stringToChange$
  45 ' #0 wChangeHTMLCompatibility ( optional RecentCompatibility as integer ) as integer
  46 '*
  47 '\***********************************************************************
  48
  49 function wPasteAvailableClipboardFormats(TheNumber as integer, CheckWhat as String )
  50     Dim i as integer, ClipboardFormat as string
  51     For i = 1 to TheNumber
  52         try
  53             Auswahl.Select i
  54         catch
  55             if i <= TheNumber then
  56                 QAErrorlog "Number of clipboard formats seems to be changed!"
  57             end if
  58             exit for
  59         endcatch
  60         ClipboardFormat = Auswahl.GetSeltext
  61         printlog "- Paste as: " + ClipboardFormat
  62         Select Case CheckWhat
  63             Case "ctext", "DRAW"
  64                 if lcase(gPlatform) = "sol" and lcase(ClipboardFormat) = "bitmap" then
  65                     QAErrorlog "#i49505#Paste drawing object as bitmap crashes office"
  66                     goto s_next_item
  67                 else
  68                     InhaltEinfuegen.Ok
  69                     Sleep 3
  70                 end if
  71             Case else
  72                 InhaltEinfuegen.Ok
  73                 Sleep 3
  74         end select
  75
  76         Select Case gApplication
  77             Case "CALC"
  78                 Kontext "TextImport"
  79                 if TextImport.Exists then TextImport.Ok
  80         end select
  81
  82         Kontext "Active"
  83         if Active.Exists then
  84             QAErrorlog " - " + Active.Gettext + "->Bug#110181"
  85             Active.Ok
  86         end if
  87         Call wDocSetContext
  88         Call wTypeKeys "<Escape>",2
  89         Select Case gApplication
  90             Case "WRITER","MASTERDOCUMENT","HTML"
  91                 Select Case CheckWhat
  92                     Case "text","field","table"
  93                     Call wTypeKeys "<Down><End><Return>"
  94                     Call wTypeKeys "(" + Clipboardformat + ")"
  95                     Call wTypeKeys "<End><Return>",2
  96             Case "frame", "DRAW", "graphicL", "graphicE", "ole", "control", "ctext"
  97                 'Call gMouseClick (50,100)
  98                 Call wTypeKeys ("<Escape>")
  99                 Call wTypeKeys "(" + Clipboardformat + ")"
 100                 if i < TheNumber Then
 101                     if gApplication <> "HTML" then
 102                         InsertManualBreak
 103                         Kontext "UmbruchEinfuegen"
 104                         Seitenumbruch.Check
 105                         UmbruchEinfuegen.OK
 106                     else
 107                         Call wTypeKeys ("<Return>" , 2)
 108                     end if
 109                 end if
 110         end select
 111         EditPasteSpecialWriter
 112
 113         Case "IMPRESS","DRAW"
 114             Call gMouseClick(7,7)
 115             Call wRenameImpressSlide(ClipboardFormat)
 116             if i < TheNumber Then
 117                 Call wInsertNewImpressSlide
 118                 EditPasteSpecial
 119             end if
 120         Case "CALC"
 121             printlog " Rename first sheet"
 122             if wRenameCalcSheet(Clipboardformat) = False then
 123                 Warnlog "Unable to rename Sheet Name !"
 124             end if
 125             if i < TheNumber Then
 126                 if wInsertNewCalcSheet(Clipboardformat) = False then
 127                     Warnlog "Unable to set Sheetname : " + Clipboardformat
 128                 end if
 129                 EditPasteSpecialCalc
 130
 131             end if
 132         end select
 133         s_next_item:
 134         Kontext "InhaltEinfuegen"
 135     next i
 136     kontext "NavigatorDraw"
 137     if NavigatorDraw.Exists then NavigatorDraw.Close
 138     kontext "Navigator"
 139     if Navigator.Exists then Navigator.Close
 140
 141     kontext "InhaltEinfuegen"
 142     f_exit:
 143     if InhaltEinfuegen.Exists then InhaltEinfuegen.Cancel
 144 end function
 145
 146 ' ---------------------------------------------------------------------------------
 147
 148 function wSetClipboardtestDefaults(ForWhat as string) as boolean
 149     printlog " Points cursor to beginning of document "
 150     Call hFileOpen (gtesttoolpath & "writer\optional\input\clipboard\writer.sxw")
 151     Call sMakeReadOnlyDocumentEditable
 152     Kontext "DocumentWriter"
 153     printlog " Jump to beginning of document "
 154     Call wTypeKeys "<Mod1 Home>"
 155     printlog " Check if beginning of document reached "
 156     Call wTypeKeys "<Mod1 Shift Right>"
 157     EditCopy
 158
 159     Select Case ForWhat
 160         Case "text"
 161         '"+ Select first paragraph "
 162         Call wTypeKeys "<Shift End>"
 163         Call wTypeKeys "<Shift Down>"
 164         '"+ Copy selected text "
 165
 166         Case "field"
 167         '"+ Select paragraph with 'Date Field' "
 168         Call wTypeKeys "<Down>",3
 169         Call wTypeKeys "<Home><Shift End>"
 170         '"+ Copy selected text "
 171
 172         Case "table"
 173         '"+ Select paragraph with 'Table' "
 174         Call wNavigatorAuswahl(2,1)
 175         'Call wTypeKeys "<Down>",6
 176         Call wTypeKeys "<Mod1 A>",2
 177         '"+ Copy selected table "
 178
 179         Case "frame"
 180         '"+ Select 'Frame' "
 181         Call wTypeKeys ( "<Shift F4>" )
 182         '"+ Copy selected frame "
 183
 184         Case "DRAW"
 185         '"+ Select 'Drawing Object' "
 186         Call wTypeKeys ( "<Shift F4>" )
 187         Call wTypeKeys "<Tab>"
 188         '"+ Copy selected Drawing Object "
 189
 190         Case "graphicL"
 191         '"+ Select 'Linked Graphic' "
 192         Call wTypeKeys ( "<Shift F4>" )
 193         Call wTypeKeys "<Tab>",2
 194         '"+ Copy selected Linked Graphic "
 195
 196         Case "graphicE"
 197         '"+ Select 'Embedded Graphic' "
 198         Call wTypeKeys ( "<Shift F4>" )
 199         Call wTypeKeys "<Tab>",3
 200         '"+ Copy selected Embedded Graphic "
 201
 202         Case "ole"
 203         '"+ Select 'OLE Object' "
 204         Call wTypeKeys ( "<Shift F4>" )
 205         Call wTypeKeys "<Tab>",4
 206         '"+ Copy selected OLE Object "
 207
 208         Case "control"
 209         '"+ Select 'Control' "
 210         Call wTypeKeys ( "<Shift F4>" )
 211         Call wTypeKeys "<Tab>",5
 212         '"+ Copy selected Control "
 213
 214         Case else
 215             Warnlog "Unknown object!"
 216     end select
 217
 218     try
 219         EditCopy
 220         EditCopy 'and a second time to make sure..
 221         wSetClipboardtestDefaults = True
 222     catch
 223         QAErrorlog "Error jump to beginning of document!"
 224         wSetClipboardtestDefaults = False
 225     endcatch
 226
 227     ' Because of Clipboard bug set
 228     wSetClipboardtestDefaults = True
 229 end function
 230
 231 ' ---------------------------------------------------------------------------------
 232
 233 function wInsertNewCalcSheet(SheetName as string) as boolean
 234     SheetName= wFilterSpecialCharacters(SheetName)
 235     printlog " Inserts a new shett and sets the name for it "
 236     InsertSheetCalc
 237     Kontext "TabelleEinfuegenCalc"
 238     if TabelleEinfuegenCalc.Exists then
 239         Nach.Check
 240         printlog " Check 'After current sheet' "
 241         NeuErstellen.Check
 242         printlog " Check 'New Sheet' "
 243         'Tabellenname.Settext SheetName
 244         printlog " Set Name of sheet "
 245         TabelleEinfuegenCalc.Ok
 246         printlog " Unable to set name of Sheet ? "
 247         Kontext "Active"
 248         if Active.Exists then
 249             if Active.GetRT = 304 then
 250                 Warnlog Active.Gettext
 251                 Active.Ok
 252                 Kontext "TabelleEinfuegenCalc"
 253                 if TabelleEinfuegenCalc.Exists then TabelleEinfuegenCalc.Cancel
 254                 wInsertNewCalcSheet = False
 255             else
 256                 wInsertNewCalcSheet = True
 257             end if
 258         else
 259             wInsertNewCalcSheet = True
 260         end if
 261     else
 262         Warnlog "Dialog 'Insert Sheet' not up!"
 263         wInsertNewCalcSheet = False
 264     end if
 265 end function
 266
 267 ' ---------------------------------------------------------------------------------
 268
 269 function wRenameCalcSheet(NewName as string) as boolean
 270     printlog " Renames an existing sheet in calc "
 271     FormatSheetRename
 272     Kontext "TabelleUmbenennen"
 273     if TabelleUmbenennen.Exists then
 274         TabellenName.Settext wFilterSpecialCharacters(NewName)
 275         TabelleUmbenennen.Ok
 276         Kontext "Active"
 277         if Active.Exists then
 278             if Active.GetRT = 304 then
 279                 Active.Ok
 280                 Kontext "TabelleUmbenennen"
 281                 if TabelleUmbenennen.Exists then TabelleUmbenennen.Cancel
 282                 wRenameCalcSheet = False
 283             else
 284                 wRenameCalcSheet = True
 285             end if
 286         else
 287             wRenameCalcSheet = True
 288         end if
 289     else
 290         wRenameCalcSheet = False
 291     end if
 292 end function
 293
 294 ' ---------------------------------------------------------------------------------
 295
 296 sub wInsertNewImpressSlide()
 297     InsertSlide
 298 end sub
 299
 300 ' ---------------------------------------------------------------------------------
 301
 302 sub wRenameImpressSlide(NewName as string)
 303     printlog " Edit->Layer->Rename "'
 304     try
 305         EditRenameSlide
 306         Kontext "NameDlgPage"
 307         if NameDlgPage.Exists then
 308             NameField.Settext NewName
 309             NameDlgPage.Ok
 310         else
 311             try
 312                 Kontext "DocumentDrawImpress"
 313                 TabBar.TypeKeys NewName + "<Return>" , true
 314             catch
 315                 Warnlog "Unable to rename Slide (No access to to Tab-Bar!)"
 316             endcatch
 317         end if
 318     catch
 319         Warnlog "Unable to rename Slide!"
 320     endcatch
 321
 322 end sub
 323
 324 ' ---------------------------------------------------------------------------------
 325
 326 function wFilterSpecialCharacters(ToFilter as string) as string
 327      Dim i as integer, SpecialCharacters as string
 328      SpecialCharacters = "!\x15$%&/()=?\}][{*+~'#;,:.-"
 329      printlog " Replace SpecialCharacters in SheetName with an underscore (_) "
 330      For i = 1 to len(SpecialCharacters)
 331         ToFilter = ReplaceCharacter(ToFilter,Mid$(SpecialCharacters,i,1),"_")
 332      next i
 333      wFilterSpecialCharacters = ToFilter
 334 end function
 335
 336 ' ---------------------------------------------------------------------------------
 337
 338 function ReplaceCharacter(stringToChange$, charToReplace$, replaceWith$) As String
 339
 340     'Replaces a specified character in a string with another character that you specify
 341     Dim ln As Long
 342     Dim n As Long
 343     Dim NextLetter As String
 344     Dim FinalString As String
 345     Dim txt As String
 346     Dim char As String
 347     Dim rep As String
 348     txt = stringToChange$ 'store all arguments in
 349     char = charToReplace$ 'new variables
 350     rep = replaceWith$
 351
 352     ln = Len(txt)
 353
 354     For n = 1 To ln Step 1
 355         NextLetter = Mid(txt, n, 1)
 356         If NextLetter = char Then
 357             NextLetter = rep
 358         End If
 359         FinalString = FinalString & NextLetter
 360     Next n
 361     ReplaceCharacter = FinalString
 362
 363 end function
 364
 365 ' ---------------------------------------------------------------------------------
 366
 367 Sub wDisableImpressAutopilot()
 368
 369     gApplication = "IMPRESS"
 370     Call hNewDocument
 371     ToolsOptions
 372     Call hToolsOptions ("IMPRESS","General")
 373     MitAutopilotStarten.UnCheck
 374     Kontext "ExtrasOptionenDlg"
 375     ExtrasOptionenDlg.OK
 376     Call hCloseDocument
 377
 378 end sub
 379
 380 function wChangeHTMLCompatibility ( optional RecentCompatibility as integer ) as integer
 381     Dim i as integer
 382     Dim CurrentCharSet as String
 383     Dim RecentCharSet as integer
 384     Dim CharsetFound as boolean
 385     printlog " This function sets the charset in options to UTF-8 "
 386     printlog " Giving a parameter a special charset will be chosen "
 387
 388     CharsetFound = False
 389     ToolsOptions
 390     Call hToolsOptions("LOADSAVE", "HTMLCOMPATIBILITY")
 391     if IsMissing(RecentCompatibility) = True then
 392         RecentCharSet = Zeichensatz.GetSelIndex
 393         For i = 1 to Zeichensatz.GetItemCount
 394             Zeichensatz.Select i
 395             CurrentCharset = Zeichensatz.GetSelText
 396             if Instr(Ucase(CurrentCharset), "UTF-8") then
 397                 i = Zeichensatz.GetItemCount + 1
 398                 CharsetFound = True
 399             end if
 400         next i
 401     else
 402         CharsetFound = True
 403         RecentCharSet = RecentCompatibility
 404         Zeichensatz.Select RecentCompatibility
 405     end if
 406     if CharsetFound = True then
 407         printlog "Charset has been changed!"
 408     else
 409         Warnlog "Couldn't set Charset to UTF-8!"
 410     end if
 411     Kontext "ExtrasOptionenDlg"
 412     ExtrasOptionenDlg.OK
 413     wChangeHTMLCompatibility = RecentCharset
 414
 415 end function
 416
 417 ' ---------------------------------------------------------------------------------
 418
 419 function wChangeHTMLCompatibilityExport ( optional wExport as integer ) as integer
 420     Dim i as integer
 421     Dim CurrentExportSet as String
 422     Dim RecentExportSet as integer
 423     Dim ExportFound as boolean
 424     printlog " This function sets the export in options to 'StarOffice Writer' "
 425     printlog " Giving a parameter a special export will be chosen "
 426
 427     ExportFound = False
 428     ToolsOptions
 429     Call hToolsOptions("LOADSAVE", "HTMLCOMPATIBILITY")
 430     if IsMissing ( wExport ) = True then
 431         RecentExportSet = Export.GetSelIndex
 432         For i = 1 to Export.GetItemCount
 433             Export.Select i
 434             CurrentExportset = Export.GetSelText
 435             if Instr(Ucase(CurrentExportset), "STAROFFICE WRITER") then
 436                 i = Export.GetItemCount + 1
 437                 ExportFound = True
 438             end if
 439         next i
 440     else
 441         ExportFound = True
 442         RecentExportSet = wExport
 443         Export.Select RecentExportSet
 444     end if
 445     if ExportFound = True then
 446         printlog "Export has been changed!"
 447     else
 448         Warnlog "Couldn't set Export to StarOffice Writer!"
 449     end if
 450     Kontext "ExtrasOptionenDlg"
 451     ExtrasOptionenDlg.OK
 452     wChangeHTMLCompatibilityExport = RecentExportSet
 453 end function