1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<!--*********************************************************** 4 * 5 * Licensed to the Apache Software Foundation (ASF) under one 6 * or more contributor license agreements. See the NOTICE file 7 * distributed with this work for additional information 8 * regarding copyright ownership. The ASF licenses this file 9 * to you under the Apache License, Version 2.0 (the 10 * "License"); you may not use this file except in compliance 11 * with the License. You may obtain a copy of the License at 12 * 13 * http://www.apache.org/licenses/LICENSE-2.0 14 * 15 * Unless required by applicable law or agreed to in writing, 16 * software distributed under the License is distributed on an 17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18 * KIND, either express or implied. See the License for the 19 * specific language governing permissions and limitations 20 * under the License. 21 * 22 ***********************************************************--> 23<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit 24 25Const SAMPLES = 1000 26Const STYLES = 1100 27Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc" 28Public Const Twip = 425 29Dim oUcbObject as Object 30Public StylesDir as String 31Public StylesDialog as Object 32Public PathSeparator as String 33Public oFamilies as Object 34Public aOptions(0) as New com.sun.star.beans.PropertyValue 35Public sQueryPath as String 36Public NoArgs()as New com.sun.star.beans.PropertyValue 37Public aTempURL as String 38 39Public Files(100) as String 40 41 42'-------------------------------------------------------------------------------------- 43'Miscellaneous Section starts here 44 45Function PrepareForEditing(Optional ByVal oDocument) 46'This sub is called when sample documents are loaded (load event). 47'It checks whether the documents is read-only, in which case it 48'offers the user to create a new (writable) document using the original 49'as a template. 50Dim DocPath as String 51Dim MMessage as String 52Dim MTitle as String 53Dim RValue as Integer 54Dim oNewDocument as Object 55Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue 56 PrepareForEditing = NULL 57 BasicLibraries.LoadLibrary( "Tools" ) 58 If InitResources("'Template'", "tpl") then 59 If IsMissing(oDocument) Then 60 oDocument = ThisComponent 61 End If 62 If oDocument.IsReadOnly then 63 MMessage = GetResText(SAMPLES) 64 MTitle = GetResText(SAMPLES + 1) 65 RValue = Msgbox(MMessage, (128+48+1), MTitle) 66 If RValue = 1 Then 67 DocPath = oDocument.URL 68 mFileProperties(0).Name = "AsTemplate" 69 mFileProperties(0).Value = True 70 mFileProperties(1).Name = "MacroExecutionMode" 71 mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG 72 73 oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_default",0, mFileProperties()) 74 PrepareForEditing() = oNewDocument 75 DisposeDocument(oDocument) 76 Else 77 PrepareForEditing() = NULL 78 End If 79 Else 80 PrepareForEditing() = oDocument 81 End If 82 End If 83End Function 84 85 86 87'-------------------------------------------------------------------------------------- 88'Calc Style Section starts here 89 90Sub ShowStyles 91'This sub displays the style selection dialog if the current document is a calc document. 92Dim TemplateDir, ActFileTitle, DisplayDummy as String 93Dim sFilterName(0) as String 94Dim StyleNames() as String 95Dim t as Integer 96Dim MaxIndex as Integer 97 BasicLibraries.LoadLibrary("Tools") 98 If InitResources("'Template'", "tpl") then 99 oDocument = ThisComponent 100 If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then 101 ToggleWindow(False) 102 oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") 103 oFamilies = oDocument.StyleFamilies 104 SaveCurrentStyles(oDocument) 105 StylesDialog = LoadDialog("Template", "DialogStyles") 106 DialogModel = StylesDialog.Model 107 TemplateDir = GetPathSettings("Template", False, 0) 108 StylesDir = GetOfficeSubPath("Template", "wizard/styles/") 109 sQueryPath = GetOfficeSubPath("Template", "../wizard/bitmap/") 110 DialogModel.Title = GetResText(STYLES) 111 DialogModel.cmdCancel.Label = GetResText(STYLES+2) 112 DialogModel.cmdOk.Label = GetResText(STYLES+3) 113 Stylenames() = ReadDirectories(StylesDir, False, False, True,) 114 MaxIndex = Ubound(Stylenames()) 115 BubbleSortList(Stylenames(),True) 116 Dim cStyles(MaxIndex) 117 For t = 0 to MaxIndex 118 Files(t) = StyleNames(t,0) 119 cStyles(t) = StyleNames(t,1) 120 Next t 121 On Local Error Resume Next 122 DialogModel.lbStyles.StringItemList() = cStyles() 123 ToggleWindow(True) 124 StylesDialog.Execute 125 End If 126 End If 127End Sub 128 129 130Sub SelectStyle 131'This sub loads the specific styles from a style document and loads them into the 132'current document. 133Dim StylePath as String 134Dim NewStyle as String 135Dim Position as Integer 136 Position = DialogModel.lbStyles.SelectedItems(0) 137 If Position > -1 Then 138 ToggleWindow(False) 139 StylePath = Files(Position) 140 aOptions(0).Name = "OverwriteStyles" 141 aOptions(0).Value = true 142 oFamilies.loadStylesFromURL(StylePath, aOptions()) 143 ToggleWindow(True) 144 End If 145End Sub 146 147 148Sub SaveCurrentStyles(oDocument as Object) 149'This sub stores the current document in the user work directory 150 On Error Goto ErrorOcurred 151 aTempURL = GetPathSettings("Work", False) 152 Dim aRightMost as String 153 aRightMost = Right(aTempURL, 1) 154 if aRightMost = "/" Then 155 aTempURL = aTempURL & aTempFileName 156 Else 157 aTempURL = aTempURL & "/" & aTempFileName 158 End If 159 160 While FileExists(aTempURL) 161 aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc" 162 Wend 163 oDocument.storeToURL(aTempURL, NoArgs()) 164 Exit Sub 165 166ErrorOcurred: 167 MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES )) 168 On Local Error Goto 0 169End Sub 170 171 172Sub RestoreCurrentStyles 173'This sub retrieves the styles from the temporarily save document 174 ToggleWindow(False) 175 On Local Error Goto NoFile 176 If FileExists(aTempURL) Then 177 aOptions(0).Name = "OverwriteStyles" 178 aOptions(0).Value = true 179 oFamilies.LoadStylesFromURL(aTempURL, aOptions()) 180 KillTempFile() 181 End If 182 StylesDialog.EndExecute 183 ToggleWindow(True) 184NOFILE: 185 If Err <> 0 Then 186 Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname()) 187 End If 188 On Local Error Goto 0 189End Sub 190 191 192Sub CloseStyleDialog 193 KillTempFile() 194 DialogExited = True 195 StylesDialog.Endexecute 196End Sub 197 198 199Sub KillTempFile() 200 If oUcbObject.Exists(aTempUrl) Then 201 oUcbObject.Kill(aTempUrl) 202 End If 203End Sub 204 205</script:module> 206