Option Explicit 'Todo: Controlling Scrollbar via Keyboard Public Const SBMAXFIELDINDEX = 14 Public DlgUserFields as Object Public oDocument as Object Public UserFieldDataType(SBMAXFIELDINDEX,1) as String Public ScrollBarValue as Integer Public UserFieldFamily(0, SBMAXfIELDINDEX) as String Public Const SBTBCOUNT = 9 Public oUserDataAccess as Object Public CurFieldIndex as Integer Public FilePath as String Sub StartChangesUserfields Dim SystemPath as String BasicLibraries.LoadLibrary("Tools") UserFieldDatatype(0,0) = "COMPANY" UserFieldDatatype(0,1) = "o" UserFieldDatatype(1,0) = "FIRSTNAME" UserFieldDatatype(1,1) = "givenname" UserFieldDatatype(2,0) = "LASTNAME" UserFieldDatatype(2,1) = "sn" UserFieldDatatype(3,0) = "INITIALS" UserFieldDatatype(3,1) = "initials" UserFieldDatatype(4,0) = "STREET" UserFieldDatatype(4,1) = "street" UserFieldDatatype(5,0) = "COUNTRY" UserFieldDatatype(5,1) = "c" UserFieldDatatype(6,0) = "ZIP" UserFieldDatatype(6,1) = "postalcode" UserFieldDatatype(7,0) = "CITY" UserFieldDatatype(7,1) = "l" UserFieldDatatype(8,0) = "TITLE" UserFieldDatatype(8,1) = "title" UserFieldDatatype(9,0) = "POSITION" UserFieldDatatype(9,1) = "position" UserFieldDatatype(10,0) = "PHONE_HOME" UserFieldDatatype(10,1) = "homephone" UserFieldDatatype(11,0) = "PHONE_WORK" UserFieldDatatype(11,1) = "telephonenumber" UserFieldDatatype(12,0) = "FAX" UserFieldDatatype(12,1) = "facsimiletelephonenumber" UserFieldDatatype(13,0) = "E-MAIL" UserFieldDatatype(13,1) = "mail" UserFieldDatatype(14,0) = "STATE" UserFieldDatatype(14,1) = "st" FilePath = GetPathSettings("Config", False) & "/" & "UserData.dat" DlgUserFields = LoadDialog("Gimmicks","UserfieldDlg") SystemPath = ConvertFromUrl(FilePath) DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, "'" & SystemPath & "'", "<ConfigDir>") DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, GetProductName(), "<PRODUCTNAME>") DlgUserFields.Model.cmdSelect.HelpText = ReplaceString(DlgUserFields.Model.cmdSelect.HelpText, GetProductName(), "<PRODUCTNAME>") ScrollBarValue = 0 oUserDataAccess = GetRegistryKeyContent("org.openoffice.UserProfile/Data", True) InitializeUserFamily() FillDialog() DlgUserFields.Execute DlgUserFields.Dispose() End Sub Sub FillDialog() Dim a as Integer With DlgUserFields For a = 1 To SBTBCount .GetControl("Label" & a).Model.Label = UserFieldDataType(a-1,0) .GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, a-1) Next a .Model.ScrollBar1.ScrollValueMax = (SBMAXFIELDINDEX+1) - SBTBCOUNT .Model.ScrollBar1.BlockIncrement = SBTBCOUNT .Model.ScrollBar1.LineIncrement = 1 .Model.ScrollBar1.ScrollValue = ScrollBarValue End With End Sub Sub ScrollControls() ScrollTextFieldInfo(ScrollBarValue) ScrollBarValue = DlgUserFields.Model.ScrollBar1.ScrollValue If (ScrollBarValue + SBTBCOUNT) >= SBMAXFIELDINDEX + 1 Then ScrollBarValue = (SBMAXFIELDINDEX + 1) - SBTBCOUNT End If FillupTextFields() End Sub Sub ScrollTextFieldInfo(ByVal iScrollValue as Integer) Dim a as Integer Dim CurIndex as Integer For a = 1 To SBTBCOUNT CurIndex = (a-1) + iScrollValue UserFieldFamily(CurFieldIndex,CurIndex) = DlgUserFields.GetControl("TextField" & a).Model.Text Next a End Sub Sub StopMacro() DlgUserFields.EndExecute End Sub Sub SaveSettings() Dim n as Integer Dim m as Integer Dim MaxIndex as Integer ScrollTextFieldInfo(DlgUserFields.Model.ScrollBar1.ScrollValue) MaxIndex = Ubound(UserFieldFamily(), 1) Dim FileStrings(MaxIndex) as String For n = 0 To MaxIndex FileStrings(n) = "" For m = 0 To SBMAXFIELDINDEX FileStrings(n) = FileStrings(n) & UserFieldFamily(n,m) & ";" Next m Next n SaveDataToFile(FilePath, FileStrings(), True) End Sub Sub ToggleButtons(ByVal Index as Integer) Dim i as Integer CurFieldIndex = Index DlgUserFields.Model.cmdNextUser.Enabled = CurFieldIndex <> Ubound(UserFieldFamily(), 1) DlgUserFields.Model.cmdPrevUser.Enabled = CurFieldIndex <> 0 End Sub Sub InitializeUserFamily() Dim FirstIndex as Integer Dim UserFieldstrings() as String Dim LocStrings() as String Dim bFileExists as Boolean Dim n as Integer Dim m as Integer bFileExists = LoadDataFromFile(GetPathSettings("Config", False) & "/" & "UserData.dat", UserFieldStrings()) If bFileExists Then FirstIndex = Ubound(UserFieldStrings()) ReDim Preserve UserFieldFamily(FirstIndex, SBMAXFIELDINDEX) as String For n = 0 To FirstIndex LocStrings() = ArrayOutofString(UserFieldStrings(n), ";") For m = 0 To SBMAXFIELDINDEX UserFieldFamily(n,m) = LocStrings(m) Next m Next n Else ReDim Preserve UserFieldFamily(0,SBMAXFIELDINDEX) as String For m = 0 To SBMAXFIELDINDEX UserFieldFamily(0,m) = oUserDataAccess.GetByName(UserFieldDataType(m,1)) Next m End If ToggleButtons(0) End Sub Sub AddRecord() Dim i as Integer Dim MaxIndex as Integer For i = 1 To SBTBCount DlgUserFields.GetControl("TextField" & i).Model.Text = "" Next i MaxIndex = Ubound(UserFieldFamily(),1) ReDim Preserve UserFieldFamily(MaxIndex + 1, SBMAXFIELDINDEX) as String ToggleButtons(MaxIndex + 1, 1) End Sub Sub FillupTextFields() Dim a as Integer Dim CurIndex as Integer For a = 1 To SBTBCOUNT CurIndex = (a-1) + ScrollBarValue DlgUserFields.GetControl("Label" & a).Model.Label = UserFieldDataType(CurIndex,0) DlgUserFields.GetControl("TextField" & a).Model.Text = UserFieldFamily(CurFieldIndex, CurIndex) Next a End Sub Sub StepToRecord(aEvent as Object) Dim iStep as Integer iStep = CInt(aEvent.Source.Model.Tag) ScrollTextFieldInfo(ScrollBarValue) ToggleButtons(CurFieldIndex + iStep) FillUpTextFields() End Sub Sub SelectCurrentFields() Dim MaxIndex as Integer Dim i as Integer ScrollTextFieldInfo(ScrollBarValue) MaxIndex = Ubound(UserFieldFamily(),2) For i = 0 To MaxIndex oUserDataAccess.ReplaceByName(UserFieldDataType(i,1), UserFieldFamily(CurFieldIndex, i)) Next i oUserDataAccess.commitChanges() End Sub Sub DeleteCurrentSettings() Dim n as Integer Dim m as Integer Dim MaxIndex as Integer MaxIndex = Ubound(UserFieldFamily(),1) If CurFieldIndex < MaxIndex Then For n = CurFieldIndex To MaxIndex - 1 For m = 0 To SBMAXFIELDINDEX UserFieldFamily(n,m) = UserFieldFamily(n + 1,m) Next m Next n Else CurFieldIndex = MaxIndex - 1 End If ReDim Preserve UserFieldFamily(MaxIndex-1, SBMAXfIELDINDEX) as String FillupTextFields() ToggleButtons(CurFieldIndex) End Sub