com!online 2001 December/COMCD1201.iso/openoffice/f_0177/Userfields.xba

Extensible Markup Language | 2001-04-25 | 5.6 KB | 197 lines

<?xml version="1.0" encoding="UTF-8"?>

<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Userfields" script:language="StarBasic">
Public iUserFieldCount as integer
Public LabelArray(10) as Object
Public EditArray(10) as Object
Public UserFieldName(255) as String
Public UserFieldValue(255) as String
Public oDocument as Object
Public aTextField as Object
Public aTextFieldEnum as Object
Public const MAXFIELDCOUNT = 9
Public UserFieldDataType(14) as String
Public ScrollBarValue as Integer

Sub StartChangesUserfields
Dim a as Integer
Dim CurElement, TFMaster as Object

        BasicLibraries.LoadLibrary("Tools")
    LoadLanguage(StarDesktop.ISOLocale.Language)
    ScrollBarValue = 0
    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"

    On Local Error GoTo NODOCUMENT
    oDocument = StarDesktop.ActiveFrame.Controller.Model
    NODOCUMENT:
    If Err <> 0 Then
        Msgbox(Error$ & "This Macro gives you the opportunity to change all Userfields of a displayed Document." & chr(13) &_
               "To start this macro you have to activate a Document first!" , 16, "StarOffice 5.2")
        Exit Sub
    End If
    On Local Error Goto 0

    ' Define TextFields
    aTextfield = oDocument.getTextfields
    aTextFieldEnum = aTextField.CreateEnumeration
    a = 0
    While aTextFieldEnum.hasmoreElements
        CurElement = aTextFieldEnum.NextElement
        If Not IsNull(CurElement) Then
            If CurElement.PropertySetInfo.hasPropertybyName("Content") Then
                TFMaster = CurElement.TextFieldMaster
                a = a + 1
                If a >= 255 Then
                    MsgBox ErrorMsg1, 0 + 16, ErrorHeader
                    Exit Sub
                End If
                UserFieldName(a) = UserFieldDataType(CurElement.UserDataType)
                UserFieldValue(a) = CurElement.Content
            End If
        End If
    Wend
    iUserFieldCount = a
    If iUserFieldCount = 0 Then
        MsgBox ErrorMsg2, 0+48, ErrorHeader
        Exit Sub
    End If

    UserfieldDlg.Load

    Call SetControlArray()
    Call FillDialog()

    UserFieldDlg.Show
End Sub



Sub FillDialog()
Dim a as Integer
    Call SetDialogText
    For a = 1 To MaxFieldCount
        If a <= iUserFieldCount Then
            LabelArray(a).Caption = UserFieldName(a)
            EditArray(a).Text = UserFieldValue(a)
        Else
            LabelArray(a).Caption = ""
            EditArray(a).Text = ""
            LabelArray(a).Enabled = False
            EditArray(a).Enabled = false
        End If
    Next a

    If iUserFieldCount > MaxFieldCount Then
        UserfieldDlg.VScrollbar.Min = 0
        UserfieldDlg.VScrollbar.Max = iUserFieldCount-MaxFieldCount
        UserfieldDlg.VScrollbar.LargeChange = MaxFieldCount
        UserfieldDlg.VScrollbar.SmallChange = 1
    Else
        UserfieldDlg.VScrollbar.enabled = False
    End If

End Sub



Sub Dlg_Scroll(ScrollValue)
    Call ChangeArray(ScrollBarValue)
    ScrollBarValue = UserfieldDlg.VScrollbar.Value
    If (ScrollBarValue + MaxFieldCount) > iUserFieldCount Then
        ScrollBarValue = iUserFieldCount - MaxFieldCount
    End If

    For a = 1 To MaxFieldCount
        LabelArray(a).Caption = UserFieldName(a + ScrollBarValue)
        EditArray(a).Text = UserFieldValue(a + ScrollBarValue)
    Next a
End Sub


Sub ChangeArray(ByVal ScrollBarValue)
Dim a as Integer
    For a = 1 To MaxFieldCount
        UserFieldValue(a + ScrollBarValue) = EditArray(a).Text
    Next a
End Sub


Sub Cancel_Click
    UserfieldDlg.Hide
End Sub


Sub Save_Click
Dim i as Integer
Dim CurElement, TFMaster as Object

    UserfieldDlg.CancelChanges.Enabled = false
    UserfieldDlg.SaveChanges.Enabled = false

    ChangeArray(UserfieldDlg.VScrollbar.Value)

    aTextfield = oDocument.getTextfields
    aTextFieldEnum = aTextField.CreateEnumeration
    i = 1
    While aTextFieldEnum.hasmoreElements
        CurElement = aTextFieldEnum.NextElement
        If Not IsNull(CurElement) Then
            If Curelement.PropertySetInfo.hasPropertybyName("Content") Then
                If CurElement.Content <> UserFieldValue(i) Then
                    CurElement.Content = UserFieldValue(i)
                End If
                i = i  + 1
            End If
        End If
    Wend
    aTextField.Refresh
    UserfieldDlg.Hide
End Sub



Sub SetControlArray()
    Set LabelArray(1) = UserfieldDlg.Label1
    Set EditArray(1) = UserfieldDlg.Textbox1
    Set LabelArray(2) = UserfieldDlg.Label2
    Set EditArray(2) = UserfieldDlg.Textbox2
    Set LabelArray(3) = UserfieldDlg.Label3
    Set EditArray(3) = UserfieldDlg.Textbox3
    Set LabelArray(4) = UserfieldDlg.Label4
    Set EditArray(4) = UserfieldDlg.Textbox4
    Set LabelArray(5) = UserfieldDlg.Label5
    Set EditArray(5) = UserfieldDlg.Textbox5
    Set LabelArray(6) = UserfieldDlg.Label6
    Set EditArray(6) = UserfieldDlg.Textbox6
    Set LabelArray(7) = UserfieldDlg.Label7
    Set EditArray(7) = UserfieldDlg.Textbox7
    Set LabelArray(8) = UserfieldDlg.Label8
    Set EditArray(8) = UserfieldDlg.Textbox8
    Set LabelArray(9) = UserfieldDlg.Label9
    Set EditArray(9) = UserfieldDlg.Textbox9
End Sub


Sub SetDialogText
    UserfieldDlg.caption = HeaderLabel
    UserfieldDlg.HeaderLabel.Caption = HeaderLabel
    UserfieldDlg.CancelChanges.Caption = CancelButton
    UserfieldDlg.SaveChanges.Caption = SaveButton
End Sub
</script:module>