Current File : //usr/lib/libreoffice/share/basic/Template/Autotext.xba
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
* This file is part of the LibreOffice project.
*
* This Source Code Form is subject to the terms of the Mozilla Public
* License, v. 2.0. If a copy of the MPL was not distributed with this
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
*
* This file incorporates work covered by the following license notice:
*
* 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 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Autotext" script:language="StarBasic">Option Explicit
Public UserfieldDataType(14) as String
Public oDocAuto as Object
Public BulletList(7) as Integer
Public sTextFieldNotDefined as String
Public sGeneralError as String
Sub Main()
Dim oCursor as Object
Dim oStyles as Object
Dim oSearchDesc as Object
Dim oFoundall as Object
Dim oFound as Object
Dim i as Integer
Dim sFoundString as String
Dim sFoundContent as String
Dim FieldStringThere as String
Dim ULStringThere as String
Dim PHStringThere as String
On Local Error Goto GENERALERROR
' Initialization...
BasicLibraries.LoadLibrary("Tools")
If InitResources("'Template'") Then
sGeneralError = GetResText("CorrespondenceMsgError")
sTextFieldNotDefined = GetResText("TextField")
End If
UserfieldDatatype(0) = "COMPANY"
UserfieldDatatype(1) = "FIRSTNAME"
UserfieldDatatype(2) = "NAME"
UserfieldDatatype(3) = "SHORTCUT"
UserfieldDatatype(4) = "STREET"
UserfieldDatatype(5) = "COUNTRY"
UserfieldDatatype(6) = "ZIP"
UserfieldDatatype(7) = "CITY"
UserfieldDatatype(8) = "TITLE"
UserfieldDatatype(9) = "POSITION"
UserfieldDatatype(10) = "PHONE_PRIVATE"
UserfieldDatatype(11) = "PHONE_COMPANY"
UserfieldDatatype(12) = "FAX"
UserfieldDatatype(13) = "EMAIL"
UserfieldDatatype(14) = "STATE"
BulletList(0) = 149
BulletList(1) = 34
BulletList(2) = 65
BulletList(3) = 61
BulletList(4) = 49
BulletList(5) = 47
BulletList(6) = 79
BulletList(7) = 58
oDocAuto = ThisComponent
oStyles = oDocAuto.Stylefamilies.GetByName("NumberingStyles")
' Prepare the Search-Descriptor
oSearchDesc = oDocAuto.createsearchDescriptor()
oSearchDesc.SearchRegularExpression = True
oSearchDesc.SearchWords = True
oSearchDesc.SearchString = "<[^>]+>"
oFoundall = oDocAuto.FindAll(oSearchDesc)
'Loop over the foundings
For i = 0 To oFoundAll.Count - 1
oFound = oFoundAll.GetByIndex(i)
sFoundString = oFound.String
'Extract the string inside the brackets
sFoundContent = FindPartString(sFoundString,"<",">",1)
sFoundContent = LTrim(sFoundContent)
' Define the Cursor and place it on the founding
oCursor = oFound.Text.CreateTextCursorbyRange(oFound)
' Find out, which object is to be created...
FieldStringThere = Instr(1,sFoundContent,"Field")
ULStringThere = Instr(1,sFoundContent,"UL")
PHStringThere = Instr(1,sFoundContent,"Placeholder")
If FieldStringThere = 1 Then
CreateUserDatafield(oCursor, sFoundContent)
ElseIf ULStringThere = 1 Then
CreateBullet(oCursor, oStyles)
ElseIf PHStringThere = 1 Then
CreatePlaceholder(oCursor, sFoundContent)
End If
Next i
GENERALERROR:
If Err <> 0 Then
Msgbox(sGeneralError,16, GetProductName())
Resume LETSGO
End If
LETSGO:
End Sub
' creates a User - datafield out of a string with the following structure
' "<field:Company>"
Sub CreateUserDatafield(oCursor, sFoundContent as String)
Dim MaxIndex as Integer
Dim sFoundList(3)
Dim oUserfield as Object
Dim UserInfo as String
Dim UserIndex as Integer
oUserfield = oDocAuto.CreateInstance("com.sun.star.text.TextField.ExtendedUser")
sFoundList() = ArrayoutofString(sFoundContent,":",MaxIndex)
UserInfo = UCase(LTrim(sFoundList(1)))
UserIndex = IndexInArray(UserInfo, UserfieldDatatype())
If UserIndex <> -1 Then
oUserField.UserDatatype = UserIndex
oCursor.Text.InsertTextContent(oCursor,oUserField,True)
oUserField.IsFixed = True
Else
Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName())
End If
End Sub
' Creates a Bullet by setting a soft Formatation on the first unsorted List-Templates with a defined
' Bullet Id
Sub CreateBullet(oCursor, oStyles as Object)
Dim n, m, s as Integer
Dim StyleSet as Boolean
Dim ostyle as Object
Dim StyleName as String
Dim alevel()
StyleSet = False
For s = 0 To Ubound(BulletList())
For n = 0 To oStyles.Count - 1
ostyle = oStyles.getbyindex(n)
StyleName = oStyle.Name
alevel() = ostyle.NumberingRules.getbyindex(0)
' The properties of the style are stored in a Name-Value-Array()
For m = 0 to Ubound(alevel())
' Set the first Numbering template without a bulletID
If (aLevel(m).Name = "BulletId") Then
If alevel(m).Value = BulletList(s) Then
oCursor.NumberingStyle = StyleName
oCursor.SetString("")
exit Sub
End if
End If
Next m
Next n
Next s
If Not StyleSet Then
' The Template with the demanded BulletID is not available, so take the first style in the sequence
' that has a defined Bullet ID
oCursor.NumberingStyleName = oStyles.GetByIndex(5).Name
oCursor.SetString("")
End If
End Sub
' Creates a placeholder out of a string with the following structure:
'<placeholder:Showtext:Helptext>
Sub CreatePlaceholder(oCursor as Object, sFoundContent as String)
Dim oPlaceholder as Object
Dim MaxIndex as Integer
Dim sFoundList(3)
oPlaceholder = oDocAuto.CreateInstance("com.sun.star.text.TextField.JumpEdit")
sFoundList() = ArrayoutofString(sFoundContent, ":" & chr(34),MaxIndex)
' Delete The Double-quotes
oPlaceholder.Hint = DeleteStr(sFoundList(2),chr(34))
oPlaceholder.placeholder = DeleteStr(sFoundList(1),chr(34))
oCursor.Text.InsertTextContent(oCursor,oPlaceholder,True)
End Sub
</script:module>
Mini Shell