DOS/V Power Report 2002 October/VPR0210A.ISO/OPENOFFICE/f_0110/Autotext.xba

Extensible Markup Language | 2001-12-12 | 6KB | 163 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

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

    ' Initialization...
    BasicLibraries.LoadLibrary("Tools")

    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
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 sTextFieldNotDefined as String
    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
        If InitResources("'Template'", "tpl") Then
            sTextFieldNotDefined = GetResText(1400)
            Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName())
        End If
    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>