1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<!-- 4 * This file is part of the LibreOffice project. 5 * 6 * This Source Code Form is subject to the terms of the Mozilla Public 7 * License, v. 2.0. If a copy of the MPL was not distributed with this 8 * file, You can obtain one at http://mozilla.org/MPL/2.0/. 9 * 10 * This file incorporates work covered by the following license notice: 11 * 12 * Licensed to the Apache Software Foundation (ASF) under one or more 13 * contributor license agreements. See the NOTICE file distributed 14 * with this work for additional information regarding copyright 15 * ownership. The ASF licenses this file to you under the Apache 16 * License, Version 2.0 (the "License"); you may not use this file 17 * except in compliance with the License. You may obtain a copy of 18 * the License at http://www.apache.org/licenses/LICENSE-2.0 . 19--> 20<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit 21 22Const NumStyles = 18 23Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc" 24Dim oUcbObject as Object 25Public StylesDir as String 26Public StylesDialog as Object 27Public PathSeparator as String 28Public oFamilies as Object 29Public aOptions(0) as New com.sun.star.beans.PropertyValue 30Public sQueryPath as String 31Public NoArgs()as New com.sun.star.beans.PropertyValue 32Public aTempURL as String 33 34Public Files(100) as String 35 36'-------------------------------------------------------------------------------------- 37'Calc Style Section starts here 38 39Sub ShowStyles 40'This sub displays the style selection dialog if the current document is a calc document. 41Dim TemplateDir, ActFileTitle, DisplayDummy as String 42Dim sFilterName(0) as String 43Dim StyleNames() as String 44Dim LocalizedStyleNames(NumStyles,2) As String 45Dim LocalizedStyleName As String 46Dim t as Integer 47Dim MaxIndex as Integer 48Dim StyleNameDef As Variant 49 BasicLibraries.LoadLibrary("Tools") 50 If InitResources("'Template'") then 51 oDocument = ThisComponent 52 If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then 53 ToggleWindow(False) 54 oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") 55 oFamilies = oDocument.StyleFamilies 56 SaveCurrentStyles(oDocument) 57 StylesDialog = LoadDialog("Template", "DialogStyles") 58 DialogModel = StylesDialog.Model 59 TemplateDir = GetPathSettings("Template", False, 0) 60 StylesDir = GetOfficeSubPath("Template", "wizard/styles/") 61 sQueryPath = GetOfficeSubPath("Template", "../wizard/bitmap/") 62 DialogModel.Title = GetResText("STYLES_0") 63 DialogModel.cmdCancel.Label = GetResText("STYLES_2") 64 DialogModel.cmdOk.Label = GetResText("STYLES_3") 65 StyleNameDef = Array("(Standard)", "Autumn Leaves", "Be", "Black and White", "Blackberry Bush", "Blue Jeans", "Fifties Diner", "Glacier", "Green Grapes", "Marine", "Millennium", "Nature", "Neon", "Night", "PC Nostalgia", "Pastel", "Pool Party", "Pumpkin") 66 For t = 0 to NumStyles - 1 67 LocalizedStyleNames(t,0) = StyleNameDef(t) 68 LocalizedStyleNames(t,1) = GetResText("STYLENAME_" & Trim(Str(t))) 69 Next t 70 Stylenames() = ReadDirectories(StylesDir, False, False, True,) 71 MaxIndex = Ubound(Stylenames()) 72 For t = 0 to MaxIndex 73 LocalizedStyleName = StringInMultiArray(LocalizedStyleNames(), StyleNames(t,1), 0, 1) 74 If LocalizedStyleName <> "" Then 75 StyleNames(t,1) = LocalizedStyleName 76 End If 77 Next t 78 BubbleSortList(Stylenames(),True) 79 Dim cStyles(MaxIndex) 80 For t = 0 to MaxIndex 81 Files(t) = StyleNames(t,0) 82 cStyles(t) = StyleNames(t,1) 83 Next t 84 On Local Error Resume Next 85 DialogModel.lbStyles.StringItemList() = cStyles() 86 ToggleWindow(True) 87 StylesDialog.Execute 88 End If 89 End If 90End Sub 91 92 93Sub SelectStyle 94'This sub loads the specific styles from a style document and loads them into the 95'current document. 96Dim StylePath as String 97Dim NewStyle as String 98Dim Position as Integer 99 Position = DialogModel.lbStyles.SelectedItems(0) 100 If Position > -1 Then 101 ToggleWindow(False) 102 StylePath = Files(Position) 103 aOptions(0).Name = "OverwriteStyles" 104 aOptions(0).Value = true 105 oFamilies.loadStylesFromURL(StylePath, aOptions()) 106 ToggleWindow(True) 107 End If 108End Sub 109 110 111Sub SaveCurrentStyles(oDocument as Object) 112'This sub stores the current document in the user work directory 113 On Error Goto ErrorOcurred 114 aTempURL = GetPathSettings("Work", False) 115 Dim aRightMost as String 116 aRightMost = Right(aTempURL, 1) 117 if aRightMost = "/" Then 118 aTempURL = aTempURL & aTempFileName 119 Else 120 aTempURL = aTempURL & "/" & aTempFileName 121 End If 122 123 While FileExists(aTempURL) 124 aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc" 125 Wend 126 oDocument.storeToURL(aTempURL, NoArgs()) 127 Exit Sub 128 129ErrorOcurred: 130 MsgBox(GetResText("STYLES_1"), 16, GetResText("STYLES_0")) 131 On Local Error Goto 0 132End Sub 133 134 135Sub RestoreCurrentStyles 136'This sub retrieves the styles from the temporarily save document 137 ToggleWindow(False) 138 On Local Error Goto NoFile 139 If FileExists(aTempURL) Then 140 aOptions(0).Name = "OverwriteStyles" 141 aOptions(0).Value = true 142 oFamilies.LoadStylesFromURL(aTempURL, aOptions()) 143 KillTempFile() 144 End If 145 StylesDialog.EndExecute 146 ToggleWindow(True) 147NOFILE: 148 If Err <> 0 Then 149 Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname()) 150 End If 151 On Local Error Goto 0 152End Sub 153 154 155Sub CloseStyleDialog 156 KillTempFile() 157 DialogExited = True 158 StylesDialog.Endexecute 159End Sub 160 161 162Sub KillTempFile() 163 If oUcbObject.Exists(aTempUrl) Then 164 oUcbObject.Kill(aTempUrl) 165 End If 166End Sub 167 168</script:module> 169
