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