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 SAMPLES = 1000
  23 Const STYLES = 1100
  24 Const STYLENAME_DEF = 1120
  25 Const STYLENAME = 1150
  26 Const NumStyles = 18
  27 Const aTempFileName = &quot;Berend_Ilko_Tom_Stella_Volker.stc&quot;
  28 Public Const Twip = 425
  29 Dim oUcbObject as Object
  30 Public StylesDir as String
  31 Public StylesDialog as Object
  32 Public PathSeparator as String
  33 Public oFamilies  as Object
  34 Public aOptions(0) as New com.sun.star.beans.PropertyValue
  35 Public sQueryPath as String
  36 Public NoArgs()as New com.sun.star.beans.PropertyValue
  37 Public aTempURL as String
  38
  39 Public Files(100) as String
  40
  41
  42 &apos;--------------------------------------------------------------------------------------
  43 &apos;Miscellaneous Section starts here
  44
  45 Function PrepareForEditing(Optional ByVal oDocument)
  46 &apos;This sub is called when sample documents are loaded (load event).
  47 &apos;It checks whether the documents is read-only, in which case it
  48 &apos;offers the user to create a new (writable) document using the original
  49 &apos;as a template.
  50 Dim DocPath as String
  51 Dim MMessage as String
  52 Dim MTitle as String
  53 Dim RValue as Integer
  54 Dim oNewDocument as Object
  55 Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue
  56         PrepareForEditing = NULL
  57         BasicLibraries.LoadLibrary( &quot;Tools&quot; )
  58         If InitResources(&quot;&apos;Template&apos;&quot;, &quot;tpl&quot;) 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 = &quot;AsTemplate&quot;
  69                                 mFileProperties(0).Value = True
  70                                 mFileProperties(1).Name = &quot;MacroExecutionMode&quot;
  71                                 mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG
  72
  73                                 oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,&quot;_default&quot;,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
  83 End Function
  84
  85
  86
  87 &apos;--------------------------------------------------------------------------------------
  88 &apos;Calc Style Section starts here
  89
  90 Sub ShowStyles
  91 &apos;This sub displays the style selection dialog if the current document is a calc document.
  92 Dim TemplateDir, ActFileTitle, DisplayDummy as String
  93 Dim sFilterName(0) as String
  94 Dim StyleNames() as String
  95 Dim LocalizedStyleNames(NumStyles,2) As String
  96 Dim LocalizedStyleName As String
  97 Dim t as Integer
  98 Dim MaxIndex as Integer
  99         BasicLibraries.LoadLibrary(&quot;Tools&quot;)
 100         If InitResources(&quot;&apos;Template&apos;&quot;, &quot;tpl&quot;) then
 101         oDocument = ThisComponent
 102                 If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
 103                         ToggleWindow(False)
 104                         oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
 105                         oFamilies = oDocument.StyleFamilies
 106                         SaveCurrentStyles(oDocument)
 107                         StylesDialog = LoadDialog(&quot;Template&quot;, &quot;DialogStyles&quot;)
 108                         DialogModel = StylesDialog.Model
 109                         TemplateDir = GetPathSettings(&quot;Template&quot;, False, 0)
 110                         StylesDir = GetOfficeSubPath(&quot;Template&quot;, &quot;wizard/styles/&quot;)
 111                         sQueryPath = GetOfficeSubPath(&quot;Template&quot;, &quot;../wizard/bitmap/&quot;)
 112                         DialogModel.Title = GetResText(STYLES)
 113                         DialogModel.cmdCancel.Label = GetResText(STYLES+2)
 114                         DialogModel.cmdOk.Label = GetResText(STYLES+3)
 115                         For t = 0 to NumStyles - 1
 116                                 LocalizedStyleNames(t,0) = GetResText(STYLENAME_DEF+t)
 117                                 LocalizedStyleNames(t,1) = GetResText(STYLENAME+t)
 118                         Next t
 119                         Stylenames() = ReadDirectories(StylesDir, False, False, True,)
 120                         MaxIndex = Ubound(Stylenames())
 121                         For t = 0 to MaxIndex
 122                                 LocalizedStyleName = StringInMultiArray(LocalizedStyleNames(), StyleNames(t,1), 0, 1)
 123                                 If LocalizedStyleName &lt;&gt; "" Then
 124                                         StyleNames(t,1) = LocalizedStyleName
 125                                 End If
 126                         Next t
 127                         BubbleSortList(Stylenames(),True)
 128                         Dim cStyles(MaxIndex)
 129                         For t = 0 to MaxIndex
 130                                 Files(t) = StyleNames(t,0)
 131                                 cStyles(t) = StyleNames(t,1)
 132                         Next t
 133                         On Local Error Resume Next
 134                         DialogModel.lbStyles.StringItemList() = cStyles()
 135                         ToggleWindow(True)
 136                         StylesDialog.Execute
 137                 End If
 138         End If
 139 End Sub
 140
 141
 142 Sub SelectStyle
 143 &apos;This sub loads the specific styles from a style document and loads them into the
 144 &apos;current document.
 145 Dim StylePath as String
 146 Dim NewStyle as String
 147 Dim Position as Integer
 148         Position = DialogModel.lbStyles.SelectedItems(0)
 149         If Position &gt; -1 Then
 150                 ToggleWindow(False)
 151                 StylePath = Files(Position)
 152                 aOptions(0).Name = &quot;OverwriteStyles&quot;
 153                 aOptions(0).Value = true
 154                 oFamilies.loadStylesFromURL(StylePath, aOptions())
 155                 ToggleWindow(True)
 156         End If
 157 End Sub
 158
 159
 160 Sub SaveCurrentStyles(oDocument as Object)
 161 &apos;This sub stores the current document in the user work directory
 162         On Error Goto ErrorOcurred
 163         aTempURL = GetPathSettings(&quot;Work&quot;, False)
 164         Dim aRightMost as String
 165         aRightMost = Right(aTempURL, 1)
 166         if aRightMost = &quot;/&quot; Then
 167                 aTempURL = aTempURL &amp; aTempFileName
 168         Else
 169                 aTempURL = aTempURL &amp; &quot;/&quot; &amp; aTempFileName
 170         End If
 171
 172         While FileExists(aTempURL)
 173                 aTempURL=Left(aTempURL,(Len(aTempURL)-4)) &amp; &quot;_1.stc&quot;
 174         Wend
 175         oDocument.storeToURL(aTempURL, NoArgs())
 176         Exit Sub
 177
 178 ErrorOcurred:
 179         MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
 180         On Local Error Goto 0
 181 End Sub
 182
 183
 184 Sub RestoreCurrentStyles
 185 &apos;This sub retrieves the styles from the temporarily save document
 186         ToggleWindow(False)
 187         On Local Error Goto NoFile
 188         If FileExists(aTempURL) Then
 189                 aOptions(0).Name = &quot;OverwriteStyles&quot;
 190                 aOptions(0).Value = true
 191                 oFamilies.LoadStylesFromURL(aTempURL, aOptions())
 192                 KillTempFile()
 193         End If
 194         StylesDialog.EndExecute
 195         ToggleWindow(True)
 196 NOFILE:
 197         If Err &lt;&gt; 0 Then
 198                 Msgbox(&quot;Cannot load Document from &quot; &amp; aTempUrl, 64, GetProductname())
 199         End If
 200         On Local Error Goto 0
 201 End Sub
 202
 203
 204 Sub CloseStyleDialog
 205         KillTempFile()
 206         DialogExited = True
 207         StylesDialog.Endexecute
 208 End Sub
 209
 210
 211 Sub KillTempFile()
 212         If oUcbObject.Exists(aTempUrl) Then
 213                 oUcbObject.Kill(aTempUrl)
 214         End If
 215 End Sub
 216
 217 </script:module>