1<?xml version="1.0" encoding="UTF-8"?> 2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit 4 5Const SAMPLES = 1000 6Const STYLES = 1100 7Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc" 8Public Const Twip = 425 9Dim oUcbObject as Object 10Public StylesDir as String 11Public StylesDialog as Object 12Public PathSeparator as String 13Public oFamilies as Object 14Public aOptions(0) as New com.sun.star.beans.PropertyValue 15Public sQueryPath as String 16Public NoArgs()as New com.sun.star.beans.PropertyValue 17Public aTempURL as String 18 19Public Files(100) as String 20 21 22'-------------------------------------------------------------------------------------- 23'Miscellaneous Section starts here 24 25Function PrepareForEditing(Optional ByVal oDocument) 26'This sub is called when sample documents are loaded (load event). 27'It checks whether the documents is read-only, in which case it 28'offers the user to create a new (writable) document using the original 29'as a template. 30Dim DocPath as String 31Dim MMessage as String 32Dim MTitle as String 33Dim RValue as Integer 34Dim oNewDocument as Object 35Dim mFileProperties(1) as New com.sun.star.beans.PropertyValue 36 PrepareForEditing = NULL 37 BasicLibraries.LoadLibrary( "Tools" ) 38 If InitResources("'Template'", "tpl") then 39 If IsMissing(oDocument) Then 40 oDocument = ThisComponent 41 End If 42 If oDocument.IsReadOnly then 43 MMessage = GetResText(SAMPLES) 44 MTitle = GetResText(SAMPLES + 1) 45 RValue = Msgbox(MMessage, (128+48+1), MTitle) 46 If RValue = 1 Then 47 DocPath = oDocument.URL 48 mFileProperties(0).Name = "AsTemplate" 49 mFileProperties(0).Value = True 50 mFileProperties(1).Name = "MacroExecutionMode" 51 mFileProperties(1).Value = com.sun.star.document.MacroExecMode.USE_CONFIG 52 53 oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_default",0, mFileProperties()) 54 PrepareForEditing() = oNewDocument 55 DisposeDocument(oDocument) 56 Else 57 PrepareForEditing() = NULL 58 End If 59 Else 60 PrepareForEditing() = oDocument 61 End If 62 End If 63End Function 64 65 66 67'-------------------------------------------------------------------------------------- 68'Calc Style Section starts here 69 70Sub ShowStyles 71'This sub displays the style selection dialog if the current document is a calc document. 72Dim TemplateDir, ActFileTitle, DisplayDummy as String 73Dim sFilterName(0) as String 74Dim StyleNames() as String 75Dim t as Integer 76Dim MaxIndex as Integer 77 BasicLibraries.LoadLibrary("Tools") 78 If InitResources("'Template'", "tpl") then 79 oDocument = ThisComponent 80 If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then 81 ToggleWindow(False) 82 oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") 83 oFamilies = oDocument.StyleFamilies 84 SaveCurrentStyles(oDocument) 85 StylesDialog = LoadDialog("Template", "DialogStyles") 86 DialogModel = StylesDialog.Model 87 TemplateDir = GetPathSettings("Template", False, 0) 88 StylesDir = GetOfficeSubPath("Template", "wizard/styles/") 89 sQueryPath = GetOfficeSubPath("Template", "../wizard/bitmap/") 90 DialogModel.Title = GetResText(STYLES) 91 DialogModel.cmdCancel.Label = GetResText(STYLES+2) 92 DialogModel.cmdOk.Label = GetResText(STYLES+3) 93 Stylenames() = ReadDirectories(StylesDir, False, False, True,) 94 MaxIndex = Ubound(Stylenames()) 95 BubbleSortList(Stylenames(),True) 96 Dim cStyles(MaxIndex) 97 For t = 0 to MaxIndex 98 Files(t) = StyleNames(t,0) 99 cStyles(t) = StyleNames(t,1) 100 Next t 101 On Local Error Resume Next 102 DialogModel.lbStyles.StringItemList() = cStyles() 103 ToggleWindow(True) 104 StylesDialog.Execute 105 End If 106 End If 107End Sub 108 109 110Sub SelectStyle 111'This sub loads the specific styles from a style document and loads them into the 112'current document. 113Dim StylePath as String 114Dim NewStyle as String 115Dim Position as Integer 116 Position = DialogModel.lbStyles.SelectedItems(0) 117 If Position > -1 Then 118 ToggleWindow(False) 119 StylePath = Files(Position) 120 aOptions(0).Name = "OverwriteStyles" 121 aOptions(0).Value = true 122 oFamilies.loadStylesFromURL(StylePath, aOptions()) 123 ToggleWindow(True) 124 End If 125End Sub 126 127 128Sub SaveCurrentStyles(oDocument as Object) 129'This sub stores the current document in the user work directory 130 On Error Goto ErrorOcurred 131 aTempURL = GetPathSettings("Work", False) 132 Dim aRightMost as String 133 aRightMost = Right(aTempURL, 1) 134 if aRightMost = "/" Then 135 aTempURL = aTempURL & aTempFileName 136 Else 137 aTempURL = aTempURL & "/" & aTempFileName 138 End If 139 140 While FileExists(aTempURL) 141 aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc" 142 Wend 143 oDocument.storeToURL(aTempURL, NoArgs()) 144 Exit Sub 145 146ErrorOcurred: 147 MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES )) 148 On Local Error Goto 0 149End Sub 150 151 152Sub RestoreCurrentStyles 153'This sub retrieves the styles from the temporarily save document 154 ToggleWindow(False) 155 On Local Error Goto NoFile 156 If FileExists(aTempURL) Then 157 aOptions(0).Name = "OverwriteStyles" 158 aOptions(0).Value = true 159 oFamilies.LoadStylesFromURL(aTempURL, aOptions()) 160 KillTempFile() 161 End If 162 StylesDialog.EndExecute 163 ToggleWindow(True) 164NOFILE: 165 If Err <> 0 Then 166 Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname()) 167 End If 168 On Local Error Goto 0 169End Sub 170 171 172Sub CloseStyleDialog 173 KillTempFile() 174 DialogExited = True 175 StylesDialog.Endexecute 176End Sub 177 178 179Sub KillTempFile() 180 If oUcbObject.Exists(aTempUrl) Then 181 oUcbObject.Kill(aTempUrl) 182 End If 183End Sub 184 185</script:module>