wizards/source/template/Samples.xba

   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
  22 Const NumStyles = 18
  23 Const aTempFileName = &quot;Berend_Ilko_Tom_Stella_Volker.stc&quot;
  24 Dim oUcbObject as Object
  25 Public StylesDir as String
  26 Public StylesDialog as Object
  27 Public PathSeparator as String
  28 Public oFamilies  as Object
  29 Public aOptions(0) as New com.sun.star.beans.PropertyValue
  30 Public sQueryPath as String
  31 Public NoArgs()as New com.sun.star.beans.PropertyValue
  32 Public aTempURL as String
  33
  34 Public Files(100) as String
  35
  36 &apos;--------------------------------------------------------------------------------------
  37 &apos;Calc Style Section starts here
  38
  39 Sub ShowStyles
  40 &apos;This sub displays the style selection dialog if the current document is a calc document.
  41 Dim TemplateDir, ActFileTitle, DisplayDummy as String
  42 Dim sFilterName(0) as String
  43 Dim StyleNames() as String
  44 Dim LocalizedStyleNames(NumStyles,2) As String
  45 Dim LocalizedStyleName As String
  46 Dim t as Integer
  47 Dim MaxIndex as Integer
  48 Dim StyleNameDef As Variant
  49         BasicLibraries.LoadLibrary(&quot;Tools&quot;)
  50         If InitResources(&quot;&apos;Template&apos;&quot;) then
  51         oDocument = ThisComponent
  52                 If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
  53                         ToggleWindow(False)
  54                         oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
  55                         oFamilies = oDocument.StyleFamilies
  56                         SaveCurrentStyles(oDocument)
  57                         StylesDialog = LoadDialog(&quot;Template&quot;, &quot;DialogStyles&quot;)
  58                         DialogModel = StylesDialog.Model
  59                         TemplateDir = GetPathSettings(&quot;Template&quot;, False, 0)
  60                         StylesDir = GetOfficeSubPath(&quot;Template&quot;, &quot;wizard/styles/&quot;)
  61                         sQueryPath = GetOfficeSubPath(&quot;Template&quot;, &quot;../wizard/bitmap/&quot;)
  62                         DialogModel.Title = GetResText(&quot;STYLES_0&quot;)
  63                         DialogModel.cmdCancel.Label = GetResText(&quot;STYLES_2&quot;)
  64                         DialogModel.cmdOk.Label = GetResText(&quot;STYLES_3&quot;)
  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(&quot;STYLENAME_&quot; &amp; 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 &lt;&gt; "" 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
  90 End Sub
  91
  92
  93 Sub SelectStyle
  94 &apos;This sub loads the specific styles from a style document and loads them into the
  95 &apos;current document.
  96 Dim StylePath as String
  97 Dim NewStyle as String
  98 Dim Position as Integer
  99         Position = DialogModel.lbStyles.SelectedItems(0)
 100         If Position &gt; -1 Then
 101                 ToggleWindow(False)
 102                 StylePath = Files(Position)
 103                 aOptions(0).Name = &quot;OverwriteStyles&quot;
 104                 aOptions(0).Value = true
 105                 oFamilies.loadStylesFromURL(StylePath, aOptions())
 106                 ToggleWindow(True)
 107         End If
 108 End Sub
 109
 110
 111 Sub SaveCurrentStyles(oDocument as Object)
 112 &apos;This sub stores the current document in the directory to hold temporary files.
 113         On Error Goto ErrorOccurred
 114         aTempURL = GetPathSettings(&quot;Temp&quot;, False)
 115         Dim aRightMost as String
 116         aRightMost = Right(aTempURL, 1)
 117         if aRightMost = &quot;/&quot; Then
 118                 aTempURL = aTempURL &amp; aTempFileName
 119         Else
 120                 aTempURL = aTempURL &amp; &quot;/&quot; &amp; aTempFileName
 121         End If
 122
 123         While FileExists(aTempURL)
 124                 aTempURL=Left(aTempURL,(Len(aTempURL)-4)) &amp; &quot;_1.stc&quot;
 125         Wend
 126         oDocument.storeToURL(aTempURL, NoArgs())
 127         Exit Sub
 128
 129 ErrorOccurred:
 130         MsgBox(GetResText(&quot;STYLES_1&quot;), 16, GetResText(&quot;STYLES_0&quot;))
 131         On Local Error Goto 0
 132 End Sub
 133
 134
 135 Sub RestoreCurrentStyles
 136 &apos;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 = &quot;OverwriteStyles&quot;
 141                 aOptions(0).Value = true
 142                 oFamilies.LoadStylesFromURL(aTempURL, aOptions())
 143                 KillTempFile()
 144         End If
 145         StylesDialog.EndExecute
 146         ToggleWindow(True)
 147 NOFILE:
 148         If Err &lt;&gt; 0 Then
 149                 Msgbox(&quot;Cannot load Document from &quot; &amp; aTempUrl, 64, GetProductname())
 150         End If
 151         On Local Error Goto 0
 152 End Sub
 153
 154
 155 Sub CloseStyleDialog
 156         KillTempFile()
 157         DialogExited = True
 158         StylesDialog.Endexecute
 159 End Sub
 160
 161
 162 Sub KillTempFile()
 163         If oUcbObject.Exists(aTempUrl) Then
 164                 oUcbObject.Kill(aTempUrl)
 165         End If
 166 End Sub
 167
 168 </script:module>