AOO410/main/wizards/source/template/Samples.xba - openoffice - Git at Google

 <?xml version="1.0" encoding="UTF-8"?>
 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
 <!--***********************************************************
  *
  * 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
  *
  * Unless required by applicable law or agreed to in writing,
  * software distributed under the License is distributed on an
  * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
  * KIND, either express or implied.  See the License for the
  * specific language governing permissions and limitations
  * under the License.
  *
  ***********************************************************-->
 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit

 Const SAMPLES = 1000
 Const STYLES = 1100
 Const aTempFileName = &quot;Berend_Ilko_Tom_Stella_Volker.stc&quot;
 Public Const Twip = 425
 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;Miscellaneous Section starts here

 Function PrepareForEditing(Optional ByVal oDocument)
 &apos;This sub is called when sample documents are loaded (load event).
 &apos;It checks whether the documents is read-only, in which case it
 &apos;offers the user to create a new (writable) document using the original
 &apos;as a template.
 Dim DocPath as String
 Dim MMessage as String
 Dim MTitle as String
 Dim RValue as Integer
 Dim oNewDocument as Object
 Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue
 	PrepareForEditing = NULL
         BasicLibraries.LoadLibrary( &quot;Tools&quot; )
 	If InitResources(&quot;&apos;Template&apos;&quot;, &quot;tpl&quot;) then
 		If IsMissing(oDocument) Then
       		oDocument = ThisComponent
 		End If
 		If oDocument.IsReadOnly then
 			MMessage = GetResText(SAMPLES)
 			MTitle = GetResText(SAMPLES + 1)
 			RValue = Msgbox(MMessage, (128+48+1), MTitle)
 			If RValue = 1 Then
 				DocPath = oDocument.URL
 				mFileProperties(0).Name = &quot;AsTemplate&quot;
 				mFileProperties(0).Value = True
 				mFileProperties(1).Name = &quot;MacroExecutionMode&quot;
 				mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG

 				oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,&quot;_default&quot;,0, mFileProperties())
 				PrepareForEditing() = oNewDocument
 				DisposeDocument(oDocument)
 			Else
 				PrepareForEditing() = NULL
 			End If
 		Else
 			PrepareForEditing() = oDocument
 		End If
 	End If
 End Function


 &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 t as Integer
 Dim MaxIndex as Integer
         BasicLibraries.LoadLibrary(&quot;Tools&quot;)
 	If InitResources(&quot;&apos;Template&apos;&quot;, &quot;tpl&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(STYLES)
 			DialogModel.cmdCancel.Label = GetResText(STYLES+2)
 			DialogModel.cmdOk.Label = GetResText(STYLES+3)
 			Stylenames() = ReadDirectories(StylesDir, False, False, True,)
 			MaxIndex = Ubound(Stylenames())
 			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 user work directory
 	On Error Goto ErrorOcurred
 	aTempURL = GetPathSettings(&quot;Work&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

 ErrorOcurred:
 	MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
 	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>
	<?xml version="1.0" encoding="UTF-8"?>
	<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
	<!--***********************************************************
	*
	* 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
	*
	* Unless required by applicable law or agreed to in writing,
	* software distributed under the License is distributed on an
	* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
	* KIND, either express or implied. See the License for the
	* specific language governing permissions and limitations
	* under the License.
	*
	***********************************************************-->
	<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit

	Const SAMPLES = 1000
	Const STYLES = 1100
	Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc"
	Public Const Twip = 425
	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


	'--------------------------------------------------------------------------------------
	'Miscellaneous Section starts here

	Function PrepareForEditing(Optional ByVal oDocument)
	'This sub is called when sample documents are loaded (load event).
	'It checks whether the documents is read-only, in which case it
	'offers the user to create a new (writable) document using the original
	'as a template.
	Dim DocPath as String
	Dim MMessage as String
	Dim MTitle as String
	Dim RValue as Integer
	Dim oNewDocument as Object
	Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue
	PrepareForEditing = NULL
	BasicLibraries.LoadLibrary( "Tools" )
	If InitResources("'Template'", "tpl") then
	If IsMissing(oDocument) Then
	oDocument = ThisComponent
	End If
	If oDocument.IsReadOnly then
	MMessage = GetResText(SAMPLES)
	MTitle = GetResText(SAMPLES + 1)
	RValue = Msgbox(MMessage, (128+48+1), MTitle)
	If RValue = 1 Then
	DocPath = oDocument.URL
	mFileProperties(0).Name = "AsTemplate"
	mFileProperties(0).Value = True
	mFileProperties(1).Name = "MacroExecutionMode"
	mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG

	oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_default",0, mFileProperties())
	PrepareForEditing() = oNewDocument
	DisposeDocument(oDocument)
	Else
	PrepareForEditing() = NULL
	End If
	Else
	PrepareForEditing() = oDocument
	End If
	End If
	End Function



	'--------------------------------------------------------------------------------------
	'Calc Style Section starts here

	Sub ShowStyles
	'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 t as Integer
	Dim MaxIndex as Integer
	BasicLibraries.LoadLibrary("Tools")
	If InitResources("'Template'", "tpl") then
	oDocument = ThisComponent
	If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
	ToggleWindow(False)
	oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
	oFamilies = oDocument.StyleFamilies
	SaveCurrentStyles(oDocument)
	StylesDialog = LoadDialog("Template", "DialogStyles")
	DialogModel = StylesDialog.Model
	TemplateDir = GetPathSettings("Template", False, 0)
	StylesDir = GetOfficeSubPath("Template", "wizard/styles/")
	sQueryPath = GetOfficeSubPath("Template", "../wizard/bitmap/")
	DialogModel.Title = GetResText(STYLES)
	DialogModel.cmdCancel.Label = GetResText(STYLES+2)
	DialogModel.cmdOk.Label = GetResText(STYLES+3)
	Stylenames() = ReadDirectories(StylesDir, False, False, True,)
	MaxIndex = Ubound(Stylenames())
	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
	'This sub loads the specific styles from a style document and loads them into the
	'current document.
	Dim StylePath as String
	Dim NewStyle as String
	Dim Position as Integer
	Position = DialogModel.lbStyles.SelectedItems(0)
	If Position > -1 Then
	ToggleWindow(False)
	StylePath = Files(Position)
	aOptions(0).Name = "OverwriteStyles"
	aOptions(0).Value = true
	oFamilies.loadStylesFromURL(StylePath, aOptions())
	ToggleWindow(True)
	End If
	End Sub


	Sub SaveCurrentStyles(oDocument as Object)
	'This sub stores the current document in the user work directory
	On Error Goto ErrorOcurred
	aTempURL = GetPathSettings("Work", False)
	Dim aRightMost as String
	aRightMost = Right(aTempURL, 1)
	if aRightMost = "/" Then
	aTempURL = aTempURL & aTempFileName
	Else
	aTempURL = aTempURL & "/" & aTempFileName
	End If

	While FileExists(aTempURL)
	aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc"
	Wend
	oDocument.storeToURL(aTempURL, NoArgs())
	Exit Sub

	ErrorOcurred:
	MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
	On Local Error Goto 0
	End Sub


	Sub RestoreCurrentStyles
	'This sub retrieves the styles from the temporarily save document
	ToggleWindow(False)
	On Local Error Goto NoFile
	If FileExists(aTempURL) Then
	aOptions(0).Name = "OverwriteStyles"
	aOptions(0).Value = true
	oFamilies.LoadStylesFromURL(aTempURL, aOptions())
	KillTempFile()
	End If
	StylesDialog.EndExecute
	ToggleWindow(True)
	NOFILE:
	If Err <> 0 Then
	Msgbox("Cannot load Document from " & 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>