home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 2003 September / VPR0309.ISO / OPENOFFICE / install / f_0114 / Samples.xba < prev    next >
Extensible Markup Language  |  2001-11-12  |  6KB  |  181 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(0) 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.                 oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0, mFileProperties())
  51.                 PrepareForEditing() = oNewDocument
  52. '                If IsFatOffice() Then
  53.                       ' If opened within a FatOffice Environment close doc.
  54.                       ' Note: Due to a bug in Web office it is not possible to close the doc there
  55.                     oDocument.Dispose()
  56.  '               End If
  57.             Else
  58.                 PrepareForEditing() = NULL
  59.             End If
  60.         Else
  61.             PrepareForEditing() = oDocument
  62.         End If
  63.     End If
  64. End Function
  65.  
  66.  
  67.  
  68. '--------------------------------------------------------------------------------------
  69. 'Calc Style Section starts here
  70.  
  71. Sub ShowStyles
  72. 'This sub displays the style selection dialog if the current document is a calc document.
  73. Dim TemplateDir, ActFileTitle, DisplayDummy as String
  74. Dim sFilterName(0) as String
  75. Dim StyleNames() as String
  76. Dim t as Integer
  77. Dim MaxIndex as Integer
  78.         BasicLibraries.LoadLibrary("Tools")
  79.     If InitResources("'Template'", "tpl") then
  80.     oDocument = ThisComponent
  81.         If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
  82.             ToggleWindow(False)
  83.             oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  84.             oFamilies = oDocument.StyleFamilies
  85.             SaveCurrentStyles(oDocument)
  86.             StylesDialog = LoadDialog("Template", "DialogStyles")
  87.             DialogModel = StylesDialog.Model
  88.             TemplateDir = GetPathSettings("Template", False, 0)
  89.             StylesDir = GetOfficeSubPath("Template", "wizard/styles/")
  90.             sQueryPath = GetOfficeSubPath("Template", "wizard/bitmap/")
  91.             DialogModel.Title = GetResText(STYLES)
  92.             DialogModel.cmdCancel.Label = GetResText(STYLES+2)
  93.             DialogModel.cmdOk.Label = GetResText(STYLES+3)
  94.             Stylenames() = ReadDirectories(StylesDir, False, False, True,)
  95.             MaxIndex = Ubound(Stylenames())
  96.             BubbleSortList(Stylenames(),True)
  97.             Dim cStyles(MaxIndex)
  98.             For t = 0 to MaxIndex
  99.                 Files(t) = StyleNames(t,0)
  100.                 cStyles(t) = StyleNames(t,1)
  101.             Next t
  102.             On Local Error Resume Next
  103.             DialogModel.lbStyles.StringItemList() = cStyles()
  104.             ToggleWindow(True)
  105.             StylesDialog.Execute
  106.         End If
  107.     End If
  108. End Sub
  109.  
  110.  
  111. Sub SelectStyle
  112. 'This sub loads the specific styles from a style document and loads them into the
  113. 'current document.
  114. Dim StylePath as String
  115. Dim NewStyle as String
  116. Dim Position as Integer
  117.     Position = DialogModel.lbStyles.SelectedItems(0)
  118.     If Position > -1 Then
  119.         ToggleWindow(False)
  120.         StylePath = Files(Position)
  121.           aOptions(0).Name = "OverwriteStyles"
  122.          aOptions(0).Value = true
  123.         oFamilies.loadStylesFromURL(StylePath, aOptions())
  124.         ToggleWindow(True)
  125.     End If
  126. End Sub
  127.  
  128.  
  129. Sub SaveCurrentStyles(oDocument as Object)
  130. 'This sub stores the current document in the user work directory
  131.     On Error Goto ErrorOcurred
  132.     aTempURL = GetPathSettings("Work", False)
  133.     aTempURL = aTempURL & "/" & aTempFileName
  134.  
  135.     While FileExists(aTempURL)
  136.         aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc"
  137.     Wend
  138.     oDocument.storeToURL(aTempURL, NoArgs())
  139.     Exit Sub
  140.  
  141. ErrorOcurred:
  142.     MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES ))
  143.     On Local Error Goto 0
  144. End Sub
  145.  
  146.  
  147. Sub RestoreCurrentStyles
  148. 'This sub retrieves the styles from the temporarily save document
  149.     ToggleWindow(False)
  150.     On Local Error Goto NoFile
  151.     If FileExists(aTempURL) Then
  152.           aOptions(0).Name = "OverwriteStyles"
  153.           aOptions(0).Value = true
  154.         oFamilies.LoadStylesFromURL(aTempURL, aOptions())
  155.         KillTempFile()
  156.     End If
  157.     StylesDialog.EndExecute
  158.     ToggleWindow(True)
  159. NOFILE:
  160.     If Err <> 0 Then
  161.         Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname())
  162.     End If
  163.     On Local Error Goto 0
  164. End Sub
  165.  
  166.  
  167. Sub CloseStyleDialog
  168.     KillTempFile()
  169.     DialogExited = True
  170.     StylesDialog.Endexecute
  171. End Sub
  172.  
  173. ' Todo:Diese Prozedur an das Dialog-Schlieﾃ歹n Ereignis ranhﾃ､ngen
  174. Sub KillTempFile()
  175.     If oUcbObject.Exists(aTempUrl) Then
  176.         oUcbObject.Kill(aTempUrl)
  177.     End If
  178. End Sub
  179.  
  180. </script:module>
  181.