odk/examples/OLE/vbscript/WriterDemo.vbs

   1 '***********************************************************************
   2 '*
   3 '*  The Contents of this file are made available subject to the terms of
   4 '*  the BSD license.
   5 '*
   6 '*  Copyright 2000, 2010 Oracle and/or its affiliates.
   7 '*  All rights reserved.
   8 '*
   9 '*  Redistribution and use in source and binary forms, with or without
  10 '*  modification, are permitted provided that the following conditions
  11 '*  are met:
  12 '*  1. Redistributions of source code must retain the above copyright
  13 '*     notice, this list of conditions and the following disclaimer.
  14 '*  2. Redistributions in binary form must reproduce the above copyright
  15 '*     notice, this list of conditions and the following disclaimer in the
  16 '*     documentation and/or other materials provided with the distribution.
  17 '*  3. Neither the name of Sun Microsystems, Inc. nor the names of its
  18 '*     contributors may be used to endorse or promote products derived
  19 '*     from this software without specific prior written permission.
  20 '*
  21 '*  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  22 '*  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  23 '*  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  24 '*  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  25 '*  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  26 '*  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  27 '*  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
  28 '*  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  29 '*  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
  30 '*  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
  31 '*  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32 '*
  33 '*************************************************************************
  34
  35 'The service manager is always the starting point
  36 'If there is no office running then an office is started up
  37 Set objServiceManager= WScript.CreateObject("com.sun.star.ServiceManager")
  38
  39 'Create the CoreReflection service that is later used to create structs
  40 Set objCoreReflection= objServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
  41
  42 'Create the Desktop
  43 Set objDesktop= objServiceManager.createInstance("com.sun.star.frame.Desktop")
  44
  45 'Open a new empty writer document
  46 Dim args()
  47 Set objDocument= objDesktop.loadComponentFromURL("private:factory/swriter", "_blank", 0, args)
  48
  49 'Create a text object
  50 Set objText= objDocument.getText
  51
  52 'Create a cursor object
  53 Set objCursor= objText.createTextCursor
  54
  55 'Inserting some Text
  56 objText.insertString objCursor, "The first line in the newly created text document." & vbLf, false
  57
  58 'Inserting a second line
  59 objText.insertString objCursor, "Now we're in the second line", false
  60
  61 'Create instance of a text table with 4 columns and 4 rows
  62 Set objTable= objDocument.createInstance( "com.sun.star.text.TextTable")
  63 objTable.initialize 4, 4
  64
  65 'Insert the table
  66 objText.insertTextContent objCursor, objTable, false
  67
  68 'Get first row
  69 Set objRows= objTable.getRows
  70 Set objRow= objRows.getByIndex( 0)
  71
  72 'Set the table background color
  73 objTable.setPropertyValue "BackTransparent", false
  74 objTable.setPropertyValue                    "BackColor", 13421823
  75
  76 'Set a different background color for the first row
  77 objRow.setPropertyValue "BackTransparent", false
  78 objRow.setPropertyValue "BackColor", 6710932
  79
  80 'Fill the first table row
  81 insertIntoCell "A1","FirstColumn", objTable
  82 insertIntoCell "B1","SecondColumn", objTable
  83 insertIntoCell "C1","ThirdColumn", objTable
  84 insertIntoCell "D1","SUM", objTable
  85
  86 objTable.getCellByName("A2").setValue 22.5
  87 objTable.getCellByName("B2").setValue 5615.3
  88 objTable.getCellByName("C2").setValue -2315.7
  89 objTable.getCellByName("D2").setFormula"sum <A2:C2>"
  90
  91 objTable.getCellByName("A3").setValue 21.5
  92 objTable.getCellByName("B3").setValue 615.3
  93 objTable.getCellByName("C3").setValue -315.7
  94 objTable.getCellByName("D3").setFormula "sum <A3:C3>"
  95
  96 objTable.getCellByName("A4").setValue 121.5
  97 objTable.getCellByName("B4").setValue -615.3
  98 objTable.getCellByName("C4").setValue 415.7
  99 objTable.getCellByName("D4").setFormula "sum <A4:C4>"
 100
 101 'Change the CharColor and add a Shadow
 102 objCursor.setPropertyValue "CharColor", 255
 103 objCursor.setPropertyValue "CharShadowed", true
 104
 105 'Create a paragraph break
 106 'The second argument is a com::sun::star::text::ControlCharacter::PARAGRAPH_BREAK constant
 107 objText.insertControlCharacter objCursor, 0 , false
 108
 109 'Inserting colored Text.
 110 objText.insertString objCursor, " This is a colored Text - blue with shadow" & vbLf, false
 111
 112 'Create a paragraph break ( ControlCharacter::PARAGRAPH_BREAK).
 113 objText.insertControlCharacter objCursor, 0, false
 114
 115 'Create a TextFrame.
 116 Set objTextFrame= objDocument.createInstance("com.sun.star.text.TextFrame")
 117
 118 'Create a Size struct.
 119 Set objSize= createStruct("com.sun.star.awt.Size")
 120 objSize.Width= 15000
 121 objSize.Height= 400
 122 objTextFrame.setSize( objSize)
 123
 124 ' TextContentAnchorType.AS_CHARACTER = 1
 125 objTextFrame.setPropertyValue "AnchorType", 1
 126
 127 'insert the frame
 128 objText.insertTextContent objCursor, objTextFrame, false
 129
 130 'Get the text object of the frame
 131 Set objFrameText= objTextFrame.getText
 132
 133
 134 'Create a cursor object
 135 Set objFrameTextCursor= objFrameText.createTextCursor
 136
 137 'Inserting some Text
 138 objFrameText.insertString objFrameTextCursor, "The first line in the newly created text frame.", _
 139                           false
 140 objFrameText.insertString objFrameTextCursor, _
 141                           vbLf & "With this second line the height of the frame raises.", false
 142
 143 'Create a paragraph break
 144 'The second argument is a com::sun::star::text::ControlCharacter::PARAGRAPH_BREAK constant
 145 objFrameText.insertControlCharacter objCursor, 0 , false
 146
 147 'Change the CharColor and add a Shadow
 148 objCursor.setPropertyValue "CharColor", 65536
 149 objCursor.setPropertyValue "CharShadowed", false
 150
 151 'Insert another string
 152 objText.insertString objCursor, " That's all for now !!", false
 153
 154 On Error Resume Next
 155 If Err Then
 156   MsgBox "An error occurred"
 157 End If
 158
 159
 160 Sub insertIntoCell( strCellName, strText, objTable)
 161     Set objCellText= objTable.getCellByName( strCellName)
 162     Set objCellCursor= objCellText.createTextCursor
 163     objCellCursor.setPropertyValue "CharColor",16777215
 164     objCellText.insertString objCellCursor, strText, false
 165 End Sub
 166
 167 Function createStruct( strTypeName)
 168     Set classSize= objCoreReflection.forName( strTypeName)
 169     Dim aStruct
 170     classSize.createObject aStruct
 171     Set createStruct= aStruct
 172 End Function