Freelog 52/Freelog052.iso/Dossier/OpenOffice/f_0285/Autotext.xba

Extensible Markup Language | 2002-09-10 | 6KB | 173 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<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'", "tpl") Then
        sGeneralError = GetResText(1302)
        sTextFieldNotDefined = GetResText(1400)
    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>