diff options
Diffstat (limited to 'wizards/source/template/Samples.xba')
| -rw-r--r-- | wizards/source/template/Samples.xba | 185 |
1 files changed, 185 insertions, 0 deletions
diff --git a/wizards/source/template/Samples.xba b/wizards/source/template/Samples.xba new file mode 100644 index 000000000000..b64ddc12db17 --- /dev/null +++ b/wizards/source/template/Samples.xba @@ -0,0 +1,185 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<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>
\ No newline at end of file |