home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 October / PCWorld_2004-10_cd.bin / akce / openoffice / f_0291 / Samples.xba < prev    next >
Extensible Markup Language  |  2003-12-17  |  6KB  |  179 lines
  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 = "Berend_Ilko_Tom_Stella_Volker.stc"
  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. '--------------------------------------------------------------------------------------
  23. 'Miscellaneous Section starts here
  24.  
  25. Function 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.
  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( "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.ALWAYS_EXECUTE    
  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
  63. End Function
  64.  
  65.  
  66.  
  67. '--------------------------------------------------------------------------------------
  68. 'Calc Style Section starts here
  69.  
  70. Sub ShowStyles
  71. '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("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
  107. End Sub
  108.  
  109.  
  110. Sub SelectStyle
  111. 'This sub loads the specific styles from a style document and loads them into the
  112. '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 > -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
  125. End Sub
  126.  
  127.  
  128. Sub 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.     aTempURL = aTempURL & "/" & aTempFileName
  133.  
  134.     While FileExists(aTempURL)
  135.         aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc"
  136.     Wend
  137.     oDocument.storeToURL(aTempURL, NoArgs())
  138.     Exit Sub
  139.  
  140. ErrorOcurred:
  141.     MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
  142.     On Local Error Goto 0
  143. End Sub
  144.  
  145.  
  146. Sub RestoreCurrentStyles
  147. 'This sub retrieves the styles from the temporarily save document
  148.     ToggleWindow(False)
  149.     On Local Error Goto NoFile
  150.     If FileExists(aTempURL) Then
  151.           aOptions(0).Name = "OverwriteStyles"
  152.           aOptions(0).Value = true
  153.         oFamilies.LoadStylesFromURL(aTempURL, aOptions())
  154.         KillTempFile()
  155.     End If
  156.     StylesDialog.EndExecute
  157.     ToggleWindow(True)
  158. NOFILE:
  159.     If Err <> 0 Then
  160.         Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname())
  161.     End If
  162.     On Local Error Goto 0
  163. End Sub
  164.  
  165.  
  166. Sub CloseStyleDialog
  167.     KillTempFile()
  168.     DialogExited = True
  169.     StylesDialog.Endexecute
  170. End Sub
  171.  
  172.  
  173. Sub KillTempFile()
  174.     If oUcbObject.Exists(aTempUrl) Then
  175.         oUcbObject.Kill(aTempUrl)
  176.     End If
  177. End Sub
  178.  
  179. </script:module>