summaryrefslogtreecommitdiffstats
path: root/wizards/source/template/Samples.xba
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 09:06:44 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-07 09:06:44 +0000
commited5640d8b587fbcfed7dd7967f3de04b37a76f26 (patch)
tree7a5f7c6c9d02226d7471cb3cc8fbbf631b415303 /wizards/source/template/Samples.xba
parentInitial commit. (diff)
downloadlibreoffice-upstream.tar.xz
libreoffice-upstream.zip
Adding upstream version 4:7.4.7.upstream/4%7.4.7upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'wizards/source/template/Samples.xba')
-rw-r--r--wizards/source/template/Samples.xba168
1 files changed, 168 insertions, 0 deletions
diff --git a/wizards/source/template/Samples.xba b/wizards/source/template/Samples.xba
new file mode 100644
index 000000000..25ff81bcf
--- /dev/null
+++ b/wizards/source/template/Samples.xba
@@ -0,0 +1,168 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<!--
+ * This file is part of the LibreOffice project.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ *
+ * This file incorporates work covered by the following license notice:
+ *
+ * Licensed to the Apache Software Foundation (ASF) under one or more
+ * contributor license agreements. See the NOTICE file distributed
+ * with this work for additional information regarding copyright
+ * ownership. The ASF licenses this file to you under the Apache
+ * License, Version 2.0 (the "License"); you may not use this file
+ * except in compliance with the License. You may obtain a copy of
+ * the License at http://www.apache.org/licenses/LICENSE-2.0 .
+-->
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit
+
+Const NumStyles = 18
+Const aTempFileName = &quot;Berend_Ilko_Tom_Stella_Volker.stc&quot;
+Dim oUcbObject as Object
+Public StylesDir as String
+Public StylesDialog as Object
+Public PathSeparator as String
+Public oFamilies as Object
+Public aOptions(0) as New com.sun.star.beans.PropertyValue
+Public sQueryPath as String
+Public NoArgs()as New com.sun.star.beans.PropertyValue
+Public aTempURL as String
+
+Public Files(100) as String
+
+&apos;--------------------------------------------------------------------------------------
+&apos;Calc Style Section starts here
+
+Sub ShowStyles
+&apos;This sub displays the style selection dialog if the current document is a calc document.
+Dim TemplateDir, ActFileTitle, DisplayDummy as String
+Dim sFilterName(0) as String
+Dim StyleNames() as String
+Dim LocalizedStyleNames(NumStyles,2) As String
+Dim LocalizedStyleName As String
+Dim t as Integer
+Dim MaxIndex as Integer
+Dim StyleNameDef As Variant
+ BasicLibraries.LoadLibrary(&quot;Tools&quot;)
+ If InitResources(&quot;&apos;Template&apos;&quot;) then
+ oDocument = ThisComponent
+ If oDocument.SupportsService(&quot;com.sun.star.sheet.SpreadsheetDocument&quot;) Then
+ ToggleWindow(False)
+ oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
+ oFamilies = oDocument.StyleFamilies
+ SaveCurrentStyles(oDocument)
+ StylesDialog = LoadDialog(&quot;Template&quot;, &quot;DialogStyles&quot;)
+ DialogModel = StylesDialog.Model
+ TemplateDir = GetPathSettings(&quot;Template&quot;, False, 0)
+ StylesDir = GetOfficeSubPath(&quot;Template&quot;, &quot;wizard/styles/&quot;)
+ sQueryPath = GetOfficeSubPath(&quot;Template&quot;, &quot;../wizard/bitmap/&quot;)
+ DialogModel.Title = GetResText(&quot;STYLES_0&quot;)
+ DialogModel.cmdCancel.Label = GetResText(&quot;STYLES_2&quot;)
+ DialogModel.cmdOk.Label = GetResText(&quot;STYLES_3&quot;)
+ 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")
+ For t = 0 to NumStyles - 1
+ LocalizedStyleNames(t,0) = StyleNameDef(t)
+ LocalizedStyleNames(t,1) = GetResText(&quot;STYLENAME_&quot; &amp; Trim(Str(t)))
+ Next t
+ Stylenames() = ReadDirectories(StylesDir, False, False, True,)
+ MaxIndex = Ubound(Stylenames())
+ For t = 0 to MaxIndex
+ LocalizedStyleName = StringInMultiArray(LocalizedStyleNames(), StyleNames(t,1), 0, 1)
+ If LocalizedStyleName &lt;&gt; "" Then
+ StyleNames(t,1) = LocalizedStyleName
+ End If
+ Next t
+ BubbleSortList(Stylenames(),True)
+ Dim cStyles(MaxIndex)
+ For t = 0 to MaxIndex
+ Files(t) = StyleNames(t,0)
+ cStyles(t) = StyleNames(t,1)
+ Next t
+ On Local Error Resume Next
+ DialogModel.lbStyles.StringItemList() = cStyles()
+ ToggleWindow(True)
+ StylesDialog.Execute
+ End If
+ End If
+End Sub
+
+
+Sub SelectStyle
+&apos;This sub loads the specific styles from a style document and loads them into the
+&apos;current document.
+Dim StylePath as String
+Dim NewStyle as String
+Dim Position as Integer
+ Position = DialogModel.lbStyles.SelectedItems(0)
+ If Position &gt; -1 Then
+ ToggleWindow(False)
+ StylePath = Files(Position)
+ aOptions(0).Name = &quot;OverwriteStyles&quot;
+ aOptions(0).Value = true
+ oFamilies.loadStylesFromURL(StylePath, aOptions())
+ ToggleWindow(True)
+ End If
+End Sub
+
+
+Sub SaveCurrentStyles(oDocument as Object)
+&apos;This sub stores the current document in the directory to hold temporary files.
+ On Error Goto ErrorOccurred
+ aTempURL = GetPathSettings(&quot;Temp&quot;, False)
+ Dim aRightMost as String
+ aRightMost = Right(aTempURL, 1)
+ if aRightMost = &quot;/&quot; Then
+ aTempURL = aTempURL &amp; aTempFileName
+ Else
+ aTempURL = aTempURL &amp; &quot;/&quot; &amp; aTempFileName
+ End If
+
+ While FileExists(aTempURL)
+ aTempURL=Left(aTempURL,(Len(aTempURL)-4)) &amp; &quot;_1.stc&quot;
+ Wend
+ oDocument.storeToURL(aTempURL, NoArgs())
+ Exit Sub
+
+ErrorOccurred:
+ MsgBox(GetResText(&quot;STYLES_1&quot;), 16, GetResText(&quot;STYLES_0&quot;))
+ On Local Error Goto 0
+End Sub
+
+
+Sub RestoreCurrentStyles
+&apos;This sub retrieves the styles from the temporarily save document
+ ToggleWindow(False)
+ On Local Error Goto NoFile
+ If FileExists(aTempURL) Then
+ aOptions(0).Name = &quot;OverwriteStyles&quot;
+ aOptions(0).Value = true
+ oFamilies.LoadStylesFromURL(aTempURL, aOptions())
+ KillTempFile()
+ End If
+ StylesDialog.EndExecute
+ ToggleWindow(True)
+NOFILE:
+ If Err &lt;&gt; 0 Then
+ Msgbox(&quot;Cannot load Document from &quot; &amp; aTempUrl, 64, GetProductname())
+ End If
+ On Local Error Goto 0
+End Sub
+
+
+Sub CloseStyleDialog
+ KillTempFile()
+ DialogExited = True
+ StylesDialog.Endexecute
+End Sub
+
+
+Sub KillTempFile()
+ If oUcbObject.Exists(aTempUrl) Then
+ oUcbObject.Kill(aTempUrl)
+ End If
+End Sub
+
+</script:module>