mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-03-16 06:03:53 +08:00
优化项目结构、优化 maven 结构
This commit is contained in:
chenkailing
205
office-plugin/windows-office/share/basic/Template/Samples.xba
Normal file
205
office-plugin/windows-office/share/basic/Template/Samples.xba
Normal file
@@ -0,0 +1,205 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--***********************************************************
|
||||
*
|
||||
* Licensed to the Apache Software Foundation (ASF) under one
|
||||
* or more contributor license agreements. See the NOTICE file
|
||||
* distributed with this work for additional information
|
||||
* regarding copyright ownership. The ASF licenses this file
|
||||
* to you under the Apache License, Version 2.0 (the
|
||||
* "License"); you may not use this file except in compliance
|
||||
* with the License. You may obtain a copy of the License at
|
||||
*
|
||||
* http://www.apache.org/licenses/LICENSE-2.0
|
||||
*
|
||||
* Unless required by applicable law or agreed to in writing,
|
||||
* software distributed under the License is distributed on an
|
||||
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
|
||||
* KIND, either express or implied. See the License for the
|
||||
* specific language governing permissions and limitations
|
||||
* under the License.
|
||||
*
|
||||
***********************************************************-->
|
||||
<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>
|
||||
Reference in New Issue
Block a user