qadevOOo/tests/basic/ifc/text/TextGraphicObject/text_TextGraphicObject.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="text_TextGraphicObject" script:language="StarBasic">
   4
   5
   6 '*************************************************************************
   7 '
   8 ' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   9 '
  10 ' Copyright 2008 by Sun Microsystems, Inc.
  11 '
  12 ' OpenOffice.org - a multi-platform office productivity suite
  13 '
  14 ' $RCSfile: text_TextGraphicObject.xba,v $
  15 '
  16 ' $Revision: 1.3 $
  17 '
  18 ' This file is part of OpenOffice.org.
  19 '
  20 ' OpenOffice.org is free software: you can redistribute it and/or modify
  21 ' it under the terms of the GNU Lesser General Public License version 3
  22 ' only, as published by the Free Software Foundation.
  23 '
  24 ' OpenOffice.org is distributed in the hope that it will be useful,
  25 ' but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27 ' GNU Lesser General Public License version 3 for more details
  28 ' (a copy is included in the LICENSE file that accompanied this code).
  29 '
  30 ' You should have received a copy of the GNU Lesser General Public License
  31 ' version 3 along with OpenOffice.org.  If not, see
  32 ' <http://www.openoffice.org/license.html>
  33 ' for a copy of the LGPLv3 License.
  34 '
  35 '*************************************************************************
  36 '*************************************************************************
  37
  38
  39
  40 ' Be sure that all variables are dimensioned:
  41 option explicit
  42
  43
  44
  45 Sub RunTest()
  46
  47 '*************************************************************************
  48 ' SERVICE:
  49 ' com.sun.star.text.TextGraphicObject
  50 '*************************************************************************
  51 On Error Goto ErrHndl
  52     Dim bOK As Boolean
  53
  54
  55     PropertyTester.TestProperty("ContentProtected")
  56
  57     PropertyTester.TestProperty("SurroundContour")
  58
  59     PropertyTester.TestProperty("ContourOutside")
  60
  61     Test.StartMethod("ContourPolyPolygon")
  62     ' Because in additional parameters we must to
  63     ' pass an array of values, we need such array.
  64     Dim aPParr1(1) As Variant
  65     Dim aPol1(3) As new com.sun.star.awt.Point
  66     Dim gArr As Variant
  67
  68     bOK = true
  69     aPol1(0).x = 0   : aPol1(0).y = 0
  70     aPol1(1).x = 101 : aPol1(1).y = 0
  71     aPol1(2).x = 101 : aPol1(2).y = 101
  72     aPol1(3).x = 0   : aPol1(3).y = 101
  73     Dim aPol2(3) As new com.sun.star.awt.Point
  74     aPol2(0).x = 11 : aPol2(0).y = 11
  75     aPol2(1).x = 90 : aPol2(1).y = 11
  76     aPol2(2).x = 90 : aPol2(2).y = 90
  77     aPol2(3).x = 11 : aPol2(3).y = 90
  78     aPParr1(0) = aPol1() : aPParr1(1) = aPol2()
  79     oObj.setPropertyValue("ContourPolyPolygon", aPParr1())
  80     gArr = oObj.getPropertyValue("ContourPolyPolygon")
  81
  82     if isArray(gArr) AND ubound(gArr) &gt;= 1 then
  83         Dim aP1 As Variant, aP2 As Variant
  84
  85         aP1 = gArr(0)
  86         aP2 = gArr(1)
  87         bOK = bOK AND comparePointArrays(aPol1(), aP1, 0, 0, 4)
  88         bOK = bOK AND comparePointArrays(aPol2(), aP2, 0, 0, 4)
  89
  90         ' One more point must be added to close the polygon
  91         bOK = bOK AND comparePointArrays(aPol1(), aP1, 0, 4, 1)
  92         bOK = bOK AND comparePointArrays(aPol2(), aP2, 0, 4, 1)
  93     else
  94         Out.Log("Returned value is invalid")
  95         Out.Log = false
  96     endif
  97
  98     Test.MethodTested("ContourPolyPolygon", bOK)
  99
 100 '    PropertyTester.TestProperty("ContourPolyPolygon",testArr())
 101
 102     Dim aCropArr(1) As Variant
 103     Dim Crop1 As Object
 104     Dim Crop2 As Object
 105
 106     Crop1 = createUnoStruct("com.sun.star.text.GraphicCrop")
 107     Crop2 = createUnoStruct("com.sun.star.text.GraphicCrop")
 108
 109     Crop1.Top = 11 : Crop1.Bottom = 11 : Crop1.Left = 11 : Crop1.Right = 11
 110     Crop2.Top = -11 : Crop2.Bottom = 11 : Crop2.Left = -11 : Crop2.Right = 11
 111
 112     aCropArr(0) = Crop1 : aCropArr(1) = Crop2
 113     PropertyTester.TestProperty("GraphicCrop",aCropArr())
 114
 115     PropertyTester.TestProperty("HoriMirroredOnEvenPages")
 116
 117     PropertyTester.TestProperty("HoriMirroredOnOddPages")
 118
 119     PropertyTester.TestProperty("VertMirrored")
 120
 121     PropertyTester.TestProperty("GraphicURL")
 122
 123     PropertyTester.TestProperty("GraphicFilter")
 124
 125     PropertyTester.TestProperty("ActualSize")
 126
 127     Dim oAdjustArr(4) As Integer
 128     oAdjustArr(0) = -100
 129     oAdjustArr(1) = -50
 130     oAdjustArr(2) = 0
 131     oAdjustArr(3) = 50
 132     oAdjustArr(4) = 100
 133
 134     PropertyTester.TestProperty("AdjustLuminance",oAdjustArr())
 135
 136     PropertyTester.TestProperty("AdjustContrast",oAdjustArr())
 137
 138     PropertyTester.TestProperty("AdjustRed",oAdjustArr())
 139
 140     PropertyTester.TestProperty("AdjustGreen",oAdjustArr())
 141
 142     PropertyTester.TestProperty("AdjustBlue",oAdjustArr())
 143
 144     PropertyTester.TestProperty("Gamma",oAdjustArr())
 145
 146     PropertyTester.TestProperty("GraphicIsInverted")
 147
 148     PropertyTester.TestProperty("Transparency",oAdjustArr())
 149
 150     PropertyTester.TestProperty("GraphicColorMode")
 151
 152     PropertyTester.TestProperty("ImageMap")
 153
 154     PropertyTester.TestProperty("ActualSize")
 155
 156 Exit Sub
 157 ErrHndl:
 158     Test.Exception()
 159     bOK = false
 160     resume next
 161 End Sub
 162
 163 Function comparePointArrays(arr1 As Variant, arr2 As Variant, fromIdx1 As Integer, fromIdx2 As Integer, count As Integer) As Boolean
 164 On Error Goto ErrHndl
 165     Dim bOK As Boolean
 166     Dim i As Integer
 167
 168     if NOT isArray(arr1) then
 169         Out.Log("First parameter is not Array.")
 170         comparePointArrays() = false
 171         exit Function
 172     endif
 173
 174     if NOT isArray(arr2) then
 175         Out.Log("Second parameter is not Array.")
 176         comparePointArrays() = false
 177         exit Function
 178     endif
 179
 180     if (lbound(arr1) &gt; fromIdx1 OR ubound(arr1) &lt; (fromIdx1 + count - 1)) then
 181         Out.Log("Invalid bounds of the first array")
 182         comparePointArrays() = false
 183         exit Function
 184     endif
 185     if (lbound(arr2) &gt; fromIdx2 OR ubound(arr2) &lt; (fromIdx2 + count - 1)) then
 186         Out.Log("Invalid bounds of the second array")
 187         comparePointArrays() = false
 188         exit Function
 189     endif
 190
 191     bOK = true
 192     for i = 0 to count - 1
 193         if arr1(fromIdx1 + i).x &lt;&gt; arr2(fromIdx2 + i).x OR _
 194            arr1(fromIdx1 + i).y &lt;&gt; arr2(fromIdx2 + i).y then
 195
 196             Out.Log("Points #" + i + " are different : (" + _
 197                 arr1(fromIdx1 + i).x + "," + arr1(fromIdx1 + i).y + "), (" + _
 198                 arr2(fromIdx2 + i).x + "," + arr2(fromIdx2 + i).y + ")."
 199
 200             bOK = false
 201         end if
 202     next i
 203
 204     comparePointArrays() = bOK
 205
 206     exit Function
 207 ErrHndl:
 208     Test.Exception()
 209     comparePointArrays() = false
 210 End Function
 211 </script:module>