From ed5640d8b587fbcfed7dd7967f3de04b37a76f26 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 11:06:44 +0200 Subject: Adding upstream version 4:7.4.7. Signed-off-by: Daniel Baumann --- wizards/source/template/Autotext.xba | 190 ++++++++++++++++++ wizards/source/template/Correspondence.xba | 303 +++++++++++++++++++++++++++++ wizards/source/template/DialogStyles.xdl | 32 +++ wizards/source/template/ModuleAgenda.xba | 220 +++++++++++++++++++++ wizards/source/template/Samples.xba | 168 ++++++++++++++++ wizards/source/template/TemplateDialog.xdl | 46 +++++ wizards/source/template/dialog.xlb | 7 + wizards/source/template/script.xlb | 8 + 8 files changed, 974 insertions(+) create mode 100644 wizards/source/template/Autotext.xba create mode 100644 wizards/source/template/Correspondence.xba create mode 100644 wizards/source/template/DialogStyles.xdl create mode 100644 wizards/source/template/ModuleAgenda.xba create mode 100644 wizards/source/template/Samples.xba create mode 100644 wizards/source/template/TemplateDialog.xdl create mode 100644 wizards/source/template/dialog.xlb create mode 100644 wizards/source/template/script.xlb (limited to 'wizards/source/template') diff --git a/wizards/source/template/Autotext.xba b/wizards/source/template/Autotext.xba new file mode 100644 index 000000000..35b3fdf62 --- /dev/null +++ b/wizards/source/template/Autotext.xba @@ -0,0 +1,190 @@ + + + +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 + + + diff --git a/wizards/source/template/Correspondence.xba b/wizards/source/template/Correspondence.xba new file mode 100644 index 000000000..01da7f3d8 --- /dev/null +++ b/wizards/source/template/Correspondence.xba @@ -0,0 +1,303 @@ + + + +Option Explicit + +Public msgNoTextmark$, msgError$ +Public sAddressbook$ +Public Table +Public sCompany$, sFirstName$, sLastName$, sStreet$, sPostalCode$, sCity$, sState$, sInitials$, sPosition$ +Public DialogExited +Public oDocument, oText, oBookMarks, oBookMark, oBookMarkCursor, oBookText as Object +Public bTemplate, bDBFields as Boolean + +Sub Main + bTemplate = true + BasicLibraries.LoadLibrary("Tools") + TemplateDialog = LoadDialog("Template", "TemplateDialog") + DialogModel = TemplateDialog.Model + DialogModel.Step = 2 + DialogModel.Optmerge.State = True + LoadLanguageCorrespondence() + TemplateDialog.Execute + TemplateDialog.Dispose() +End Sub + + +Sub Placeholder + bTemplate = false + BasicLibraries.LoadLibrary("Tools") + LoadLanguageCorrespondence() + bDBFields = false + OK() +End Sub + + +Sub Database + bTemplate = false + BasicLibraries.LoadLibrary("Tools") + LoadLanguageCorrespondence() + bDBFields = true + OK() +End Sub + + +Function LoadLanguageCorrespondence() as Boolean + If InitResources("'Template'") Then + msgNoTextmark$ = GetResText("CorrespondenceDialog_0") & Chr(13) & Chr(10) & GetResText("CorrespondenceNoTextmark_1") + msgError$ = GetResText("CorrespondenceMsgError") + If bTemplate Then + DialogModel.Title = GetResText("CorrespondenceDialog_3") + DialogModel.CmdCancel.Label = GetResText("STYLES_2") + DialogModel.CmdCorrGoOn.Label = GetResText("STYLES_3") + DialogModel.OptSingle.Label = GetResText("CorrespondenceDialog_1") + DialogModel.Optmerge.Label = GetResText("CorrespondenceDialog_2") + DialogModel.FrmLetter.Label = GetResText("CorrespondenceDialog_0") + End If + LoadLanguageCorrespondence() = True + Else + msgbox("Warning: Resource could not be loaded!") + End If +End Function + + +Function GetFieldName(oFieldKnot as Object, GeneralFieldName as String) + If oFieldKnot.HasByName(GeneralFieldName) Then + GetFieldName = oFieldKnot.GetByName(GeneralFieldName).AssignedFieldName + Else + GetFieldName = "" + End If +End Function + + +Sub OK +Dim ParaBreak +Dim sDocLang as String +Dim oSearchDesc as Object +Dim oFoundAll as Object +Dim oFound as Object +Dim sFoundContent as String +Dim sFoundString as String +Dim sDBField as String +Dim i as Integer +Dim oDBAccess as Object +Dim oAddressDialog as Object +Dim oAddressPilot as Object +Dim oFields as Object +Dim oDocSettings as Object +Dim oContext as Object +Dim bDBvalid as Boolean + 'On Local Error Goto GENERALERROR + + If bTemplate Then + bDBFields = DialogModel.Optmerge.State 'database or placeholder + TemplateDialog.EndExecute() + DialogExited = TRUE + End If + + If bDBFields Then + oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") + sAddressbook = oDBAccess.DataSourceName + + bDBvalid = false + oContext = createUnoService( "com.sun.star.sdb.DatabaseContext" ) + + If (not isNull(oContext)) Then + 'Is the previously assigned address data source still valid? + bDBvalid = oContext.hasByName(sAddressbook) + end if + + If (bDBvalid = false) Then + oAddressPilot = createUnoService("com.sun.star.ui.dialogs.AddressBookSourcePilot") + oAddressPilot.execute + + oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") + sAddressbook = oDBAccess.DataSourceName + If sAddressbook = "" Then + MsgBox(GetResText("CorrespondenceNoTextmark_1")) + Exit Sub + End If + End If + oFields = oDBAccess.GetByName("Fields") + Table = oDBAccess.GetByName("Command") + End If + + ParaBreak = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK + oDocument = ThisComponent + If bDBFields Then + 'set the address db as current db at the document + oDocSettings = oDocument.createInstance("com.sun.star.document.Settings") + oDocSettings.CurrentDatabaseDataSource = sAddressbook + oDocSettings.CurrentDatabaseCommand = Table + oDocSettings.CurrentDatabaseCommandType = 0 + End If + oBookmarks = oDocument.Bookmarks + oText = oDocument.Text + + oSearchDesc = oDocument.createsearchDescriptor() + oSearchDesc.SearchRegularExpression = True + oSearchDesc.SearchWords = True + oSearchDesc.SearchString = "<[^>]+>" + oFoundall = oDocument.FindAll(oSearchDesc) + + 'Loop over the foundings + For i = oFoundAll.Count -1 To 0 Step -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 + oBookmarkCursor = oFound.Text.CreateTextCursorbyRange(oFound) + oBookText = oFound.Text + If bDBFields Then + sDBField = GetFieldname(oFields, sFoundContent) + If sDBField <> "" Then + InsertDBField(sAddressbook, Table, sDBField) + Else + InsertPlaceholder(sFoundContent) + End If + Else + InsertPlaceholder(sFoundContent) + End If + Next i + If bDBFields Then + 'Open the DB beamer with the right DB + Dim oDisp as Object + Dim oTransformer + Dim aURL as new com.sun.star.util.URL + aURL.complete = ".component:DB/DataSourceBrowser" + oTransformer = createUnoService("com.sun.star.util.URLTransformer") + oTransformer.parseStrict(aURL) + oDisp = oDocument.getCurrentController.getFrame.queryDispatch(aURL, "_beamer", com.sun.star.frame.FrameSearchFlag.CHILDREN + com.sun.star.frame.FrameSearchFlag.CREATE) + Dim aArgs(3) as new com.sun.star.beans.PropertyValue + aArgs(1).Name = "DataSourceName" + aArgs(1).Value = sAddressbook + aArgs(2).Name = "CommandType" + aArgs(2).Value = com.sun.star.sdb.CommandType.TABLE + aArgs(3).Name = "Command" + aArgs(3).Value = Table + oDisp.dispatch(aURL, aArgs()) + End If + + GENERALERROR: + If Err <> 0 Then + Msgbox(msgError$,16, GetProductName()) + Resume LETSGO + End If + LETSGO: + +End Sub + + +Sub InsertDBField(sDBName as String, sTableName as String, sColName as String) +Dim oFieldMaster, oField as Object + If sColname <> "" Then + oFieldMaster = oDocument.createInstance("com.sun.star.text.FieldMaster.Database") + oField = oDocument.createInstance("com.sun.star.text.TextField.Database") + oFieldMaster.DataBaseName = sDBName + oFieldMaster.DataBaseName = sDBName + oFieldMaster.DataTableName = sTableName + oFieldMaster.DataColumnName = sColName + oField.AttachTextfieldmaster (oFieldMaster) + oBookText.InsertTextContent(oBookMarkCursor, oField, True) + oField.Content = "<" & sColName & ">" + End If +End Sub + + +Sub InsertPlaceholder(sColName as String) +Dim oFieldMaster as Object +Dim bCorrectField as Boolean + If sColname <> "" Then + bCorrectField = True + oFieldMaster = oDocument.createInstance("com.sun.star.text.TextField.JumpEdit") + Select Case sColName + Case "Company" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_1") + Case "Department" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_2") + Case "FirstName" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_3") + Case "LastName" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_4") + Case "Street" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_5") + Case "Country" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_6") + Case "Zip" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_7") + Case "City" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_8") + Case "Title" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_9") + Case "Position" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_10") + Case "AddrForm" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_11") + Case "Code" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_12") + Case "AddrFormMail" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_13") + Case "PhonePriv" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_14") + Case "PhoneComp" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_15") + Case "Fax" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_16") + Case "EMail" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_17") + Case "URL" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_18") + Case "Note" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_19") + Case "Altfield1" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_20") + Case "Altfield2" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_21") + Case "Altfield3" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_22") + Case "Altfield4" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_23") + Case "Id" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_24") + Case "State" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_25") + Case "PhoneOffice" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_26") + Case "Pager" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_27") + Case "PhoneCell" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_28") + Case "PhoneOther" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_29") + Case "CalendarURL" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_30") + Case "InviteParticipant" + oFieldMaster.PlaceHolder = getResText("CorrespondenceFields_31") + Case Else + bCorrectField = False + End Select + If bCorrectField Then + oFieldMaster.Hint = getResText("CorrespondenceFields_0") + oBookText.InsertTextContent(oBookMarkCursor, oFieldMaster, True) + End If + End If +End Sub + diff --git a/wizards/source/template/DialogStyles.xdl b/wizards/source/template/DialogStyles.xdl new file mode 100644 index 000000000..ec5f71423 --- /dev/null +++ b/wizards/source/template/DialogStyles.xdl @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/wizards/source/template/ModuleAgenda.xba b/wizards/source/template/ModuleAgenda.xba new file mode 100644 index 000000000..a17fb68cd --- /dev/null +++ b/wizards/source/template/ModuleAgenda.xba @@ -0,0 +1,220 @@ + + + +' All variables must be declared before use +Option Explicit + +' Used for "disabling" the cancel button of the dialog +Public DialogExited As Boolean +Dim DlgAgenda_gMyName as String +Public TemplateDialog as Object +Public DialogModel as Object +Public sTrueContent as String +Public Bookmarkname as String + + + +Sub Initialize() +' User sets the type of minutes + BasicLibraries.LoadLibrary( "Tools" ) + TemplateDialog = LoadDialog("Template", "TemplateDialog") + DialogModel = TemplateDialog.Model + DialogModel.Step = 1 + LoadLanguageAgenda() + DialogModel.OptAgenda2.State = TRUE + GetOptionValues() + DialogExited = FALSE + TemplateDialog.Execute +End Sub + + +Sub LoadLanguageAgenda() + If InitResources("'Template'") Then + DlgAgenda_gMyName = GetResText("AgendaDlgName") + DialogModel.CmdCancel.Label = GetResText("STYLES_2") + DialogModel.CmdAgdGoon.Label = GetResText("STYLES_3") +' DlgAgenda_gMsgNoCancel$ = GetResText("AgendaDlgNoCancel") + DialogModel.FrmAgenda.Label = GetResText("AgendaDlgFrame") + DialogModel.OptAgenda1.Label = GetResText("AgendaDlgButton1") + DialogModel.OptAgenda2.Label = GetResText("AgendaDlgButton2") +' DialogModel.OptAgenda1.State = 1 + End If +End Sub + + +Sub ModifyTemplate() +Dim oDocument, oBookmarks, oBookmark, oBookmarkCursor, oTextField as Object +Dim i as Integer + + oDocument = ThisComponent + oBookMarks = oDocument.Bookmarks + + On Local Error Goto NOBOOKMARK + TemplateDialog.EndExecute + DialogExited = TRUE + oBookmarkCursor = CreateBookmarkCursor(oDocument, BookmarkName) + oBookmarkCursor.Text.insertString(oBookmarkCursor,"",True) + ' Delete all the Bookmarks except for the one named "NextTopic" + For i = oBookmarks.Count-1 To 0 Step -1 + oBookMark = oBookMarks.GetByIndex(i) + If oBookMark.Name <> "NextTopic" Then + oBookMark.Dispose() + End If + Next i + oBookMarkCursor = CreateBookmarkCursor(oDocument, "NextTopic") + If Not IsNull(oBookMarkCursor) Then + oTextField = oBookMarkCursor.TextField +' oTextField.TrueContent = sTrueContent + oTextField.Content = sTrueContent + End If + + NOBOOKMARK: + If Err <> 0 Then + RESUME NEXT + End If +End Sub + + +Sub NewTopic +' Add a new topic to the agenda +Dim oDocument, oBookmarks, oBookmark, oBookmarkCursor, oTextField as Object +Dim oBaustein, oAutoText, oAutoGroup as Object +Dim i as Integer + + oDocument = ThisComponent + oBookMarkCursor = CreateBookMarkCursor(oDocument, "NextTopic") + oTextField = oBookMarkCursor.TextField + oAutoText = CreateUnoService("com.sun.star.text.AutoTextContainer") + If oAutoText.HasbyName("template") Then + oAutoGroup = oAutoText.GetbyName("template") + If oAutoGroup.HasbyName(oTextField.Content) Then + oBaustein = oAutoGroup.GetbyName(oTextField.Content) + oBaustein.ApplyTo(oBookMarkCursor) + Else + Msgbox("AutoText '" & oTextField.Content & "' is not existing. Cannot insert additional topic!") + End If + Else + Msgbox("AutoGroupField template is not existing. Cannot insert additional topic!", 16, DlgAgenda_gMyName ) + End If +End Sub + + + +' Add initials, date and time at bottom of agenda, disable and hide command buttons +Sub FinishAgenda +Dim BtnAddAgendaTopic As Object +Dim BtnFinishAgenda As Object +Dim oUserField, oDateTimeField as Object +Dim oBookmarkCursor as Object +Dim oFormats, oLocale as Object +Dim iDateTimeKey as Integer + + BasicLibraries.LoadLibrary( "Tools" ) + oDocument = ThisComponent + + oUserField = oDocument.CreateInstance("com.sun.star.text.TextField.ExtendedUser") + oUserField.UserDatatype = com.sun.star.text.UserDataPart.SHORTCUT + + oDateTimeField = oDocument.CreateInstance("com.sun.star.text.TextField.DateTime") + + ' Assign Standardformat to Datetime-Textfield + oFormats = oDocument.Numberformats + oLocale = oDocument.CharLocale + iDateTimeKey = oFormats.GetStandardFormat(com.sun.star.util.NumberFormat.DATETIME,oLocale) + oDateTimeField.NumberFormat = iDateTimeKey + + oBookmarkCursor = CreateBookmarkCursor(oDocument, "NextTopic") + oBookmarkCursor.Text.InsertTextContent(oBookmarkCursor,oUserField,False) + oBookmarkCursor.Text.InsertString(oBookmarkCursor," ",False) + oBookmarkCursor.Text.InsertTextContent(oBookmarkCursor,oDateTimeField,False) + BtnAddAgendaTopic = getControlModel(oDocument, "BtnAddAgendaTopic") + BtnFinishAgenda = getControlModel(oDocument, "BtnFinishAgenda") + If Not IsNull(BtnAddAgendaTopic) Then BtnAddAgendaTopic.Enabled = FALSE + If Not IsNull(BtnFinishAgenda) Then BtnFinishAgenda.Enabled = FALSE +End Sub + + +Function CreateBookMarkCursor(oDocument as Object,sBookmarkName as String) + oBookMarks = oDocument.Bookmarks + If oBookmarks.HasbyName(sBookmarkName) Then + oBookMark = oBookMarks.GetbyName(sBookmarkName) + CreateBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) + Else + Msgbox "Bookmark " & sBookmarkName & " is not defined!" + End If +End Function + + + +Sub DeleteButtons +Dim AgendaFinished As Boolean +Dim BtnAddAgendaTopic As Object +Dim BtnFinishAgenda As Object + + oDocument = ThisComponent + + BtnAddAgendaTopic = getControlModel(oDocument, "BtnAddAgendaTopic") + BtnFinishAgenda = getControlModel(oDocument, "BtnFinishAgenda") + + ' If buttons could be accessed: If at least one button is disabled, then agenda is finished + AgendaFinished = FALSE + If Not IsNull(BtnAddAgendaTopic) Then + AgendaFinished = (AgendaFinished Or (BtnAddAgendaTopic.Enabled = FALSE)) + End If + + If Not IsNull(BtnFinishAgenda) Then + AgendaFinished = (AgendaFinished Or (BtnFinishAgenda.Enabled = FALSE)) + End If + + ' Delete Buttons, empty rows at end of document & macro bindings if agenda is finished + If AgendaFinished Then + DisposeControl(oDocument, "BtnAddAgendaTopic") + DisposeControl(oDocument, "BtnFinishAgenda") + + oBookmarkCursor = CreateBookMarkCursor(oDocument,"NextTopic") + oBookMarkCursor.GotoEnd(True) + oBookmarkCursor.Text.insertString(oBookmarkCursor,"",True) + + AttachBasicMacroToEvent(oDocument,"OnNew", "") + AttachBasicMacroToEvent(oDocument,"OnSave", "") + AttachBasicMacroToEvent(oDocument,"OnSaveAs", "") + AttachBasicMacroToEvent(oDocument,"OnPrint", "") + End If +End Sub + + + +Sub GetOptionValues(Optional aEvent as Object) +Dim CurTag as String +Dim Taglist() as String + If Not IsMissing(aEvent) Then + CurTag = aEvent.Source.Model.Tag + Else + If DialogModel.OptAgenda1.State = TRUE Then + CurTag = DialogModel.OptAgenda1.Tag + Else + CurTag = DialogModel.OptAgenda2.Tag + End If + End If + Taglist() = ArrayoutOfString(CurTag, ";") + Bookmarkname = TagList(0) + sTrueContent = TagList(1) +End Sub + + diff --git a/wizards/source/template/Samples.xba b/wizards/source/template/Samples.xba new file mode 100644 index 000000000..25ff81bcf --- /dev/null +++ b/wizards/source/template/Samples.xba @@ -0,0 +1,168 @@ + + + +Option Explicit + +Const NumStyles = 18 +Const aTempFileName = "Berend_Ilko_Tom_Stella_Volker.stc" +Dim oUcbObject as Object +Public StylesDir as String +Public StylesDialog as Object +Public PathSeparator as String +Public oFamilies as Object +Public aOptions(0) as New com.sun.star.beans.PropertyValue +Public sQueryPath as String +Public NoArgs()as New com.sun.star.beans.PropertyValue +Public aTempURL as String + +Public Files(100) as String + +'-------------------------------------------------------------------------------------- +'Calc Style Section starts here + +Sub ShowStyles +'This sub displays the style selection dialog if the current document is a calc document. +Dim TemplateDir, ActFileTitle, DisplayDummy as String +Dim sFilterName(0) as String +Dim StyleNames() as String +Dim LocalizedStyleNames(NumStyles,2) As String +Dim LocalizedStyleName As String +Dim t as Integer +Dim MaxIndex as Integer +Dim StyleNameDef As Variant + BasicLibraries.LoadLibrary("Tools") + If InitResources("'Template'") then + oDocument = ThisComponent + If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then + ToggleWindow(False) + oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") + oFamilies = oDocument.StyleFamilies + SaveCurrentStyles(oDocument) + StylesDialog = LoadDialog("Template", "DialogStyles") + DialogModel = StylesDialog.Model + TemplateDir = GetPathSettings("Template", False, 0) + StylesDir = GetOfficeSubPath("Template", "wizard/styles/") + sQueryPath = GetOfficeSubPath("Template", "../wizard/bitmap/") + DialogModel.Title = GetResText("STYLES_0") + DialogModel.cmdCancel.Label = GetResText("STYLES_2") + DialogModel.cmdOk.Label = GetResText("STYLES_3") + StyleNameDef = Array("(Standard)", "Autumn Leaves", "Be", "Black and White", "Blackberry Bush", "Blue Jeans", "Fifties Diner", "Glacier", "Green Grapes", "Marine", "Millennium", "Nature", "Neon", "Night", "PC Nostalgia", "Pastel", "Pool Party", "Pumpkin") + For t = 0 to NumStyles - 1 + LocalizedStyleNames(t,0) = StyleNameDef(t) + LocalizedStyleNames(t,1) = GetResText("STYLENAME_" & Trim(Str(t))) + Next t + Stylenames() = ReadDirectories(StylesDir, False, False, True,) + MaxIndex = Ubound(Stylenames()) + For t = 0 to MaxIndex + LocalizedStyleName = StringInMultiArray(LocalizedStyleNames(), StyleNames(t,1), 0, 1) + If LocalizedStyleName <> "" Then + StyleNames(t,1) = LocalizedStyleName + End If + Next t + BubbleSortList(Stylenames(),True) + Dim cStyles(MaxIndex) + For t = 0 to MaxIndex + Files(t) = StyleNames(t,0) + cStyles(t) = StyleNames(t,1) + Next t + On Local Error Resume Next + DialogModel.lbStyles.StringItemList() = cStyles() + ToggleWindow(True) + StylesDialog.Execute + End If + End If +End Sub + + +Sub SelectStyle +'This sub loads the specific styles from a style document and loads them into the +'current document. +Dim StylePath as String +Dim NewStyle as String +Dim Position as Integer + Position = DialogModel.lbStyles.SelectedItems(0) + If Position > -1 Then + ToggleWindow(False) + StylePath = Files(Position) + aOptions(0).Name = "OverwriteStyles" + aOptions(0).Value = true + oFamilies.loadStylesFromURL(StylePath, aOptions()) + ToggleWindow(True) + End If +End Sub + + +Sub SaveCurrentStyles(oDocument as Object) +'This sub stores the current document in the directory to hold temporary files. + On Error Goto ErrorOccurred + aTempURL = GetPathSettings("Temp", False) + Dim aRightMost as String + aRightMost = Right(aTempURL, 1) + if aRightMost = "/" Then + aTempURL = aTempURL & aTempFileName + Else + aTempURL = aTempURL & "/" & aTempFileName + End If + + While FileExists(aTempURL) + aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.stc" + Wend + oDocument.storeToURL(aTempURL, NoArgs()) + Exit Sub + +ErrorOccurred: + MsgBox(GetResText("STYLES_1"), 16, GetResText("STYLES_0")) + On Local Error Goto 0 +End Sub + + +Sub RestoreCurrentStyles +'This sub retrieves the styles from the temporarily save document + ToggleWindow(False) + On Local Error Goto NoFile + If FileExists(aTempURL) Then + aOptions(0).Name = "OverwriteStyles" + aOptions(0).Value = true + oFamilies.LoadStylesFromURL(aTempURL, aOptions()) + KillTempFile() + End If + StylesDialog.EndExecute + ToggleWindow(True) +NOFILE: + If Err <> 0 Then + Msgbox("Cannot load Document from " & aTempUrl, 64, GetProductname()) + End If + On Local Error Goto 0 +End Sub + + +Sub CloseStyleDialog + KillTempFile() + DialogExited = True + StylesDialog.Endexecute +End Sub + + +Sub KillTempFile() + If oUcbObject.Exists(aTempUrl) Then + oUcbObject.Kill(aTempUrl) + End If +End Sub + + diff --git a/wizards/source/template/TemplateDialog.xdl b/wizards/source/template/TemplateDialog.xdl new file mode 100644 index 000000000..545b92f95 --- /dev/null +++ b/wizards/source/template/TemplateDialog.xdl @@ -0,0 +1,46 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/wizards/source/template/dialog.xlb b/wizards/source/template/dialog.xlb new file mode 100644 index 000000000..c5eed37a2 --- /dev/null +++ b/wizards/source/template/dialog.xlb @@ -0,0 +1,7 @@ + + + + + + + diff --git a/wizards/source/template/script.xlb b/wizards/source/template/script.xlb new file mode 100644 index 000000000..c89cc3788 --- /dev/null +++ b/wizards/source/template/script.xlb @@ -0,0 +1,8 @@ + + + + + + + + -- cgit v1.2.3