diff options
| author | Tom Verbeek <tv@openoffice.org> | 2001-04-23 09:46:42 +0000 |
|---|---|---|
| committer | Tom Verbeek <tv@openoffice.org> | 2001-04-23 09:46:42 +0000 |
| commit | c786f7438730e7793ca002c09e52e3785fc8caca (patch) | |
| tree | bcccef8e2d855f0ee06ef8db55a8832e1ea43c7e | |
| parent | 1227288c5df611aa8be748b2328b25f9a17ccafe (diff) | |
initial revision
43 files changed, 10749 insertions, 0 deletions
diff --git a/wizards/source/euro/AutoPilotRun.xba b/wizards/source/euro/AutoPilotRun.xba new file mode 100644 index 000000000..37228129c --- /dev/null +++ b/wizards/source/euro/AutoPilotRun.xba @@ -0,0 +1,398 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="AutoPilotRun" script:language="StarBasic">Option Explicit + +Public SourceDir as String +Public TargetDir as String +Public TargetStemDir as String +Public SourceFile as String +Public TargetFile as String +Public EuroStyles(50) as String +Public EuroBools(50) as Boolean +Public Source as String +Public SubstFile as String +Public SubstDir as String +Public NoArgs() +Public FilterList(0) as String +Public GoOn as Boolean +Public UnprotectList(50,1) as String +Public DoUnprotect as Integer +Public Password as String +Public DocIndex as Integer +Public oPathSettings as Object +Public oDocInfo as Object +Public oUcb as Object +Public TotDocCount as Integer +Public sTotDocCount as String + +Sub StartAutoPilot() +Dim i As Integer + LoadLibrary("tools") + If InitResources("Euro Converter", "eur") Then + oDocInfo = CreateUnoService("com.sun.star.document.StandaloneDocumentInfo") + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + DocDisposed = True + oLocale = GetStarOfficeLocale() + InitializeConverter(oLocale, 2) + DialogConvert.Execute + End If +End Sub + + +Sub ConvertDocuments() +Dim FilesList() +Msgbox DialogModel.lblSource.Label + Source = AssignFileName(DialogModel.txtSource.Text, DialogModel.lblSource.Label, True) + TargetDir = AssignFileName(DialogModel.txtTarget.Text, DialogModel.lblTarget.Label, False) + If Source <> "" And TargetDir <> "" Then + bRecursive = DialogModel.chkRecursive.State = 1 + InitializeThirdStep() + If DialogModel.optSingleFile.State = 1 Then + SourceFile = Source + TotDocCount = 1 + Else + SourceDir = Source + TargetStemDir = TargetDir + FilesList() = ReadDirectories(SourceDir, bRecursive, True, False, FilterList()) + TotDocCount = CInt(FilesList(0,0)) + End If + InitializeProgressPage(DialogModel) +' ChangeToNextProgressStep() + sTotDocCount = CStr(TotDocCount) + For DocIndex = 1 To TotDocCount + If InitializeDocument(FilesList()) Then + ConvertDocument() + DocDisposed = StoreDocument() + End If + Next DocIndex + If GoOn Then + Msgbox (sMsgREADY,64, sMsgDLGTITLE) + End If + End If +End Sub + + +Function InitializeDocument(FilesList()) as Boolean +Dim sViewPath as String +Dim oLocDocument as Object +Dim oSecDocument as Object + ' The Autopilot is started from step No. 2 + If DialogModel.optWholeDir.State = 1 Then + SourceFile = FilesList(DocIndex,0) + TargetFile = ReplaceString(SourceFile,TargetStemDir,SourceDir) + TargetDir = DirectorynameoutofPath(TargetFile, "/") + Else + SourceFile = Source + TargetFile = TargetDir & "/" & FileNameoutofPath(SourceFile, "/") + End If + + If Not oUcb.Exists(TargetDir) Then + oUcb.CreateFolder(TargetDir) + End If + oLocDocument = OpenDocument(SourceFile, NoArgs(), StarDesktop) + Set oSecDocument = PrepareForEditing(oLocDocument) + If Not IsNull(oDocument) Then + DoUnProtect = -6 * Int(DialogModel.chkProtect.State = 1) + RetrieveDocumentObjects() + sViewPath = CutPathView(SourceFile, 60) + DialogModel.LabelCurDocument.Label = Str(DocIndex) & "/" & sTotDocCount & " (" & sViewPath & ")" + InitializeDocument() = True + Else + InitializeDocument() = False + End If +End Function + + +Sub ChangeToNextProgressStep() + DialogModel.LabelCurProgress.FontBold = False + DialogModel.LabelCurProgress.Visible = False + DialogModel.LabelCurProgress.Visible = True + DialogModel.cmdBack.Enabled = True +End Sub + + +Function StoreDocument() + If TargetFile <> "" Then + On Local Error Goto NOSAVING + If TargetFile <> SourceFile Then + oDocument.StoreToUrl(TargetFile,NoArgs) + Else + oDocument.Store + End If + oDocument.Dispose() + StoreDocument() = True + NOSAVING: + If Err <> 0 Then + StoreDocument() = False + Resume CLERROR + End If + CLERROR: + End If +End Function + + +Sub SwapExtent() + DialogModel.chkRecursive.Enabled = DialogModel.optWholeDir.State = 1 + If DialogModel.optWholeDir.State = 1 Then + DialogModel.lblSource.Label = sSOURCEDIR '"Quellverzeichnis:" + If Not IsNull(SubstFile) Then + SubstFile = DialogModel.txtSource.Text + DialogModel.txtSource.Text = SubstDir + End If + Else + DialogModel.LblSource.Label = sSOURCEFILE '"Quelldatei:" + If Not IsNull(SubstDir) Then + SubstDir = DialogModel.txtSource.Text + DialogModel.txtSource.Text = SubstFile + End If + End If +End Sub + + + +Sub SourceSearchDialog() + If DialogModel.optWholeDir.State = 1 Then + 'Konvertierung eines gesamten Verzeichnisses + Source = Application.FileDialog( "P", sMsgSELDIR, DialogModel.txtSource.Text ) ' "Wählen Sie ein Verzeichnis" + Else + Source = Application.FileDialog( "O", sMsgSELFILE, DialogModel.txtSource.Text ) ' "Wählen Sie eine Datei" + End If + DialogModel.txtSource.Text = AssignFileName(Source, DialogModel.LblSource.Label,True) +End Sub + + + +Sub TargetDirectorySearchDialog() + TargetDir = Application.FileDialog( "P", sMsgTARGETDIR, DialogModel.txtTarget.Text ) + DialogModel.txtTarget.Text = AssignFileName(TargetDir, DialogModel.LblTarget.Label,False) +End Sub + + +Function AssignFileName(sPath as String, ByVal HeaderString, bCheckFileType as Boolean) as String +Dim bIsValid as Boolean +Dim sLocMimeType as String +Dim sNoDirMessage as String + HeaderString = DeleteStr(HeaderString, ":") + sPath = ConvertToUrl(Trim(sPath)) + bIsValid = oUcb.Exists(sPath) + If bIsValid Then + If DialogModel.optSingleFile.State = 1 Then + If bCheckFileType Then + sLocMimeType = GetRealFileContent(oDocInfo, sPath) + If Instr(1, sLocMimeType, "calc") = 0 Then + Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE) + bIsValid = False + End If + End If + Else + If Not oUcb.IsFolder(sPath) Then + sNoDirMessage = ReplaceString(sMsgNODIRECTORY,sPath,"<1>") + Msgbox(sNoDirMessage,48, sMsgDLGTITLE) + bIsValid = False + Else + sPath = RTrimStr(sPath,"/") + sPath = sPath & "/" + End If + End if + Else + Msgbox(HeaderString & " '" & sPath & "' " & sMsgNOTTHERE,48, sMsgDLGTITLE) + End If + If bIsValid Then + AssignFileName() = sPath + Else + AssignFilename() = "" + End If +End Function + + + +Function UnprotectSheet(oListSheet as Object) +Dim PWIsCorrect as Boolean +'Dim Password as String +Dim QueryText as String +Dim ListSheetName as String +Dim OldDoUnprotect as Integer +Dim sStatustext as String + ListSheetName = oListSheet.Name + If oListSheet.IsProtected Then + OldDoUnprotect = DoUnprotect + If DoUnprotect = 0 Then + ' At First query if sheets shall generally be unprotected + DoUnprotect = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE) + End If + If DoUnprotect = 6 Then + 'the answer is yes... + ' Try to unprotect the sheet without a Password + oListSheet.Unprotect("") + If oListSheet.IsProtected Then + ' Sheet is protected by a Password + oDocument.CurrentController.SetActiveSheet(oListSheet) + + QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1") + '"Geben Sie das Kennwort zum Entschützen der Tabelle '" & ListSheetName & " ein:'" + Do + InitializePasswordDialog() + If bCancelProtection Then + bCancelProtection = False + Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) + UnprotectSheet = False '"Tabelle wird nicht entschützt!" + exit Function + End If + oListSheet.Unprotect(Password) + If oListSheet.IsProtected Then + PWIsCorrect = False + Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE) + Else + ' Sheet could be unprotected + AddSheettoUnprotectionlist(ListSheetName,Password) + PWIsCorrect = True + End If + Loop Until PWIsCorrect + UnProtectSheet = True + Else + ' The Sheet could be unprotected without a password + AddSheettoUnprotectionlist(ListSheetName,"") + UnprotectSheet = True + End If + Else + ' The Answer is 'No' (Tables shall not be unprotected) + If OldDoUnprotect = 0 Then + Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) + End If '"Tabellen werden nicht entschützt!" + Unprotectsheet = False + End If + Else + UnprotectSheet = True + End If +End Function + + +Sub InitializePasswordDialog() + With DialogPW + .Load + .Label = QueryText + .frmSelection.Label = sMsgPASSWORD + .cmdOK.Label = sMsgOK + .cmdCancel.Label = sMsgCANCEL + .cmdHelp.Label = sHELP + .Show + End With +End Sub + +Sub ReadPassword() + Password = DialogPW.TextBox1.Text + DialogPW.Unload +End Sub + + +Sub RejectPassword() + bCancelProtection = True + DialogPW.Unload +End Sub + + +' Reprotects the previousliy protected sheets +' The passwordinformation is stored in the List 'UnProtectList()' +Sub ReprotectSheets() +Dim i as Integer +Dim oProtectSheet as Object + If Val(UnProtectList(0,0)) > 0 Then +' oStatusline.SetText(sStsREPROTECT) + For i = 1 To Val(UnProtectList(0,0)) + oProtectSheet = oSheets.GetbyName(UnProtectList(i,0) + If Not oProtectSheet.IsProtected Then + oProtectSheet.Protect(UnProtectList(i,1)) + End If + UnprotectList(i,0) = "" + UnprotectList(i,1) = "" + Next i + End If + UnprotectList(0,0) = "" +End Sub + + +' Add a Sheet to the list of sheets that finally have to be +' unprotected +Sub AddSheettoUnprotectionlist(ListSheetName,Password) + UnprotectList(Int(UnProtectList(0,0))+ 1,0) = ListSheetName + UnprotectList(Int(UnProtectList(0,0))+ 1,1) = Password + ' The first Field contains the highest Index of the list + ' and therefor has to be incremented + UnprotectList(0,0) = Str(Val(UnProtectList(0,0)) + 1) +End Sub + + +Sub HelperDialog() +'Todo: The String "start" can be replaced by a HelpIndex + StarDesktop.LoadComponentfromUrl("vnd.sun.star.help://" & sDocType & "/start", "_OFFICE_HELP", 64, NoArgs()) +End Sub + + +Sub InitializeThirdStep() +Dim TextBoxText as String + DialogModel.lblCurrencies.Visible = False + DialogModel.lstCurrencies.Visible = False + DialogModel.cmdBack.Label = sBACK + DialogModel.LabelRetrieval.FontBold = True + DialogModel.LabelRetrieval.Label = sPrgsRETRIEVAL + DialogModel.LabelCurProgress.Label = sPrgsCONVERTING + DialogModel.cmdGoOn.Visible = False + DialogModel.Step = 3 + If DialogModel.optWholeDir.State = 1 Then + TextBoxText = sSOURCEDIR & " " & Source & chr(13) '& " " + If DialogModel.chkRecursive.State = 1 Then + TextBoxText = TextBoxText & DeleteStr(sSUBDIR,"&") & chr(13)' & " " + End If + Else + TextBoxText = sSOURCEFILE & " " & Source & chr(13) '& " " + End If + TextBoxText = TextBoxText & sTARGETDIR & " " & TargetDir & chr(13)' & " " + If DialogModel.chkProtect.State = 1 Then + TextBoxText = TextboxText & sPrgsUNPROTECT + End If + DialogModel.TextBoxConfig.Text = TextBoxText + DialogModel.cmdBack.Visible = True +End Sub + + +Sub SwitchBack() + DialogModel.Step = 2 + DialogModel.lblCurrencies.Visible = True + DialogModel.lstCurrencies.Visible = True + DialogModel.cmdBack.Visible = False + DialogModel.cmdGoOn.Visible = True +End Sub + + +Sub EnableStep2DialogControls(OnValue as Boolean) + DialogModel.frmExtent.Enabled = OnValue + DialogModel.optWholeDir.Enabled = OnValue + DialogModel.optSingleFile.Enabled = OnValue + DialogModel.chkProtect.Enabled = OnValue + DialogModel.cmdCallSourceDialog.Enabled = False + DialogModel.cmdCallTargetDialog.Enabled = False + DialogModel.lblSource.Enabled = OnValue + DialogModel.lblTarget.Enabled = OnValue + DialogModel.txtSource.Enabled = OnValue + DialogModel.txtTarget.Enabled = OnValue +' DialogModel.Preview1.Enabled = OnValue + DialogModel.lstCurrencies.Enabled = OnValue + DialogModel.lblCurrencies.Enabled = OnValue + If OnValue Then + DialogModel.cmdGoOn.Enabled = Ubound(DialogModel.lstCurrencies.SelectedItems()) > -1 + DialogModel.chkRecursive.Enabled = DialogModel.optWholeDir.State = 1 + Else + DialogModel.cmdGoOn.Enabled = False + DialogModel.chkRecursive.Enabled = False + End If +End Sub + + +Sub InitializeProgressPage() + DialogModel.LabelRetrieval.Visible = False + DialogModel.LabelCurProgress.Visible = False + DialogModel.LabelRetrieval.FontBold = False + DialogModel.LabelCurProgress.FontBold = True + DialogModel.LabelRetrieval.Visible = True + DialogModel.LabelCurProgress.Visible = True +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/euro/Common.xba b/wizards/source/euro/Common.xba new file mode 100644 index 000000000..319008bf9 --- /dev/null +++ b/wizards/source/euro/Common.xba @@ -0,0 +1,243 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Common" script:language="StarBasic">REM ***** BASIC ***** +Public DialogModel as Object +Public DialogConvert as Object + + +Sub RetrieveDocumentObjects() + oSheets = oDocument.Sheets + oSheet = oDocument.Sheets.GetbyIndex(0) + oStatusline = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator + ' Retrieve the indices for the cellformatations + oFormats = oDocument.NumberFormats + oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") +End Sub + + +Sub CloseDialog +Dim n, m as Integer + If Not bMacroStopped Then + ' Die Zuordnungstabelle löschen + If Not IsNull(oStyles) Then + Redim StyleRangeAssignmentList(20,50)as String + End If + + ReDim RangeList(100) as String + ReDim SelRangeList(100) as String + Redim RangeBools(100) as Boolean + ReDim RemoveList(100) as String + ClearArray(ListboxItems()) + ' Prevent That this Procedure is called again the second time + ' by the Unload Event of the dialog + bMacroStopped = True + DialogConvert.EndExecute + If Not DocDisposed Then + ReprotectSheets() + End If + Stop + End If +End Sub + + +Function ConvertDocument() +Dim i, a as integer +Dim CurStylename as String +Dim DummyList(100) as String +Dim RangeName as String +Dim oDummySheet as Object +Dim AddRange as Boolean + GoOn = True + DocDisposed = True + CurCellCount = 0 + StatusValue = 0 + AddRange = True + + oStatusline.Start(sStsPROGRESS,100) '"Konvertierungsfortschritt:" + StatusValue = 0 + If Not bRangeListDefined Then + TotCellCount = 0 + CreateRangeEnumeration(True) + Else + IncreaseStatusvalue(SBRelGet/3) + End If + ' Check protected Areas + a = 1 + i = 0 + For i = 1 To Val(RangeList(0)) + RangeName = RangeList(i) + If Rangename <> "" Then + oDummySheet = RetrieveSheetoutofRangeName(RangeName) + + ' Unprotect the sheet if necessary + AddRange = UnprotectSheet(oDummySheet) + If AddRange Then +' Todo: Umschreiben mit Redim RangeList(RangeIndex) Preserve + DummyList(a) = RangeName + DummyList(0) = Str(a) + a = a + 1 + Else + Exit For + End If + End If + Next + If AddRange Then + RangeIndex = Val(DummyList(0)) + Dim LocRangeList(RangeIndex-1) as String + Dim LocRangeBools(RangeIndex) as String + For i = 0 To RangeIndex + LocRangeList(i-1 ) = DummyList(i) + LocRangeBools(i-1) = True + Next i + ConvertThehardWay(LocRangeList(), LocRangeBools(), True, True) + MakeStyleEnumeration(True) + oDocument.calculateAll() + End If + ReprotectSheets() + oStatusline.End + bRangeListDefined = False + ConvertDocument = AddRange + On Local Error Goto 0 +End Function + + +Sub SwitchNumberFormat(oObject as Object, oFormats as object, sNewSymbol as String) +Dim nFormatLanguage as Integer +Dim nFormatDecimals as Integer +Dim nFormatLeading as Integer +Dim bFormatLeading as Integer +Dim bFormatNegRed as Integer +Dim bFormatThousands as Integer +Dim i as Integer +Dim aNewStr as String +Dim iNumberFormat as Long +Dim AddToList as Boolean + + ' Numberformat mit dem neuen Symbol als Basis für generateFormat + aSimpleStr = "0 [$"+sNewSymbol+"]" + nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale) + On Local Error Resume Next + iNumberFormat = oObject.NumberFormat + If Err <> 0 Then + Msgbox "Error Reading the Number Format" + Resume CLERROR + End If + + On Local Error GoTo NOKEY + aFormat() = oFormats.getByKey(iNumberFormat) + On Local Error GoTo 0 + ' Typ und Währungssymbol des Numberformats heraussuchen + ' neues Währungsformat mit passenden Einstellungen setzen + nFormatDecimals = aFormat.Decimals + nFormatLeading = aFormat.LeadingZeros + bFormatNegRed = aFormat.NegativeRed + bFormatThousands = aFormat.ThousandsSeparator + oLocale = aFormat.Locale + aNewStr = oFormats.generateFormat( nSimpleKey, oLocale, _ + bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading) + oObject.NumberFormat = Numberformat(oFormats, aNewStr, oLocale) + NOKEY: + If Err <> 0 Then + Resume CLERROR + End If + CLERROR: +End Sub + + +Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Variant ) +Dim nRetkey + nRetKey = oFormats.queryKey( aFormatStr, oLocale, True ) + If nRetKey = -1 Then + nRetKey = oFormats.addNew( aFormatStr, oLocale ) + If nRetKey = -1 Then nRetKey = 0 + End If + Numberformat = nRetKey +End Function + + +Sub RepaintEuroPreview() +Dim Twip as integer +Dim Bitmap As Object +Dim CurStep as Integer +Dim PicturePath as String + Twip = 425 +' TODO: Einbinden der Twip-Konstanten + CurStep = DialogModel.Step + Picturepath = BitmapDir & "euro_" & CurStep & ".bmp" +' Msgbox PicturePath + Set Bitmap = LoadPicture(PicturePath) + DialogConvert.Preview1.DrawPicture(Bitmap,20,20,6820,760) +End Sub + + +' Funktion findet den Formattyp einer Vorlage, Zelle oder eines Bereiches heraus und schreibt das Ergebnis +' in die globale Variable nFormatType; Ist ein Währungssymbol gesetzt, wird dieses in den globalen String +' sFormatCurrency geschrieben. +Function CheckFormatType( FormatObject as object) +Dim i as Integer +Dim LocCurrIndex as Integer +Dim nFormatFormatString as String +Dim FormatLangID as Integer +Dim sFormatCurrExt as String +Dim oFormatofObject() as Object + + ' Retrieve the Format of the Object + On Local Error GoTo NOKEY + oFormatofObject = oFormats.getByKey(FormatObject.NumberFormat) + On Local Error GoTo 0 + ' Typ und Währungssymbol des Numberformats heraussuchen + If NOT INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Then + CheckFormatType = False + Exit Function + End If + + If FieldinArray(CurrSymbolList(),2,oFormatofObject.CurrencySymbol) Then + ' If the Currencysymbol of the object ist the one needed, then check the Currency extension + sFormatCurrExt = oFormatofObject.CurrencyExtension + + If FieldInList(CurExtension(),1,sFormatCurrExt) Then + ' The Currency - extension also fits + CheckFormatType = True + Else + ' The Currency - symbol is Euro-conforming (like 'DEM'), so there is no Currency-Extension + CheckFormatType = oFormatofObject.CurrencySymbol = CurrsymbolList(2) + End If + Else + ' The Currency Symbol of the object is not the desired one + If oFormatofObject.CurrencySymbol = "" Then + ' Format is "automatic" + CheckFormatType = CheckLocale(oFormatofObject.Locale) + Else + CheckFormatType = False + End If + End If + + NOKEY: + If Err <> 0 Then + CheckFormatType = False + Resume CLERROR + End If + CLERROR: +End Function + + +Sub StartConversion() + GoOn = True +' ToggleWindow(False) + If DialogModel.Step = 2 Then + ConvertDocuments() + Else + If DialogModel.chkComplete.State = 1Then + ConvertWholeDocument() + Else + ConvertRangesorStylesofDocument() + End If + End If +' ToggleWindow(True) +End Sub + + +Sub IncreaseStatusValue(AddStatusValue as Integer) + StatusValue = Int(StatusValue + AddStatusValue) + oStatusline.SetValue(StatusValue) +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/euro/ConvertRun.xba b/wizards/source/euro/ConvertRun.xba new file mode 100644 index 000000000..0df2eed92 --- /dev/null +++ b/wizards/source/euro/ConvertRun.xba @@ -0,0 +1,408 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ConvertRun" script:language="StarBasic">Option Explicit +' Todo Den Bug mit der Statuszeilengeschichte überprüfen +' Todo Vorselektion der Listbox +' Mauspointer umschalten: + +' Todo: Sinnigkeit von 'DocDisposed' noch einmal überprüfen + +Sub Main() + LoadLibrary("tools") + If InitResources("Euro Converter", "eur") Then + DoUnProtect = 0 + bPreSelected = True + DocDisposed = False + oDocument = StarDesktop.CurrentFrame.Controller.Model + RetrieveDocumentObjects() ' Statusline, SheetsCollection etc. + InitializeConverter(oDocument.CharLocale, 1) + GetPreSelectedRange() + If GoOn Then + DialogConvert.Execute + Else + DialogConvert.Dispose + End If + End If +End Sub + + +Sub SelectListItem() +Dim Listbox as Object +Dim oListSheet as Object +Dim AddRange as Boolean +Dim CurStyleName as String +Dim oCursheet as Object +Dim oTempRanges as Object +Dim sCurSheetName as String +Dim RangeName as String +Dim oSheetRanges as Object +Dim ListIndex as Integer +Dim a as Integer +Dim s as Integer +Dim i as Integer +Dim n as Integer +Dim m as Integer +Dim AddStyle as Boolean + Listbox = DialogModel.lstSelection + If Ubound(Listbox.SelectedItems()) > -1 Then +' ToggleWindow(False) + EnableStep1DialogControls(False, False, False) + oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + + ' Is the sheet the basis, then the sheetobject has to be created + If DialogModel.optDocRanges.State= 1 Then + ' Document is the basis for the conversion + ListIndex = Listbox.SelectedItems(0) + oCurSheet = RetrieveSheetoutofRangeName(ListIndex) + oDocument.CurrentController.SetActiveSheet(oCurSheet) + Else + oCurSheet = oDocument.CurrentController.ActiveSheet + End If + sCurSheetName = oCurSheet.Name + AddStyle = True + If DialogModel.optCellTemplates.State = 1 Then + 'Soft formatation is selected + For s = 0 To oSheets.Count-1 + If oSheets.GetbyIndex(s).IsProtected Then + AddStyle = UnprotectSheet(oSheets.GetbyIndex(s)) + If Not AddStyle Then + Exit For + End If + End If + Next s + If AddStyle Then + Dim CurIndex as Integer + For i = 0 To Ubound(Listbox.SelectedItems()) + CurIndex = Listbox.SelectedItems(i) + CurStylename = Listbox.StringItemList(CurIndex) + oSheetRanges = oCursheet.CellFormatRanges.createEnumeration + While oSheetRanges.hasMoreElements + oRange = oSheetRanges.NextElement + If oRange.getPropertyState("NumberFormat") = 1 Then + If oRange.CellStyle = CurStyleName Then + oSelRanges.InsertbyName("",oRange) + End If + End If + Wend + Next i + Else + EmptyListbox(Listbox) + End If + Else + a = 1 + ' Hard Formatation is selected + For n = 0 To Ubound(Listbox.SelectedItems()) + m = Listbox.SelectedItems(n) + RangeName = Listbox.StringItemList(m) + oListSheet = RetrieveSheetoutofRangeName(RangeName) + AddRange = UnprotectSheet(oListSheet) +' Todo: Klären wie das am besten geht! + If Not AddRange Then + DeselectListboxItem(Listbox, n) + Else + SelRangeList(a) = RangeName + SelRangeList(0) = Str(a) + a = a + 1 + If oListSheet.Name = sCurSheetName Then + oRange = RetrieveRangeoutofRangeName(RangeName) + oSelRanges.InsertbyName("",oRange) + End If + End If + Next n + End If + oDocument.CurrentController.Select(oSelRanges) + EnableStep1DialogControls(True, True, True) +' ToggleWindow(True) + End If +End Sub + + +' Prozedur that is called by an event +Sub RetrieveEnableValue() +Dim EnableValue as Boolean + EnableValue = Not DialogModel.lstSelection.Enabled + EnableStep1DialogControls(True, EnableValue, True) +End Sub + + +Sub EnableStep1DialogControls(bCurrEnabled as Boolean, bFrameEnabled as Boolean, bButtonsEnabled as Boolean) +Dim bNoComboSelection as Boolean +Dim bNoLBSelection as Boolean + ' Controls around the Currency-Listbox + DialogModel.lblCurrencies.Enabled = bCurrEnabled + DialogModel.lstCurrencies.Enabled = bCurrEnabled + + DialogModel.lstSelection.Enabled = bFrameEnabled + DialogModel.lblSelection.Enabled = bFrameEnabled + DialogModel.frmSelection.Enabled = bFrameEnabled + DialogModel.optCellTemplates.Enabled = bFrameEnabled + DialogModel.optSheetRanges.Enabled = bFrameEnabled + DialogModel.optDocRanges.Enabled = bFrameEnabled + DialogModel.optSelRange.Enabled = bFrameEnabled + + ' The CheckBox has the Value 'True' when the Controls in the Frame are disabled + If bButtonsEnabled Then + bNoComboSelection = Ubound(DialogModel.lstCurrencies.SelectedItems()) = -1 + ' Enable GoOnButton only when Currency is selected + DialogModel.cmdGoOn.Enabled = Not bNoComboSelection + DialogModel.chkComplete.Enabled = Not bNoComboSelection + If bFrameEnabled AND Not DialogModel.chkComplete.State = 1 AND DialogModel.cmdGoOn.Enabled Then + ' If FrameControls are enabled, check if Listbox is Empty + bNoLBSelection = Ubound(DialogModel.lstSelection.SelectedItems()) = -1 + DialogModel.cmdGoOn.Enabled = NOT bNoLBSelection + End If + Else + DialogModel.cmdGoOn.Enabled = False + DialogModel.chkComplete.Enabled = False + End If +End Sub + + +Sub ConvertRangesOrStylesOfDocument() +Dim i as Integer +Dim Listbox as Object +Dim ItemName as String +Dim ThisList() as String +Dim ThisSel() as Boolean + + ' Variable, in der der aktuelle Stand der Fortschrittsleiste angzeigt wird + CurCellCount = 0 + Listbox = DialogModel.lstSelection + EnableStep1DialogControls(False, False, False) + + oStatusline.Start(sStsPROGRESS,100) ' "Konvertierungsfortschritt:" + StatusValue = 0 + If DialogModel.optSelRange.State = 1 Then + SelectListItem() + End If + ThisSel() = GetSelectedListboxItems(Listbox) + ThisList() = Listbox.StringItemList() + If DialogModel.optCellTemplates.State <> 1 Then + ' Option 'Hard Formatation is selected + SelectRange() + ConverttheHardWay(ThisList(), ThisSel(), False, False) + Else + ' Option 'Soft' Formatation is selected + AssignRangestoStyle(ThisList(), ThisSel()) + ConverttheSoftWay(ThisList(), ThisSel(), False) + End If + oStatusline.End + i = 0 + ' Todo: Dieses Array vorab neu dimensionieren und in For - Schleife abarbeiten + While RemoveList(i) <> "" + ItemName = RemoveList(i) + RemoveItemfromListbox(Listbox, ItemName) + i = i + 1 + Wend + EnableStep1DialogControls(True, False, True) + DialogModel.cmdGoOn.Enabled = True + oDocument.CurrentController.Select(oSelRanges) +End Sub + + +Sub ConvertWholeDocument() +Dim s as Integer + DialogModel.cmdGoOn.Enabled = False + DialogModel.chkComplete.Enabled = False + GoOn = ConvertDocument() + If Ubound(DialogModel.lstSelection.StringItemList()) > -1 AND GoOn Then + EmptyListbox(DialogModel.lstSelection()) + EnableStep1DialogControls(True, True, True) + Else + ' The next time ask for unprotection again + DoUnprotect = 0 + DialogModel.cmdGoOn.Enabled = True + DialogModel.chkComplete.Enabled = True + End If +End Sub + + +Sub SelectCurrency() +Dim AddtoList as Boolean +Dim UpRangeList as Integer +Dim OldCurrIndex as Integer + OldCurrIndex = CurrIndex + CurrIndex = DialogModel.lstCurrencies.SelectedItems(0) + InitializeCurrencyValues(CurrIndex) + CurExtension(0) = LangIDValue(CurrIndex,0,2) + CurExtension(1) = LangIDValue(CurrIndex,1,2) + If DialogModel.Step = 1 Then + If OldCurrIndex = -1 Then + DialogModel.chkComplete.State = 1 + EnableStep1DialogControls(True,False, True) + SetOptionValuestoNull() + Else + EnableStep1DialogControls(False,False, False) + If DialogModel.optCellTemplates.State = 1 Then + EnableStep1DialogControls(False, False, False) + CreateStyleEnumeration() + EnableStep1DialogControls(True, True, True) + ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then + UpRangeList = UBound(RangeList()) + ReDim RangeList(UpRangeList) 'as String + CreateRangeEnumeration(False) + ElseIf DialogModel.optSelRange.State= 1 Then + 'Preselected Range + CheckRangeSelection() + End If + EnableStep1DialogControls(True, True, True) + End If + ElseIf DialogModel.Step = 2 Then + EnableStep2DialogControls(True) + End If +End Sub + + + +Sub FillUpCurrencyListbox() +Dim i as Integer +Dim MaxIndex as Integer + MaxIndex = Ubound(CurrValue(),1) + Dim LocList(MaxIndex) as String + For i = 0 To MaxIndex + LocList(i) = CurrValue(i,0) + Next i + DialogModel.lstCurrencies.StringItemList() = LocList() + If CurrIndex > -1 Then + SelectListboxItem(DialogModel.lstCurrencies, CurrIndex) + End If +End Sub + + +' Alles was selektiert wurde wird deselektiert +Sub EmptySelection() +Dim RangeName as String +Dim i, MaxIndex as Integer +Dim EmptySelRangeList(30) as String + + If Not IsNull(oSelRanges) Then + If oSelRanges.HasElements Then + EmptySelRangeList() = ArrayOutofString(oSelRanges.RangeAddressesasString, ";", MaxIndex) + i = 0 + Do + If EmptySelRangeList(i) <> "" Then + oSelRanges.RemovebyName(EmptySelRangeList(i)) + i = i + 1 + End If + Loop Until EmptySelRangeList(i) = "" + End If + oDocument.CurrentController.Select(oSelRanges) + Else + oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + End If +End Sub + + +Sub AddSelectedRangeToSelRangesEnum() + osheet = oDocument.CurrentController.GetActiveSheet + oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + ' Check if a Currency-Range has been selected + oRange = oDocument.CurrentController.Selection + oSelRanges.InsertbyName("",oRange) +End Sub + + +Sub GetPreSelectedRange() +Dim i as Integer +Dim OldCurrSymbolList(2) as String +Dim OldCurrIndex as Integer +Dim OldCurExtension(1) as String + AddSelectedRangeToSelRangesEnum() + bPreSelected = CheckIfRangeisCurrency(oRange) + If bPreSelected Then +' Todo: Array als ganzes übergeben! + OldCurrSymbolList() = CurrSymbolList() + OldCurExtension() = CurExtension() + OldCurrIndex = CurrIndex + For i = 0 To 10 + CurrIndex = i + CurExtension(0) = LangIDValue(CurrIndex,0,2) + CurExtension(1) = LangIDValue(CurrIndex,1,2) + InitializeCurrencyValues(CurrIndex) + bPreSelected = CheckFormatType(oRange) + If bPreSelected Then + Exit For + End If + Next i + If Not bPreSelected Then + CurrIndex = OldCurrIndex + CurrSymbolList() = OldCurrSymbolList() + CurExtension() = OldCurExtension() + End If + End If + + If CurrIndex > -1 Then + If bPreSelected Then + DialogModel.optSelRange.State = 1 + AddRangeToListbox() + Else + DialogModel.optCellTemplates.State = 1 + CreateStyleEnumeration() + End If + End If + EnableStep1DialogControls(True, bPreSelected, True) +' Todo: auf Integer umstellen + DialogModel.chkComplete.State = Not bPreSelected + DialogModel.optSelRange.Enabled = bPreSelected +End Sub + + +Sub AddRangeToListbox() + EmptyListBox(DialogModel.lstSelection) + ' Den Namen der Range ermitteln und in ein Array packen + PreName = RetrieveRangeNamefromAddress(oRange.RangeAddress, oSheet.Name) + AddSingleItemToListbox(DialogModel.lstSelection, Prename)', 0) + SelectListboxItem(DialogModel.lstCurrencies, CurrIndex) + TotCellCount = CountRangeCells(oRange) +End Sub + + +Sub CheckRangeSelection(Optional oEvent) +' Todo: Beim Startup werden die folgenden zwei Zeilen doppelt ausgeführt + AddSelectedRangeToSelRangesEnum() + bPreSelected = CheckFormatType(oRange) + If bPreSelected Then + AddRangeToListbox() + End If +End Sub + + +' Checks if a Field (LocField) is already defined in an Array +' Returns 'True' or 'False' +Function FieldinList(LocList(), MaxIndex as integer, ByVal LocField ) As Boolean +Dim i as integer + LocField = Ucase(LocField) + For i = Lbound(LocList()) to MaxIndex + If Ucase(LocList(i)) = LocField then + FieldInList = True + Exit Function + End if + Next + FieldInList = False +End Function + + +Function CheckLocale(oLocale) as Boolean +Dim i as Integer +Dim LocCountry as String +Dim LocLanguage as String + LocCountry = oLocale.Country + LocLanguage = oLocale.Language + For i = 0 To 1 + If LocLanguage = LangIDValue(CurrIndex,i,0) AND LocCountry = LangIDValue(CurrIndex,i,1) Then + CheckLocale = True + Exit Function + End If + Next i + CheckLocale = False +End Function + + +Sub SetOptionValuestoNull() + DialogModel.optCellTemplates.State = 0 + DialogModel.optSheetRanges.State = 0 + DialogModel.optDocRanges.State = 0 + DialogModel.optSelRange.State = 0 +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/euro/Hard.xba b/wizards/source/euro/Hard.xba new file mode 100644 index 000000000..0bda715d9 --- /dev/null +++ b/wizards/source/euro/Hard.xba @@ -0,0 +1,259 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Hard" script:language="StarBasic">REM ***** BASIC ***** +Option Explicit +'ToDo: Währung wechseln und dann sehen, ob die Listbox mit den neuen Ranges aufgefrischt wird + + +Sub CreateRangeList() +Dim MaxIndex as Integer + EnableStep1DialogControls(False, False, False) + EmptySelection() + DialogModel.lblSelection.Label = sCURRRANGES '"Währungsbereiche:" + EmptyListbox(DialogModel.lstSelection) + Msgbox DialogModel.optCellTemplates.State + oDocument.CurrentController.Select(oSelRanges) + If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State <> 1) Then + ' Ist das Sheet Grundlage für die Bearbeitung? + oStatusline.SetText(sStsRELRANGES) '"Erfassung der relevanten Bereiche..." + osheet = oDocument.CurrentController.GetActiveSheet + oRanges = osheet.CellFormatRanges.createEnumeration() + MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False) + Else + CreateRangeEnumeration(False) + bRangeListDefined = True + End If + EnableStep1DialogControls(True, True, True) + oStatusline.SetText("") +End Sub + + +Sub CreateRangeEnumeration(bAutopilot as Boolean) +Dim i, MaxIndex as integer +Dim sStatustext as String + MaxIndex = 0 + ' oder das Dokument - dann müsssen alle Sheets abgearbeitet werden + If Not bRangeListDefined Then + ' Die Ranges sind noch nicht definiert + oSheets = oDocument.Sheets + For i = 0 To oSheets.Count-1 + oSheet = oSheets.GetbyIndex(i) + If bAutopilot Then + IncreaseStatusValue(SBRELGET/osheets.Count) + Else + sStatustext = ReplaceString(sStsRELSHEETRANGES,Str(i+1),"%1Number%1") + sStatustext = ReplaceString(sStatusText,oSheets.Count,"%2TotPageCount%2") + oStatusline.SetText(sStatusText) + End If + oRanges = osheet.CellFormatRanges.createEnumeration + RangeList(0) = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot) + Next i + Else + oStatusline.SetText(sStsRELRANGES) '"Erfassung der relevanten Bereiche..." + ' Die Ranges sind schon definiert + For I = 0 To CInt(RangeList(0)) + If RangeList(i) <> "" AND RangeBools(i) = True Then + If Not bAutoPilot Then + AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i)) + End If + End If + Next + End If + Rangeindex = MaxIndex +End Sub + + + +Function AddSheetRanges(oRanges as Object, r as Integer, oSheet as Object, bAutopilot) +Dim RangeName as String +Dim AddtoList as Boolean +Dim iCurStep as Integer + iCurStep = DialogModel.Step + While oRanges.hasMoreElements + oRange = oRanges.NextElement + AddToList = CheckFormatType(oRange) + If AddToList Then + ' Den Namen der Range ermitteln und in ein Array packen + RangeName = RetrieveRangeNamefromAddress(oRange.RangeAddress, oSheet.Name) + TotCellCount = TotCellCount + CountRangeCells(oRange) + If Not bAutoPilot Then + AddSingleItemToListbox(DialogModel.lstSelection, RangeName) + End If + ' The Ranges are only passed to an Array when the whole Document is the basis + r = r + 1 + RangeList(r) = RangeName + RangeBools(r) = True + End If + Wend + AddSheetRanges = r +End Function + + + +' Fügt einen Bereich zur selektierten Kollektion hinzu +Sub SelectRange() +Dim i, a, s as Integer +Dim Listbox as Object +Dim RangeName as String +Dim SelItem as String +Dim LocRangeList(100) as String +Dim CurRange as String +Dim SheetRangeName as String +Dim DescriptionList(1) as String +Dim MaxRangeIndex, StatusValue as Integer + + StatusValue = 0 + MaxRangeIndex = Val(SelRangeList(0)) + Listbox = DialogModel.lstSelection + a = 0 + CurSheetName = oSheet.Name + For i = 1 To MaxRangeIndex + SelItem = SelRangeList(i) + ' Is the Range already included in the collection? + oRange = RetrieveRangeoutOfRangename(SelItem) + TotCellCount = TotCellCount + CountRangeCells(oRange) + LocRangeList(a) = SelItem + a = a + 1 + ' Der Listboxeintrag ist frisch selektiert worden und muß der Range - Kollektion + ' hinzugefügt werden + DescriptionList() = ArrayOutofString(SelItem,".",1) + SheetRangeName = DeleteStr(DescriptionList(0),"'") + If SheetRangeName = CurSheetName Then + oSelRanges.InsertbyName("",oRange) + End If + IncreaseStatusValue(SBRELGET/MaxRangeIndex) + Next i + + ' Das Array mit den selektierten Listboxeinträgen aktualisieren + ClearArray(ListboxItems()) + For s = 0 To a - 1 + CurRange = LocRangeList(s) + ListboxItems(s) = CurRange + Next s +End Sub + + +Sub ConvertThehardWay(ListboxList(), ThisSel(), SwitchFormat as Boolean, bAutopilot as Boolean) +Dim i, a, r as Integer +Dim AddCells as Long +Dim OldStatusValue as Single +Dim RangeName as String +Dim LastIndex as Integer + + Lastindex = Ubound(ListboxList()) + If TotCellCount > 0 Then + ' Index für die Removelist + a = 0 + OldStatusValue = StatusValue + ' Harte Formatierung + For i = 0 To LastIndex + If ThisSel(i) = True Then + RangeName = ListboxList(i) + oRange = RetrieveRangeoutofRangeName(RangeName) + ConvertCellCurrencies(oRange, Currfactor, False, SwitchFormat) + If NOT bAutoPilot Then +' The following line has been put beside due to Bug #73157 (Two ranges lying side by side) +' If oSelRanges.HasbyName(RangeName) Then + oSelRanges.RemovebyName(RangeName) + oDocument.CurrentController.Select(oSelRanges) +' End If + End If + + If SwitchFormat Then + If oRange.getPropertyState("NumberFormat") <> 1 Then + ' Range Ist hart formatiert + SwitchNumberFormat(oRange, oFormats, sEuroSign)' "€") + End If + Else + SwitchNumberFormat(oRange, oFormats, sEuroSign) '"€" + End If + AddCells = CountRangeCells(oRange) + CurCellCount = AddCells + IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue)) + + ' Die selektierte Stilvorlage muß zum Schluß aus der Listbox entfernt werden + If bPreSelected Then + RemoveList(0) = ListboxList(i) + Else + r = IndexinArray(ListboxList(i), RangeList()) + If r <> -1 Then + RangeBools(r) = False + RemoveList(a) = RangeList(r) + a = a + 1 + End If + End If + End If + Next + End If +End Sub + + + +Sub ConvertCellCurrencies(oRange as Object, fFaktor as Double, CurrRoundMode, SwitchFormat as Boolean) +Dim oValues as Object +Dim IntValue as Long +Dim i as Integer +Dim CellValue as double +Dim oCells as Object +Dim oCell as Object +Dim DecFactor as integer +Dim nFormatDecimals as integer +Dim IsHardFormatted as Boolean + + ' Wenn der Bereich hart formatiert ist, dann bei selektierter + ' weichen Formatierung keine Umrechnung + + ' konstante Werte im Bereich anpassen + oValues = oRange.queryContentCells( com.sun.star.sheet.CellFlags.VALUE ) + + If (oValues.Count > 0) Then + oCells = oValues.Cells.createEnumeration + While oCells.hasMoreElements + oCell = oCells.nextElement + DecFactor = 0 + CellValue = oCell.Value + oCell.Value = CellValue/fFaktor + Wend + End If +End Sub + + +Function CheckIfRangeisCurrency(FormatObject as Object) +Dim oFormatofObject() as Object + ' Retrieve the Format of the Object + On Local Error GoTo NOKEY + oFormatofObject() = oFormats.getByKey(FormatObject.NumberFormat) + On Local Error GoTo 0 + + ' Typ und Währungssymbol des Numberformats heraussuchen + ' Todo: Ãœberprüfe, ob diese beiden Zeilen nicht eleganter gehen + CheckIfRangeIsCurrency = INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY + Exit Function +NOKEY: + CheckIfRangeisCurrency = False + Resume CLERROR + CLERROR: +End Function + + +Function CountColumnsForRow(IndexArray() as String, Row as Integer) +Dim i as Integer +Dim NoNulls as Boolean + For i = 1 To Ubound(IndexArray,2) + If IndexArray(Row,i)= "" Then + NoNulls = False + Exit For + End If + Next + CountColumnsForRow = i +End Function + + +Function CountRangeCells(oRange as Object) As Long +Dim oRangeAddress as Object +Dim LocCellCount as Long + oRangeAddress = oRange.RangeAddress + LocCellCount = (oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1) * (oRangeAddress.EndRow - oRangeAddress.StartRow + 1) + CountRangeCells = LocCellCount +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/euro/Init.xba b/wizards/source/euro/Init.xba new file mode 100644 index 000000000..fb85f5dab --- /dev/null +++ b/wizards/source/euro/Init.xba @@ -0,0 +1,481 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Init" script:language="StarBasic">Option Explicit +REM ***** BASIC ***** + +Public sREADY as String +Public sPROTECT as String +Public sCONTINUE as String + +Public sSELTEMPL as String +Public sSELCELL as String +Public sCURRRANGES as String +Public sTEMPLATES as String + +Public sSOURCEFILE as String +Public sSOURCEDIR as String + +Public sStsPROGRESS as String +Public sStsCELLPROGRSS as String +Public sStsRELRANGES as String +Public sStsRELSHEETRANGES as String +Public sStsREPROTECT as String + +Public sMsgREADY as String +Public sMsgSELDIR as String +Public sMsgSELFILE as String +Public sMsgTARGETDIR as String +Public sMsgNOTTHERE as String +Public sMsgDLGTITLE as String +Public sMsgUNPROTECT as String +Public sMsgPWPROTECT as String +Public sMsgWRONGPW as String +Public sMsgSHEETPROTECTED as String +Public sMsgWARNING as String +Public sMsgSHEETSNOPROTECT as String +Public sMsgSHEETNOPROTECT as String +Public sMsgCHOOSECURRENCY as String +Public sMsgPASSWORD as String +Public sMsgOK as String +Public sMsgCANCEL as String +Public sMsgFileInvalid as String +Public sMsgNODIRECTORY as String + +Public sCurrPORTUGUESE as String +Public sCurrDUTCH as String +Public sCurrFRENCH as String +Public sCurrSPANISH as String +Public sCurrITALIAN as String +Public sCurrGERMAN as String +Public sCurrBELGIAN as String +Public sCurrIRISH as String +Public sCurrLUXEMBOURG as String +Public sCurrAUSTRIAN as String +Public sCurrFINNISH as String +Public sCurrUNKNOWN as String +Public sCurrSYSUNKNOWN as String + +Public sPrgsRETRIEVAL as String +Public sPrgsCONVERTING as String +Public sPrgsUNPROTECT as String + +Public Const SBCOUNTRYCOUNT = 11 +Public CurCellCount as Long +Public oSheets as Object +Public oStyles as Object +Public oStyle as Object +Public oFormats as Object +Public aSimpleStr as String +Public nSimpleKey as Long +Public aFormat() as Variant +Public oRanges as Object +Public oRange as Object +Public nLanguage as integer +Public nFormatLanguage as integer +Public aCellFormat as Variant +Public StyleRangeAssignmentList(20,50)as String +Public oDocument as Object +Public StartCol, StartRow, EndCol, EndRow as String +Public oSheet as Object +Public IntStartCol, IntStartRow, IntEndCol, IntEndRow as integer +Public oSelRanges as Object +Public nFormatType as Integer +Public sFormatCurrency as String +Public sFormatLanguage as String +Public RangeList(200) as String +Public SelRangeList(200) as String +Public ListboxItems(200) as String +Public CurSheetName as String +Public oStatusLine as Object +Public Const SBRELGET = 50 +Public StatusValue as Single +Public TotCellCount as Long +Public StyleIndex as Integer +Public RemoveList(100) as String +Public RangeIndex as Integer +Public CurrIndex as Integer +Public ActLangNumber(1) as Integer +Public CurExtension(1) as String +Public Currfactor as Double +Public CurrSymbolList(2) as String +Public CurrLanguage as String +Public CurrValue(10,5) as String +Public LangIDValue(10,2,2) as String +Public PreName as String +Public oAddressRanges as Object +Public Separator as String +Public BitmapDir as String +Public TypeIndex as Integer, CSIndex as Integer, LangIndex as Integer, FSIndex as Integer +Public oLocale as Object +Public sEuroSign as String +Public oPointer as Object +Public sDocType as String +Public RangeBools(100) as Boolean +Public bPreSelected as Boolean +Public DocDisposed as Boolean +Public bMacroStopped as Boolean +Public bRecursive as Boolean +Public bCancelProtection as Boolean +Public CurrRoundMode as Boolean +Public bRangeListDefined as Boolean + + +Sub InitializeResources() + DialogModel.cmdCancel.Label = GetResText(1000) + DialogModel.cmdHelp.Label = GetResText(1001) + DialogModel.cmdBack.Label = GetResText(1002) + DialogModel.cmdGoOn.Label = GetResText(1003) + DialogModel.lblHint.Label = GetResText(1004) + DialogModel.lblCurrencies.Label = GetResText(1006) +' Todo: Dieses Model später am Control unsichtbar machen + If DialogModel.Step = 1 Then + DialogModel.chkComplete.Label = GetResText(1100) + DialogModel.frmSelection.Label = GetResText(1101) + DialogModel.optCellTemplates.Label = GetResText(1102) + DialogModel.optSheetRanges.Label = GetResText(1103) + DialogModel.optDocRanges.Label = GetResText(1104) + DialogModel.optSelRange.Label = GetResText(1105) + sCURRRANGES = GetResText(1108) + DialogModel.lblSelection.Label = sCURRRANGES + Else + DialogModel.frmExtent.Label = GetResText(1200) + DialogModel.optSingleFile.Label = GetResText(1201) + DialogModel.optWholeDir.Label = GetResText(1202) + DialogModel.chkProtect.Label = GetResText(1207) + sSOURCEFILE = GetResText(1203) + sSOURCEDIR = GetResText(1204) + DialogModel.lblSource.Label = sSOURCEDIR + DialogModel.chkRecursive.Label = GetResText(1205) + DialogModel.lblTarget.Label = GetResText(1206) + DialogModel.optWholeDir.State = 1 + DialogModel.txtSource.Text = GetPathSettings("Work") + DialogModel.txtTarget.Text = DialogModel.txtSource.Text + + DialogModel.frmProgress.Label = GetResText(1600) + DialogModel.lblConfig.Label = GetResText(1603) + sPrgsRETRIEVAL = GetResText(1601) + sPrgsCONVERTING = GetResText(1602) + sPrgsUNPROTECT = GetResText(1604) + End If + DialogModel.cmdBack.Enabled = False + sPROTECT = GetResText(1005) + sCONTINUE = GetResText(1007) + sSELTEMPL = GetResText(1106) + sSELCELL = GetResText(1107) + sCURRRANGES = GetResText(1108) + sTEMPLATES = GetResText(1109) + sStsPROGRESS = GetResText(1300) + sStsCELLPROGRSS = GetResText(1301) + sStsRELSHEETRANGES = GetResText(1302) + sStsRELRANGES = GetResText(1303) + sStsREPROTECT = GetResText(1304) + + sMsgREADY = GetResText(1400) + sMsgSELDIR = GetResText(1401) + sMsgSELFILE = GetResText(1402) + sMsgTARGETDIR = GetResText(1403) + sMsgNOTTHERE = GetResText(1404) + sMsgDLGTITLE = GetResText(1405) + sMsgUNPROTECT = GetResText(1406) + sMsgPWPROTECT = GetResText(1407) + sMsgWRONGPW = GetResText(1408) + sMsgSHEETPROTECTED = GetResText(1409) + sMsgWARNING = GetResText(1410) + sMsgSHEETSNOPROTECT = GetResText(1411) + sMsgSHEETNOPROTECT = GetResText(1412) + sMsgCHOOSECURRENCY = GetResText(1415) + sMsgPASSWORD = GetResText(1416) + sMsgOK = GetResText(1417) + sMsgCANCEL = GetResText(1418) + sMsgFILEINVALID = GetResText(1419) + sMsgFILEINVALID = ReplaceString(sMsgFILEINVALID,"%PRODUCTNAME", GetProductname()) + SMsgNODIRECTORY = GetResText(1420) + + sCurrPORTUGUESE = GetResText(1500) + sCurrDUTCH = GetResText(1501) + sCurrFRENCH = GetResText(1502) + sCurrSPANISH = GetResText(1503) + sCurrITALIAN = GetResText(1504) + sCurrGERMAN = GetResText(1505) + sCurrBELGIAN = GetResText(1506) + sCurrIRISH = GetResText(1507) + sCurrLUXEMBOURG = GetResText(1508) + sCurrAUSTRIAN = GetResText(1509) + sCurrFINNISH = GetResText(1510) + sCurrUNKNOWN = GetResText(1511) + sCurrSYSUNKNOWN = GetResText(1512) +End Sub + + +Sub InitializeLanguages() + sEuroSign = chr(8364) + +' CURRENCIES_PORTUGUESE + LangIDValue(0,0,0) = "pt" + LangIDValue(0,0,1) = "PT" + LangIDValue(0,0,2) = "-816" + +' CURRENCIES_DUTCH + LangIDValue(1,0,0) = "nl" + LangIDValue(1,0,1) = "NL" + LangIDValue(1,0,2) = "-413" + +' CURRENCIES_FRENCH + LangIDValue(2,0,0) = "fr" + LangIDValue(2,0,1) = "FR" + LangIDValue(2,0,2) = "-40C" + +' CURRENCIES_SPANISH + LangIDValue(3,0,0) = "es" + LangIDValue(3,0,1) = "ES" + LangIDValue(3,0,2) = "-40A" + + 'Spanish modern + LangIDValue(3,1,0) = "es" + LangIDValue(3,1,1) = "ES" + LangIDValue(3,1,2) = "-C0A" + +' CURRENCIES_ITALIAN + LangIDValue(4,0,0) = "it" + LangIDValue(4,0,1) = "IT" + LangIDValue(4,0,2) = "-410" + +' CURRENCIES_GERMAN + LangIDValue(5,0,0) = "de" + LangIDValue(5,0,1) = "DE" + LangIDValue(5,0,2) = "-407" + +' CURRENCIES_BELGIAN + LangIDValue(6,0,0) = "fr" + LangIDValue(6,0,1) = "BE" + LangIDValue(6,0,2) = "-80C" + + LangIDValue(6,1,0) = "nl" + LangIDValue(6,1,1) = "BE" + LangIDValue(6,1,2) = "-813" + +' CURRENCIES_IRISH + LangIDValue(7,0,0) = "en" + LangIDValue(7,0,1) = "IE" + LangIDValue(7,0,2) = "-1809" + +' CURRENCIES_LUXEMBOURG + LangIDValue(8,0,0) = "fr" + LangIDValue(8,0,1) = "LU" + LangIDValue(8,0,2) = "-140C" + + LangIDValue(8,1,0) = "de" + LangIDValue(8,1,1) = "LU" + LangIDValue(8,1,2) = "-1007" + +' CURRENCIES_AUSTRIAN + LangIDValue(9,0,0) = "de" + LangIDValue(9,0,1) = "AT" + LangIDValue(9,0,1) = "-C07" + +' CURRENCIES_FINNISH + LangIDValue(10,0,0) = "fi" + LangIDValue(10,0,1) = "FI" + LangIDValue(10,0,2) = "-40B" + + LangIDValue(10,1,0) = "sv" + LangIDValue(10,1,1) = "FI" + LangIDValue(10,1,2) = "-81D" +End Sub + + + +Sub InitializeCurrencies() +Dim i as Integer + GoOn = True + + CurrValue(0,0) = sCurrPORTUGUESE + ' Wahrer Umrechnungskurs + CurrValue(0,1) = "200.482" + ' Gerundeter Umrechnungskurs + CurrValue(0,2) = "200" + CurrValue(0,3) = "Esc." + CurrValue(0,4) = "Esc." + CurrValue(0,5) = "PTE" + + CurrValue(1,0) = sCurrDUTCH + ' Wahrer Umrechnungskurs + CurrValue(1,1) = "2.20371" + ' Gerundeter Umrechnungskurs + CurrValue(1,2) = "2" + CurrValue(1,3) = "F" + CurrValue(1,4) = "F" + CurrValue(1,5) = "NLG" + + CurrValue(2,0) = sCurrFRENCH + ' Wahrer Umrechnungskurs + CurrValue(2,1) = "6.55957" + ' Gerundeter Umrechnungskurs + CurrValue(2,2) = "7" + CurrValue(2,3) = "F" + CurrValue(2,4) = "F" + CurrValue(2,5) = "FRF" + + CurrValue(3,0) = sCurrSPANISH + ' Wahrer Umrechnungskurs + CurrValue(3,1) = "166.386" + ' Gerundeter Umrechnungskurs + CurrValue(3,2) = "170" + CurrValue(3,3) = "Pts" + CurrValue(3,4) = "Pts" + CurrValue(3,5) = "ESP" + + CurrValue(4,0) = sCurrITALIAN + ' Wahrer Umrechnungskurs + CurrValue(4,1) = "1936.27" + ' Gerundeter Umrechnungskurs + CurrValue(4,2) = "2000" + CurrValue(4,3) = "L." + CurrValue(4,4) = "L." + CurrValue(4,5) = "ITL" + + CurrValue(5,0) = sCurrGERMAN + ' Wahrer Umrechnungskurs + CurrValue(5,1) = "1.95583" + ' Gerundeter Umrechnungskurs + CurrValue(5,2) = "140" + CurrValue(5,3) = "DM" + CurrValue(5,4) = "DM" + CurrValue(5,5) = "DEM" + + CurrValue(6,0) = sCurrBELGIAN + ' Wahrer Umrechnungskurs + CurrValue(6,1) = "40.3399" + ' Gerundeter Umrechnungskurs + CurrValue(6,2) = "40" + CurrValue(6,3) = "FB" + CurrValue(6,4) = "BF" + CurrValue(6,5) = "BEF" + + CurrValue(7,0) = sCurrIRISH + ' Wahrer Umrechnungskurs + CurrValue(7,1) = "0.787564" + ' Gerundeter Umrechnungskurs + CurrValue(7,2) = "0.8" + CurrValue(7,3) = "£" + CurrValue(7,4) = "£" + CurrValue(7,5) = "IEP" + + CurrValue(8,0) = sCurrLUXEMBOURG + ' Wahrer Umrechnungskurs + CurrValue(8,1) = "40.3399" + ' Gerundeter Umrechnungskurs + CurrValue(8,2) = "40" + CurrValue(8,3) = "F" + CurrValue(8,4) = "F" + CurrValue(8,5) = "LUF" + + CurrValue(9,0) = sCurrAUSTRIAN + ' Wahrer Umrechnungskurs + CurrValue(9,1) = "13.7603" + ' Gerundeter Umrechnungskurs + CurrValue(9,2) = "15" + CurrValue(9,3) = "S" + CurrValue(9,4) = "S" + CurrValue(9,5) = "ATS" + + CurrValue(10,0) = sCurrFINNISH + ' Wahrer Umrechnungskurs + CurrValue(10,1) = "5.94573" + ' Gerundeter Umrechnungskurs + CurrValue(10,2) = "6" + CurrValue(10,3) = "mk" + CurrValue(10,4) = "mk" + CurrValue(10,5) = "FIM" + + i = -1 + CurrSymbolList(0) = "" + CurrSymbolList(1) = "" + + If CurrIndex <> -1 Then + ' Current language is of the European Currency Union + InitializeCurrencyValues(CurrIndex) + Else + If DialogModel.Step = 1 Then + EnableStep1DialogControls(True, False, False) + ElseIf DialogModel.Step = 2 Then + EnableStep2DialogControls(True) + End If + End If +End Sub + + +Sub InitializeConverter(oLocale, iDialogPage as Integer) +Dim Isthere as Boolean + ToggleWindow(False) + bCancelProtection = False + bMacroStopped = False + bRangeListDefined = False + sDocType = GetDocumentType(StarDesktop.ActiveFrame.Controller.Model) + DialogConvert = LoadDialog("Euro", "DialogConvert") + DialogModel = DialogConvert.Model + DialogModel.Step = iDialogPage + InitializeResources() + InitializeLanguages() + InitializeLocales(oLocale) + InitializeCurrencies() + Filterlist(0) = "application/vnd.stardivision.calc" + BitmapDir = GetOfficeSubPath("Template", "wizard/bitmap") + UnprotectList(0,0) = "0" + FillUpCurrencyListbox() + DialogConvert.Title = sMsgDLGTITLE + ToggleWindow(True) +End Sub + + +Sub InitializeCurrencyValues(CurrIndex) + If CurrIndex <> -1 Then + CurrLanguage = CurrValue(CurrIndex,0) + CurrFactor = Val(CurrValue(CurrIndex,1)) + CurrSymbolList(0) = CurrValue(CurrIndex,3) + CurrSymbolList(1) = CurrValue(CurrIndex,4) + CurrSymbolList(2) = CurrValue(CurrIndex,5) + End If +End Sub + + +Function InitializeLocales(oLocale) as Boolean +Dim i as Integer, n as Integer, m as Integer +Dim sLanguage as String, sCountry as String + + sLanguage = oLocale.Language + sCountry = oLocale.Country + For n = 0 To SBCOUNTRYCOUNT - 1 + For m = 0 TO 1 + If LangIDValue(n,m,0) = sLanguage AND LangIDValue(n,m,1) = sCountry Then + CurrIndex = n + For i = 0 To 1 + CurExtension(i) = LangIDValue(CurrIndex,i,2) + Next i + InitializeLocales = True + Exit Function + End If + Next m + Next n + CurrIndex = -1 + InitializeLocales = False +End Function + + +Sub LoadLibrary(sLibname as String) + Dim oArg(0) as new com.sun.star.beans.PropertyValue + Dim oUrl as new com.sun.star.util.URL + Dim oTrans as Object + Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict( oUrl ) + + oDisp = StarDesktop.currentFrame.queryDispatch( oUrl, "_self", 0) + oDisp.dispatch( oUrl, oArg()) +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/euro/Soft.xba b/wizards/source/euro/Soft.xba new file mode 100644 index 000000000..36f8ce6b0 --- /dev/null +++ b/wizards/source/euro/Soft.xba @@ -0,0 +1,233 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Soft" script:language="StarBasic">Option Explicit +REM ***** BASIC ***** + +'Assignmentlist: + +' Stylename ; Defined ; Selected ; RangeCellCount ; Range No 1 ; Range No 2 ... +' 0 1 2 3 4 + + +Sub CreateStyleEnumeration() + EmptySelection() + EmptyListbox(DialogModel.lstSelection) + CurSheetName = oDocument.CurrentController.GetActiveSheet.Name + MakeStyleEnumeration(False) + DialogModel.lblSelection.Label = sTEMPLATES ' "Vorlagen:" +End Sub + + +Sub MakeStyleEnumeration(bAutoPilot as Boolean) +Dim m as integer +Dim aStyleFormat as Object +Dim Stylename as String +Dim AddToList as Boolean + StyleIndex = 0 + oStyles = oDocument.StyleFamilies.GetbyIndex(0) + For m = 0 To oStyles.count-1 + oStyle = oStyles.GetbyIndex(m) + StyleName = oStyle.Name + AddToList = CheckFormatType(oStyle) + If AddToList Then + If Not bAutoPilot Then + AddSingleItemToListbox(DialogModel.lstSelection, Stylename) + Else + SwitchNumberFormat(ostyle, oFormats, sEuroSign)' "€") + EuroStyles(StyleIndex) = Stylename + EuroBools(StyleIndex) = True + End If + StyleRangeAssignmentList(StyleIndex,0) = Stylename + StyleIndex = StyleIndex + 1 + End If + Next m +End Sub + + +Sub AssignRangestoStyle(Stylelist(), SelList()) +Dim CurStyleName as String +Dim oTempRanges as Object +Dim i, n, m, t as integer +Dim Rangename as String +Dim oRangeAddress as Object +Dim SheetName as String +Dim SheetThere as Boolean +Dim StyleCellCount as Long +Dim AddRange as Boolean +Dim oListSheet as Object +Dim SheetsCount as Integer +Dim LastIndex as Integer + + LastIndex = Ubound(StyleList()) + StatusValue = 0 + SheetsCount = oSheets.Count + oStatusLine.SetText(sStsRELRANGES) '"Erfassung der relevanten Bereiche..." + ' Zähler für die selektierten Einträge + StyleCellCount = 0 + TotCellcount = 0 + For i = 0 To LastIndex + CurStyleName = StyleList(i) + + ' Finde den Index in der Zuordnungstabelle + n = IndexinArray(CurStyleName, StyleRangeAssignmentList()) + + ' Ist der Listboxeintrag selektiert? + If SelList(i) = True Then + m = 4 + StyleRangeAssignmentList(n,2) = 1 + + If StyleRangeAssignmentList(n,1) <> 1 Then + ' Die Ranges für diesen Style sind noch nicht definiert + StyleCellCount = 0 + For t = 0 To sheetscount - 1 + oSheet = oSheets.GetbyIndex(t) + SheetName = oSheet.Name + ' Der Listboxeintrag ist frisch selektiert worden und muß der Ranges - Kollektion + ' hinzugefügt werden + + ' Dem Stylenamen sind keine Ranges zugeordnet + ' Diese holen wir mit der folgenden Schleife nach + oRanges = osheet.CellFormatRanges.createEnumeration + + While oRanges.hasMoreElements + oRange = oRanges.NextElement + If oRange.getPropertyState("NumberFormat") = 1 Then + If oRange.CellStyle = CurStyleName Then + oRangeAddress = oRange.RangeAddress + RangeName = RetrieveRangeNamefromAddress(oRangeAddress,SheetName) + oListSheet = RetrieveSheetoutofRangeName(RangeName) + AddRange = UnprotectSheet(oListSheet) + If AddRange Then + ' Jetzt den Index für den Style ermitteln + StyleRangeAssignmentList(n,m) = RangeName + + ' Die gesamtZahl der Zellen anpassen + StyleCellCount = StyleCellCount + CountRangeCells(oRange) + m = m + 1 + End If + End If + End If + Wend + Next t + TotCellCount = TotCellCount + StyleCellCount + ' Die Ranges für den Stil sind jetzt definiert + StyleRangeAssignmentList(n,1) = "1" + StyleRangeAssignmentList(n,3) = cStr(StyleCellCount) + End If +' TotCellCount = TotCellCount + Int(StyleRangeAssignmentlist(n,3) + Else + ' Style is not selected + If StyleRangeAssignmentList(n,2) = "1" Then + StyleRangeAssignmentList(n,2) = "0" + DeselectStyle(CurStyleName) + End If + End If + IncreaseStatusvalue(SBRELGET/(LastIndex+1)) + Next i +End Sub + + +' löscht eine Stilvorlage aus der Kollektion, die die Ranges selektiert +Sub DeselectStyle(DeSelStyleName as String) +Dim n, m as Integer +Dim RangeName as String + + ' Finde den Index in der Zuordnungstabelle + n = IndexinArray(DeSelStyleName, StyleRangeAssignmentList(), 1) + m = 4 + Do + RangeName = StyleRangeAssignmentList(n,m) + If RangeName <> "" Then + oSelRanges.RemovebyName(RangeName) + m = m + 1 + End If + Loop until RangeName = "" +End Sub + + +Function RetrieveRangeNamefromAddress(oRangeAddress as Object, Sheetname as String) as String +Dim Rangename as String + oAddressRanges.InsertbyName("",oRange) + Rangename = oAddressRanges.RangeAddressesasString + oAddressRanges.RemovebyName(RangeName) + RetrieveRangeNamefromAddress = Rangename +End Function + + +' Erzeugt eine Sheetobjekt aus einem entsprechenden Bereichsnamen +Function RetrieveSheetoutofRangeName(TableText as String) +Dim DescriptionList() as String +Dim SheetName as String +Dim MaxIndex as integer + ' Herausfinden, in welchem Sheet sich der Range befindet + DescriptionList() = ArrayOutofString(TableText,".",MaxIndex) + SheetName = DescriptionList(0) + SheetName = DeleteStr(SheetName,"'") + ' Und den ViewCursor auf dieses Sheet setzen + RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName) +End Function + + +' Erzeugt eine Rangeobjekt aus einem entsprechenden Bereichsnamen +Function RetrieveRangeoutofRangeName(TableText as String) + oSheet = RetrieveSheetoutofRangeName(TableText) + oRange = oSheet.GetCellRangebyName(TableText) + RetrieveRangeoutofRangeName = oRange +End Function + + +Sub ConvertTheSoftWay(StyleList() as String, ThisSel() as Boolean, bAutopilot as Boolean) +Dim a, i, m, n, s as Integer +Dim CurStyleName as String +Dim RangeName as String +Dim OldStatusValue as Integer +Dim LastIndex as Integer + LastIndex = Ubound(StyleList()) + ' Index für die Removelist + a = 0 + OldStatusValue = StatusValue + For i = 0 To LastIndex + If ThisSel(i) = True Then + CurStyleName = StyleList(i) + oStyle = oStyles.GetbyName(CurStyleName) + + ' Jetzt die Ranges abarbeiten, die mit der Vorlage verknüpft sind + ' Gibt es den Listboxeintrag schon in der Zuordnungstabelle? + n = IndexinArray(CurStyleName, StyleRangeAssignmentList(), 1) + m = 4 + + Do + RangeName = StyleRangeAssignmentList(n,m) + If RangeName <> "" Then + oRange = RetrieveRangeoutofRangeName(RangeName) + If oRange.getPropertyState("NumberFormat") = 1 Then + ' Range Ist hart formatiert + ConvertCellCurrencies(oRange,Currfactor,False) + CurCellCount = CountRangeCells(oRange) + End If + IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue)) + If NOT bAutoPilot Then +' The following line has been put aside due to Bug #73157 (Two ranges lying side by side) +' They should be reintegrated after the bugfix, as in future versions oSelRangs might throw an exception +' If oSelRanges.HasbyName(RangeName) Then + oSelRanges.RemovebyName(RangeName) + oDocument.CurrentController.Select(oSelRanges) +' End If + End If + m = m + 1 + End If + Loop Until RangeName = "" + + ' Zuletzt das Währungsformat in den Vorlagen anpassen + SwitchNumberFormat( ostyle, oFormats, sEuroSign) +' oStatusline.SetValue(100) + ' Die Vorlage wird aus der Zuordnungstabelle gelöscht + For s = 0 To m - 1 + StyleRangeAssignmentList(n,s) = "" + Next + ' Die selektierte Stilvorlage muß zum Schluß aus der Listbox entfernt werden + RemoveList(a) = StyleList(i) + a = a + 1 + End If + Next +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/DBMeta.xba b/wizards/source/formwizard/DBMeta.xba new file mode 100644 index 000000000..658737ff0 --- /dev/null +++ b/wizards/source/formwizard/DBMeta.xba @@ -0,0 +1,127 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DBMeta" script:language="StarBasic">REM ***** BASIC ***** +Public sDatabaseList() +Public sTableName as String + + +Sub GetDatabaseNames() + If oDBContext.HasElements Then + sDatabaseList() = oDBContext.ElementNames() + End If +End Sub + + +Sub GetSelectedDBMetaData() +Dim NullList() +Dim OldsDBname as String + ToggleDatabasePage(False) + GetDBMetaData(sDatabaseList(), oDialogModel.lstDatabases.SelectedItems(0) ) + oDialogModel.lstTables.Enabled = True + oDialogModel.lblTables.Enabled = True + oDialogModel.lstTables.StringItemList() = AddListToList(TableNames(), QueryNames()) + oDialogModel.lstFields.StringItemList() = NullList() + oDialogModel.lstSelFields.StringItemList() = NullList() + ToggleDatabasePage(True) +End Sub + + +Sub GetDBMetaData(sDataBaseList(), DBIndex as Integer) +Dim oDatabase as Object + If oDBContext.HasElements Then + oDatabase = oDBContext.GetByName(sDatabaseList(DBIndex)) + sDBName = oDatabase.Name + If Not oDatabase.IsPasswordRequired Then + oDBConnection = oDBContext.GetByName(sDatabaseList(DBIndex)).GetConnection("","") + Else + Msgbox("Todo: Passwortabfrage!") + oDBConnection = oDBContext.GetByName(sDatabaseList(DBIndex)).GetConnection("extra","extra") + End If + Tablenames() = oDBConnection.Tables.ElementNames() + Querynames() = oDBConnection.Queries.ElementNames() + Else + MsgBox(Form_gErrNoDatabase$, 64, Form_gWizardName$) + End If +End Sub + + +Sub GetTableMetaData() +Dim iType as Long +Dim ActType$, subType$, ShowAfterCreate$, sSQLExpr$ +Dim m as Integer +Dim Found as Boolean + MaxIndex = Ubound(oDialogModel.lstSelFields.StringItemList()) + Dim ColumnMap(MaxIndex)as Integer + + FieldNames() = oDialogModel.lstSelFields.StringItemList() + + ' Build a structure which maps the position of a selected field (within the selection) to the the column position within + ' the table. So we ensure that the controls are placed in the same order the according fields are selected. + For i = 0 To Ubound(FieldNames()) + sFieldName = FieldNames(i) + Found = False + n = 0 + While (n< MaxIndex And (Not Found)) + If (FieldNames(n) = sFieldName) Then + Found = True + ColumnMap(n) = i + End If + n = n + 1 + Wend + Next i + +' Todo: Was Wenn die Reihenfolge durcheinandergebracht ist? + For n = 0 to MaxIndex + sFieldname = FieldNames(n) + iType = oColumns.GetByName(sFieldName).Type + FieldMetaValues(n,0) = iType + FieldMetaValues(n,1) = GetValueoutofList(iType, WidthList(),1) + FieldMetaValues(n,2) = GetValueoutofList(iType, WidthList(),2) + Next +End Sub + + +Sub GetSpecificFieldNames() +Dim n as Integer +Dim m as Integer +Dim iType as Integer +Dim oField as Object +Dim MaxIndex as Integer + If Ubound(oDialogModel.lstTables.StringItemList()) > -1 Then + FieldNames() = oColumns.GetElementNames() + If oDialogModel.optIgnoreBinaries.State Then + MaxIndex = Ubound(FieldNames()) + Dim ResultFieldNames(MaxIndex) + m = 0 + For n = 0 To MaxIndex + oField = oColumns.GetByName(FieldNames(n)) + iType = oField.Type + If (iType <> com.sun.star.sdbc.DataType.BINARY)AND(iType <> com.sun.star.sdbc.DataType.VARBINARY)AND(iType <> com.sun.star.sdbc.DataType.LONGVARBINARY) Then + ResultFieldNames(m) = FieldNames(n) + m = m + 1 + End If + Next n + ' Todo: Den folgenden Code wieder reinnehmen: + ' Redim ResultFieldNames(m-1) Preserve + ' Redim FieldNames(m-1) Preserve + FieldNames() = ResultFieldNames() + End If + oDialogModel.lstFields.StringItemList = FieldNames + End If +End Sub + + +Sub CreateDBForm() + oDBForm = oDocument.CreateInstance("com.sun.star.form.component.Form") + oDocument.Drawpage.Forms.InsertByIndex (0, oDBForm) + oDBForm.Name = "Standard" + oDBForm.DataSourceName = sDBName + oDBForm.Command = sTableName + ' Todo: Ist diese Abfrage notwendig? + If bIsQuery Then + oDBForm.CommandType=1 ' Abfrage + else + oDBForm.CommandType=0 ' Tabelle + End If +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/DlgFormDB.xdl b/wizards/source/formwizard/DlgFormDB.xdl new file mode 100644 index 000000000..e9b1c38f9 --- /dev/null +++ b/wizards/source/formwizard/DlgFormDB.xdl @@ -0,0 +1,137 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="DlgFormDB" dlg:left="96" dlg:top="28" dlg:width="270" dlg:height="210" dlg:page="1"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + <dlg:style dlg:style-id="1" dlg:background-color="0x0" dlg:border="simple"/> + </dlg:styles> + <dlg:bulletinboard> + <dlg:button dlg:style-id="0" dlg:id="cmdCancel" dlg:left="5" dlg:top="190" dlg:width="50" dlg:height="13" dlg:value="cmdCancel"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.CancelFormWizard"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdHelp" dlg:left="65" dlg:top="190" dlg:width="50" dlg:height="13" dlg:value="cmdHelp"/> + <dlg:button dlg:style-id="0" dlg:id="cmdBack" dlg:left="155" dlg:top="190" dlg:width="50" dlg:height="13" dlg:value="cmdBack"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.PreviousStep"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdGoOn" dlg:left="215" dlg:top="190" dlg:width="50" dlg:height="13" dlg:value="cmdGoOn"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.NextStep"/> + </dlg:button> + <dlg:text dlg:style-id="0" dlg:id="lblDatabases" dlg:left="5" dlg:top="40" dlg:width="74" dlg:height="8" dlg:page="1" dlg:value="lblDatabases"/> + <dlg:text dlg:style-id="0" dlg:id="lblTables" dlg:left="5" dlg:top="67" dlg:width="72" dlg:height="8" dlg:page="1" dlg:value="lblTables"/> + <dlg:text dlg:style-id="0" dlg:id="lblFields" dlg:left="5" dlg:top="96" dlg:width="72" dlg:height="8" dlg:page="1" dlg:value="lblFields"/> + <dlg:button dlg:style-id="0" dlg:id="cmdMoveSelected" dlg:left="122" dlg:top="114" dlg:width="25" dlg:height="14" dlg:page="1" dlg:value="->"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormMoveSelected"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdMoveAll" dlg:left="122" dlg:top="131" dlg:width="25" dlg:height="14" dlg:page="1" dlg:value="=>>"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormMoveAll"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdRemoveSelected" dlg:left="122" dlg:top="149" dlg:width="25" dlg:height="14" dlg:page="1" dlg:value="<-"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormRemoveSelected"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdRemoveAll" dlg:left="122" dlg:top="166" dlg:width="25" dlg:height="14" dlg:page="1" dlg:value="<<="> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormRemoveAll"/> + </dlg:button> + <dlg:radiogroup> + <dlg:radio dlg:style-id="0" dlg:id="optIgnoreBinaries" dlg:left="159" dlg:top="53" dlg:width="100" dlg:height="10" dlg:page="1" dlg:value="optIgnoreBinaries"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.DBMeta.GetSpecificFieldNames"/> + </dlg:radio> + <dlg:radio dlg:style-id="0" dlg:id="optBinariesasGraphics" dlg:left="159" dlg:top="71" dlg:width="100" dlg:height="10" dlg:page="1" dlg:value="optBinariesasGraphics"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.DBMeta.GetSpecificFieldNames"/> + </dlg:radio> + </dlg:radiogroup> + <dlg:titledbox dlg:style-id="0" dlg:id="frmBinaries" dlg:left="155" dlg:top="40" dlg:width="110" dlg:height="50" dlg:page="1"> + <dlg:title dlg:value="frmBinaries"/> + </dlg:titledbox> + <dlg:menulist dlg:style-id="0" dlg:id="lstFields" dlg:left="5" dlg:top="106" dlg:width="110" dlg:height="78" dlg:page="1" dlg:multiselection="true"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormSetMoveRights"/> + </dlg:menulist> + <dlg:menulist dlg:style-id="0" dlg:id="lstSelFields" dlg:left="155" dlg:top="106" dlg:width="110" dlg:height="78" dlg:page="1" dlg:multiselection="true"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Listbox.FormSetMoveRights"/> + </dlg:menulist> + <dlg:titledbox dlg:style-id="0" dlg:id="frmAlign" dlg:left="208" dlg:top="85" dlg:width="57" dlg:height="44" dlg:page="2"> + <dlg:title dlg:value="frmAlign"/> + </dlg:titledbox> + <dlg:titledbox dlg:style-id="0" dlg:id="frmBorderLayout" dlg:left="120" dlg:top="85" dlg:width="84" dlg:height="44" dlg:page="2"> + <dlg:title dlg:value="frmBorderLayout"/> + </dlg:titledbox> + <dlg:radiogroup> + <dlg:radio dlg:style-id="0" dlg:id="optTiled" dlg:left="125" dlg:top="143" dlg:width="70" dlg:height="10" dlg:page="2" dlg:tag="11" dlg:value="optTiled"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="WebWizard.Common.SetBackGraphicStyle"/> + </dlg:radio> + <dlg:radio dlg:style-id="0" dlg:id="optArea" dlg:left="125" dlg:top="160" dlg:width="70" dlg:height="10" dlg:page="2" dlg:tag="10" dlg:value="optArea"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="WebWizard.Common.SetBackGraphicStyle"/> + </dlg:radio> + </dlg:radiogroup> + <dlg:text dlg:style-id="0" dlg:id="lblStyles" dlg:left="5" dlg:top="38" dlg:width="110" dlg:height="11" dlg:page="2" dlg:value="lblStyles"/> + <dlg:menulist dlg:style-id="0" dlg:id="lstStyles" dlg:left="5" dlg:top="49" dlg:width="110" dlg:height="128" dlg:page="2"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.tools.ImportStyles"/> + </dlg:menulist> + <dlg:text dlg:style-id="0" dlg:id="lblInputTitle" dlg:left="5" dlg:top="45" dlg:width="136" dlg:height="12" dlg:page="3" dlg:value="lblInputTitle"/> + <dlg:text dlg:style-id="0" dlg:id="lblfinalConfig" dlg:left="5" dlg:top="72" dlg:width="260" dlg:height="16" dlg:page="3" dlg:value="lblfinalConfig"/> + <dlg:radiogroup> + <dlg:radio dlg:style-id="0" dlg:id="optSaveDocument" dlg:left="5" dlg:top="93" dlg:width="83" dlg:height="12" dlg:page="3" dlg:value="optSaveDocument"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.ToggleControlsofLastPage"/> + </dlg:radio> + <dlg:radio dlg:style-id="0" dlg:id="optEditDocument" dlg:left="5" dlg:top="135" dlg:width="83" dlg:height="14" dlg:page="3" dlg:value="optEditDocument"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.ToggleControlsofLastPage"/> + </dlg:radio> + </dlg:radiogroup> + <dlg:text dlg:style-id="0" dlg:id="lblPath" dlg:left="20" dlg:top="108" dlg:width="32" dlg:height="10" dlg:page="3" dlg:value="lblPath" dlg:align="right"/> + <dlg:textfield dlg:style-id="0" dlg:id="txtInputPath" dlg:left="54" dlg:top="106" dlg:width="190" dlg:height="14" dlg:page="3"> + <dlg:event dlg:listener-type="com.sun.star.awt.XKeyListener" dlg:event-method="keyReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.CheckPathValidation"/> + </dlg:textfield> + <dlg:button dlg:style-id="0" dlg:id="cmdGetPathDialog" dlg:disabled="true" dlg:left="252" dlg:top="106" dlg:width="13" dlg:height="14" dlg:page="3" dlg:value="..."/> + <dlg:text dlg:style-id="0" dlg:id="lblSelFields" dlg:left="155" dlg:top="96" dlg:width="105" dlg:height="10" dlg:page="1" dlg:value="lblSelFields"/> + <dlg:menulist dlg:style-id="0" dlg:id="lstDatabases" dlg:left="5" dlg:top="49" dlg:width="110" dlg:height="14" dlg:page="1" dlg:spin="true"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.DBMeta.GetSelectedDBMetaData"/> + </dlg:menulist> + <dlg:menulist dlg:style-id="0" dlg:id="lstTables" dlg:left="5" dlg:top="76" dlg:width="110" dlg:height="14" dlg:page="1" dlg:spin="true"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.FormGetFields"/> + </dlg:menulist> + <dlg:titledbox dlg:style-id="0" dlg:id="frmBackground" dlg:left="120" dlg:top="133" dlg:width="84" dlg:height="44" dlg:page="2"> + <dlg:title dlg:value="frmBackground"/> + </dlg:titledbox> + <dlg:titledbox dlg:style-id="0" dlg:id="frmArrangements" dlg:left="120" dlg:top="38" dlg:width="145" dlg:height="44" dlg:page="2"> + <dlg:title dlg:value="frmArrangements"/> + </dlg:titledbox> + <dlg:img dlg:style-id="1" dlg:id="imgArrange5" dlg:left="239" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="5"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgArrange2" dlg:left="150" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="2"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgArrange1" dlg:left="123" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="1"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgBorder2" dlg:left="177" dlg:top="96" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="2"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.develop.ChangeBorderLayouts"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgBorder1" dlg:left="150" dlg:top="96" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="1"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.develop.ChangeBorderLayouts"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgBorder0" dlg:left="123" dlg:top="96" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="0"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.develop.ChangeBorderLayouts"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgAlign0" dlg:left="212" dlg:top="96" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="0"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.develop.ChangeLabelAlignments"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgAlign2" dlg:left="239" dlg:top="96" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="2"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.develop.ChangeLabelAlignments"/> + </dlg:img> + <dlg:img dlg:id="imgTheme" dlg:left="5" dlg:top="5" dlg:width="260" dlg:height="30"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.ChangeDialogHeight"/> + </dlg:img> + <dlg:textfield dlg:style-id="0" dlg:id="txtTitle" dlg:left="143" dlg:top="44" dlg:width="122" dlg:height="14" dlg:page="3"> + <dlg:event dlg:listener-type="com.sun.star.awt.XKeyListener" dlg:event-method="keyReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.FormWizard.ChangeDocumentTitle"/> + </dlg:textfield> + <dlg:img dlg:style-id="1" dlg:id="imgArrange3" dlg:left="177" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="3"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgArrange3" dlg:left="177" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="3"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + <dlg:img dlg:style-id="1" dlg:id="imgArrange4" dlg:left="212" dlg:top="49" dlg:width="23" dlg:height="28" dlg:page="2" dlg:tag="4"> + <dlg:event dlg:listener-type="com.sun.star.awt.XMouseListener" dlg:event-method="mouseReleased" dlg:script-type="StarBasic" dlg:script-code="FormWizard.Layouter.ChangeArrangemode"/> + </dlg:img> + </dlg:bulletinboard> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/formwizard/FormWizard.xba b/wizards/source/formwizard/FormWizard.xba new file mode 100644 index 000000000..015b78044 --- /dev/null +++ b/wizards/source/formwizard/FormWizard.xba @@ -0,0 +1,274 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FormWizard" script:language="StarBasic">Option Explicit +'Very new version +Public DocumentName as String +Public FormPath$, FormDBName$, FormReturnValue$ +Public TemplatePath$ +Public WizardPath as String +Public WebWizardPath as String +Public TexturePath as String +Public sQueryName as String +Public NumberofStyles as Integer +Public oDBConnection as Object +Public s_aCurrencySymbol As String +Public s_aPrependCurrencySymbol As Boolean + +Public bNeedFieldRefresh as Boolean +Public bIsQuery as Boolean +Public oDBForm as Object +Public oColumns() as Object +Public sDatabaseList() +Public TableNames() as String +Public QueryNames() as String +Public FieldNames() as String +Public oDBContext as Object +Public oUcb as Object +Public oDocInfo as Object +'Public TemplateList(50,1) as String +Public WidthList(27,3) as Long +Public ControlList(1 To 9) as String +Public sDBName as String +Public Tablename as String + + +Sub MainWithDefault() +'On Local Error Goto GlobalError + LoadLibrary("tools") + LoadLibrary("webwizard") + bControlsareCreated = False + If Not InitResources("Formwizard","dbw") Then + Exit Sub + End If + MaxIndex = -1 + oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + FormPath = GetOfficeSubPath("Template","wizard/bitmap") + WebWizardPath = GetOfficeSubPath("Template","wizard/web") + WizardPath = GetOfficeSubPath("Template","wizard/") + TexturePath = GetOfficeSubPath("Gallery", "www-back/") + OpenBaseDocument() + GetDatabaseNames() + InitializeWidthList() + ' calc some special currency control properties (they depend from the system language) + ' Todo: What's going on here? +' calcCurrencyProperties() + LoadLanguage + bNeedFieldRefresh = True + CreateForm() + +GlobalError: + If Err <> 0 Then + ToggleWindow(True) + MsgBox(Form_gErrMsg$ , 16, Form_gWizardName$) + End If +End Sub + + +Sub CreateForm() as String +Dim i as Integer +' On Error Goto GlobalError + oDialogModel.optIgnoreBinaries.State = True + oDialogModel.optEditDocument.State = True + oDialogModel.cmdBack.Enabled = False + oDialogModel.cmdGoOn.Enabled = False + oDialogModel.lblTables.Enabled = False + oDialogModel.lstSelFields.Tag = False + ToggleListboxControls(oDialogModel, False) + oDialogModel.Step = 1 + oDialogModel.lstDatabases.StringItemList()= sDatabaseList()' = AddItem(sDatabaseList(i) + oDialogModel.Title = Form_Dlg_Caption(oDialogModel.Step) + NumberofStyles = FillupWebListbox(oUcb, "/stl", oDialogModel.lstStyles, Styles(), False) + ImportStyles() + ToggleWindow(True) + DlgFormDB.Execute() + Exit Sub + +GlobalError: + MsgBox(Form_gErrMsg$ , 16, Form_gWizardName$) + ToggleWindow(True) + DlgFormDB.EndExecute() + Reset + Stop +End Sub + + +Function AddListtoList(FirstArray(), SecondArray(), Optional StarIndex) +Dim n as Integer +Dim m as Integer +Dim MaxIndex as Integer + MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1 + Dim ResultArray(MaxIndex) + For m = 0 To Ubound(FirstArray()) + ResultArray(m) = FirstArray(m) + Next m + For n = 0 To Ubound(SecondArray()) + ResultArray(m) = SecondArray(n) + m = m + 1 + Next n + AddListToList() = ResultArray() +End Function + + +Sub FormGetFields() +Dim i as Integer +Dim n as Integer +Dim DocTest as String + ToggleDatabasePage(False) + n = Ubound(oDialogModel.lstTables.SelectedItems()) + If n <> -1 Then + Tablename = Tablenames(oDialogModel.lstTables.SelectedItems(0)) +' Todo: Ask, what' happening here +' DocTest$ = SuggestTitleStr$(FormAvailForms, Form_ilFormTitleSuggestPrefix$ + FormActiveTableName$) + DocTest = ReplaceString(TableName,"_",":") +' i= instr(1, DocTest$, ":" ,1) +' If i > 0 then Mid(DocTest$,i,1,"_") +' DlgFormDB.txtDocTitle.Text = DocTest + bIsQuery = FieldinArray(QueryNames(), Ubound(QueryNames()), TableName) + If (bIsQuery) Then + oColumns = oDBConnection.Queries.GetByName(TableName).Columns + Else + oColumns = oDBConnection.Tables.GetByName(Tablename).Columns + End If +' Todo What's going on here? +' sActFieldName$ = FieldsInQueries.Item (n%) ' should be the same as aField.Name +' sActFieldName$ = Left (sActFieldName$, InStr (1, sActFieldName$, ",") - 1) +' Call FixODBCBug() + GetSpecificFieldNames() + ToggleListboxControls(oDialogModel, True) + End If + SetUpOriginalList(oDialogModel.lstFields) + ToggleDatabasePage(True) + +' bNeedFieldRefresh = False + Exit Sub +no_fields: + MsgBox Form_gErrCouldNotOpenObject$, 16, Form_gWizardName$ +End Sub + + +Sub CancelFormWizard() + DlgFormDB.EndExecute() + DlgFormDB.Dispose() + oDocument.Dispose() + Stop +End Sub + + +Sub PreviousStep() + oDialogModel.Step = oDialogModel.Step - 1 + oDialogModel.cmdBack.Enabled = oDialogModel.Step <> 1 + oDialogModel.cmdGoOn.Enabled = True + If oDialogModel.Step = 1 Then + oDialogModel.lstSelFields.Tag = Not bControlsareCreated + End If +' Todo: Finde für jeden Step eine sinnige Überschrift +' DlgForm.DB.Caption = Form_Dlg_Caption(DlgFormDB.CurrentStep-1) +End Sub + + +Sub NextStep() + Select Case oDialogModel.Step + Case 1 + GetTableMetaData() + CreateDBForm() + InitializeLayoutSettings() + oDialogModel.Step = 2 + Case 2 + oDialogModel.cmdGoOn.Label = Form_5_cmdReady + ToggleControlsofLastPage() + oDialogModel.Step = 3 + Case 3 + HandleCreatedDocument() + End Select +End Sub + + +Sub InitializeLayoutSettings() + bControlsAreCreated = Not (CBool(oDialogModel.lstSelFields.Tag)) + If Not bControlsAreCreated Then + oDialogModel.optTiled.State = 1 + OldArrangement = 0 + CurArrangement = cTabled + CurBorderType = SB3DBORDER + CurAlignmode = SBALIGNLEFT + ToggleBorderGroup(False) + ToggleAlignGroup(False) + ArrangeControls() + End If + + ' Todo: Hier die Grafik Urls der ImageControls setzen. + ' Alternativ würde es vielleicht reichen die Border auf 3-D zu setzen +End Sub + + +Sub HandleCreatedDocument() +Dim sPath as String +Dim NoArgs() as new com.sun.star.beans.PropertyValue + On Local Error Goto NOSAVING + + If oDialogModel.optSaveDocument.State = 1 Then + sPath = oDialogModel.txtInputPath.Text + oDocument.StoreToUrl(sPath,NoArgs() + End If + NOSAVING: + If Err <> 0 Then + Msgbox("Todo: Resourcen für fehlerhaftes Abspeichern suchen!", 16, GetProductname) + Resume CLERROR + Else + oDocument.Dispose + End If + CLERROR: +End Sub + + +Sub ChangeDocumentTitle + oDocument.DocumentInfo.Title = oDialogModel.txtTitle.Text +End Sub + + +Sub ChangeDialogHeight + If oDialogModel.Height <> 40 Then + oDialogModel.Height = 40 + Else + oDialogModel.Height = 210 + End If +End Sub + + +Sub CheckPathValidation() +Dim sPath as String +Dim sDir as String + sPath = ConvertToUrl(oDialogModel.txtInputPath.Text) +' Todo: Abklären, ob Verzeichnisse auch rekursiv erstellt werden sollen! +' Wenn ja muss beim Abspeichern eine Sicherheitsabfrage erscheinen + sDir = DirectorynameoutofPath(sPath , "/") + If oUcb.IsFolder(sDir) Then + oDialogModel.cmdGoOn.Enabled = oUcb.Exists(sDir) + Else + oDialogModel.cmdGoOn.Enabled = False + End If +End Sub + + +Sub ToggleControlsofLastPage() + If oDialogModel.optEditDocument.State = 1 Then + oDialogModel.cmdGoOn.Enabled = True + oDialogModel.txtInputPath.Enabled = False + oDialogModel.cmdGetPathDialog.Enabled = False + oDialogMode.lblPath.Enabled = False + Else + oDialogMode.lblPath.Enabled = True + oDialogModel.txtInputPath.Enabled = True + oDialogModel.cmdGetPathDialog.Enabled = True + CheckPathValidation() + End If +End Sub + + +Sub ToggleDatabasePage(bDoEnable as Boolean) + oDialogModel.frmBinaries.Enabled = bDoEnable + oDialogModel.optIgnoreBinaries.Enabled = bDoEnable + oDialogModel.optBinariesasGraphics.Enabled = bDoEnable + oDialogModel.cmdHelp.Enabled = bDoEnable +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/Language.xba b/wizards/source/formwizard/Language.xba new file mode 100644 index 000000000..9bfe4f4c0 --- /dev/null +++ b/wizards/source/formwizard/Language.xba @@ -0,0 +1,310 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic"> +Global Const RID_DB_COMMON_START = 1000 +Global Const RID_DB_FORM_WIZARD_START = 2200 + + +Public DlgFormDB as Object +Public oDialogModel as Object + +' Global Msg +Dim Form_gWizardName$ +Dim Form_gErrMsg$ +Dim Form_gErrFormOpen$ +Dim Form_gErrNoDatabase$ +Dim Form_gErrNoTableInDatabase$ +Dim Form_gErrTitleSuggestedExist$ +Dim Form_gErrTitleSyntaxError$ +Dim Form_gErrTitleAsTableExist$ +Dim Form_gProgressText$ +Dim Form_gCreatedForm$ +Dim Form_gErrCouldNotOpenObject$ +Dim Form_gErrNameToLong$ + +Dim Form_Dlg_Caption(4) as String + +' Const control-properties +Dim Form_0_cmdCancel$ +Dim Form_0_cmdBack$ +Dim Form_0_CmdNext$ +Dim Form_1_frameDatabase$ +Dim Form_1_frameTables$ +Dim Form_2_lblAvailable$ +Dim Form_2_lblSelected$ +Dim Form_3_frameStyles$ +Dim Form_3_optStyleCol$ +Dim Form_3_optStyleJustified$ +Dim Form_3_optStyleTabled$ +Dim Form_3_frameOrientation$ +Dim Form_3_optHorizontal$ +Dim Form_3_optVertical$ +Dim Form_5_frameFormTitle$ +Dim Form_5_frameOptRun$ +Dim Form_5_cmdReady$ + +' Internal Logic +Dim Form_ilFormTitleSuggestPrefix$ + +Dim Form_gDatetime_DateComponent$ +Dim Form_gDatetime_TimeComponent$ + +Sub LoadLanguage () + Form_gWizardName$ = GetResText(RID_DB_FORM_WIZARD_START + 0) + Form_gErrMsg$ = GetResText(RID_DB_COMMON_START + 6) + Form_gErrFormOpen$ = GetResText(RID_DB_COMMON_START + 7) + Form_gErrNoDatabase$ = GetResText(RID_DB_COMMON_START + 8) + Form_gErrNoTableInDatabase$ = GetResText(RID_DB_COMMON_START + 9) + Form_gErrTitleSuggestedExist$ = GetResText(RID_DB_COMMON_START + 10) + Form_gErrTitleAsTableExist$ = GetResText(RID_DB_COMMON_START + 10) + Form_gErrTitleSyntaxError$ = GetResText(RID_DB_COMMON_START + 11) + Form_gProgressText$ = GetResText(RID_DB_FORM_WIZARD_START + 2) + Form_gCreatedForm$ = GetResText(RID_DB_FORM_WIZARD_START + 26) + Form_gErrNameToLong$ = GetResText (RID_DB_FORM_WIZARD_START + 27) + Form_gErrCouldNotOpenObject$ = GetResText (RID_DB_COMMON_START + 13) + + ' Internal Logic + Form_ilFormTitleSuggestPrefix$ = GetResText(RID_DB_FORM_WIZARD_START + 3) + Form_gDatetime_DateComponent$ = GetResText(RID_DB_FORM_WIZARD_START + 4) + Form_gDatetime_TimeComponent$ = GetResText(RID_DB_FORM_WIZARD_START + 5) + + ' Non const control-properties + Form_Dlg_Caption(0) = Form_gWizardName$ + GetResText(RID_DB_FORM_WIZARD_START + 6) + Form_Dlg_Caption(1) = Form_gWizardName$ + GetResText(RID_DB_FORM_WIZARD_START + 7) + Form_Dlg_Caption(2) = Form_gWizardName$ + GetResText(RID_DB_FORM_WIZARD_START + 8) + Form_Dlg_Caption(3) = Form_gWizardName$ + GetResText(RID_DB_FORM_WIZARD_START + 9) + Form_Dlg_Caption(4) = Form_gWizardName$ + GetResText(RID_DB_FORM_WIZARD_START + 10) + + Form_2_lblAvailable = GetResText(RID_DB_FORM_WIZARD_START + 12) + Form_2_lblSelected = GetResText(RID_DB_FORM_WIZARD_START + 13) + Form_3_frameStyles = GetResText(RID_DB_FORM_WIZARD_START + 14) + Form_3_optStyleCol = GetResText(RID_DB_FORM_WIZARD_START + 15) + Form_3_optStyleJustified = GetResText(RID_DB_FORM_WIZARD_START + 16) + Form_3_optStyleTabled = GetResText(RID_DB_FORM_WIZARD_START + 17) + Form_3_frameOrientation = GetResText(RID_DB_FORM_WIZARD_START + 18) + Form_3_optHorizontal = GetResText(RID_DB_FORM_WIZARD_START + 19) + Form_3_optVertical = GetResText(RID_DB_FORM_WIZARD_START + 20) + Form_5_frameFormTitle = GetResText(RID_DB_FORM_WIZARD_START + 22) + Form_5_frameOptRun = GetResText(RID_DB_FORM_WIZARD_START + 23) + Form_5_cmdReady = GetResText(RID_DB_COMMON_START + 0) + SetDialogLanguage() +End Sub + +Sub SetDialogLanguage () + DlgFormDB = LoadDialog("FormWizard", "DlgFormDB") + oDialogModel = DlgFormDB.Model + oDialogModel.cmdCancel.Label = GetResText(RID_DB_COMMON_START + 1) + oDialogModel.cmdBack.Label = GetResText(RID_DB_COMMON_START + 2) + oDialogModel.cmdGoOn.Label = GetResText(RID_DB_COMMON_START + 3) + oDialogModel.lblDatabases.Label = GetResText(RID_DB_COMMON_START + 4) + oDialogModel.lblTables.Label = GetResText(RID_DB_FORM_WIZARD_START + 11) 'Form_1_frameTables + + oDialogModel.lblFields.Label = GetResText(RID_DB_FORM_WIZARD_START + 12) 'Form_2_lblAvailable + oDialogModel.lblSelFields.Label = GetResText(RID_DB_FORM_WIZARD_START + 13) 'Form_2_lblSelected +' Todo: Die folgenden Resourcen lassen sich immer noch als Hilfetexte für die ImageControls missbrauchen +' .optStyleCol.Caption = Form_3_optStyleCol +' oDialogModel.optStyleHorizontal.Label = Form_3_optHorizontal +' oDialogModel.optStyleVertical.Label = Form_3_optVertical +' oDialogModel.optStyleJustified.Label = Form_3_optStyleJustified +' oDialogModel.optStyleTabled.Label = Form_3_optStyleTabled + + oDialogModel.lblStyles.Label = GetResText(RID_DB_FORM_WIZARD_START + 21) +' Todo: Die Position des Eingabefeld für den Formulartitel entsprechend der Länge seines Labels bestimmen +' oDialogModel.frameFormTitle.Label = Form_5_frameFormTitle +' oDialogModel.frameOptRun.Label = Form_5_frameOptRun + oDialogModel.optEditDocument.Label = GetResText(RID_DB_FORM_WIZARD_START + 24) + oDialogModel.optSaveDocument.Label = GetResText(RID_DB_FORM_WIZARD_START + 25) + oDialogModel.optEditDocument.Enabled = True + oDialogModel.frmBorderLayout.Label = GetResText(RID_DB_FORM_WIZARD_START + 28) +' oDialogModel.OptNoFrame.Label = GetResText(RID_DB_FORM_WIZARD_START + 29) +' oDialogModel.Opt3D.Label = GetResText(RID_DB_FORM_WIZARD_START + 30) +' oDialogModel.OptFlat.Label = GetResText(RID_DB_FORM_WIZARD_START + 31) +End Sub + + + +Sub InitializeWidthList() +'Todo: Was ist mit Currencies? Wieso sind dafür in der API keine Feldtypen definiert? + WidthList(0,0) = com.sun.star.sdbc.DataType.BIT ' = -7; + WidthList(0,1) = 5 + WidthList(0,2) = cCheckbox + WidthList(0,3) = False + + WidthList(1,0) = com.sun.star.sdbc.DataType.TINYINT ' = -6; + WidthList(1,1) = 4 + WidthList(1,2) = cNumericBox + WidthList(1,3) = False + + WidthList(2,0) = com.sun.star.sdbc.DataType.SMALLINT ' = 5; + WidthList(2,1) = 4 + WidthList(2,2) = cNumericBox + WidthList(2,3) = False + + WidthList(3,0) = com.sun.star.sdbc.DataType.INTEGER ' = 4; + WidthList(3,1) = 6 + WidthList(3,2) = cNumericBox + WidthList(3,3) = False + + WidthList(4,0) = com.sun.star.sdbc.DataType.BIGINT ' = -5; + WidthList(4,1) = 11 + WidthList(4,2) = cNumericBox + WidthList(4,3) = False + + WidthList(5,0) = com.sun.star.sdbc.DataType.FLOAT ' = 6; + WidthList(5,1) = 21 + WidthList(5,2) = cNumericBox + WidthList(5,3) = False + + WidthList(6,0) = com.sun.star.sdbc.DataType.REAL ' = 7; + WidthList(6,1) = 21 + WidthList(6,2) = cNumericBox + WidthList(6,3) = False + + WidthList(7,0) = com.sun.star.sdbc.DataType.DOUBLE ' = 8; + WidthList(7,1) = 21 + WidthList(7,2) = cNumericBox + WidthList(7,3) = False + + WidthList(8,0) = com.sun.star.sdbc.DataType.NUMERIC ' = 2; + WidthList(8,1) = 21 + WidthList(8,2) = cNumericBox + WidthList(8,3) = False + + WidthList(9,0) = com.sun.star.sdbc.DataType.DECIMAL ' = 3; + WidthList(9,1) = 10 ' ToDo: Dies muss in einer Routine errechnet werden + WidthList(9,2) = cNumericBox + WidthList(9,3) = False + + WidthList(10,0) = com.sun.star.sdbc.DataType.CHAR ' = 1; + WidthList(10,1) = 3 + WidthList(10,2) = cTextBox + WidthList(10,3) = False + ' Todo: Sollte die Feldlänge vielleicht lieber aus den Metadaten ausgelesen werden? + WidthList(11,0) = com.sun.star.sdbc.DataType.VARCHAR ' = 12; + WidthList(11,1) = 20 + WidthList(11,2) = cTextBox + WidthList(11,3) = True + + WidthList(12,0) = com.sun.star.sdbc.DataType.LONGVARCHAR ' = -1; + WidthList(12,1) = 20 + WidthList(12,2) = cTextBox + WidthList(12,3) = True + + WidthList(13,0) = com.sun.star.sdbc.DataType.DATE ' = 91; + WidthList(13,1) = 12 + WidthList(13,2) = cDateBox + WidthList(13,3) = False + + WidthList(14,0) = com.sun.star.sdbc.DataType.TIME ' = 92; + WidthList(14,1) = 11 + WidthList(14,2) = cTimeBox + WidthList(14,3) = False + +' Todo: Die folgenden Felder auffüllen! + WidthList(15,0) = com.sun.star.sdbc.DataType.TIMESTAMP ' = 93; +' WidthList(15,1) = +' WidthList(15,2) = + WidthList(15,3) = False + + WidthList(16,0) = com.sun.star.sdbc.DataType.BINARY ' = -2; +' WidthList(16,1) = +' WidthList(16,2) = cImageControl + WidthList(16,3) = False + + WidthList(17,0) = com.sun.star.sdbc.DataType.VARBINARY ' = -3; +' WidthList(17,1) = +' WidthList(17,2) = cImageControl + WidthList(17,3) = False + + WidthList(18,0) = com.sun.star.sdbc.DataType.LONGVARBINARY ' = -4; +' WidthList(18,1) = +' WidthList(18,2) = cImageControl + WidthList(18,3) = False + + WidthList(19,0) = com.sun.star.sdbc.DataType.SQLNULL ' = 0; +' WidthList(19,1) = +' WidthList(19,2) = + WidthList(19,3) = False + + WidthList(20,0) = com.sun.star.sdbc.DataType.OTHER ' = 1111; +' WidthList(20,1) = +' WidthList(20,2) = + WidthList(20,3) = False + + WidthList(21,0) = com.sun.star.sdbc.DataType.OBJECT ' = 2000; +' WidthList(21,1) = +' WidthList(21,2) = + WidthList(21,3) = False + + WidthList(22,0) = com.sun.star.sdbc.DataType.DISTINCT ' = 2001; +' WidthList(22,1) = +' WidthList(22,2) = + WidthList(22,3) = False + + WidthList(23,0) = com.sun.star.sdbc.DataType.STRUCT ' = 2002; +' WidthList(23,1) = +' WidthList(23,2) = + WidthList(23,3) = False + + WidthList(24,0) = com.sun.star.sdbc.DataType.ARRAY ' = 2003; +' WidthList(24,1) = +' WidthList(24,2) = + WidthList(24,3) = False + + WidthList(25,0) = com.sun.star.sdbc.DataType.BLOB ' = 2004; +' WidthList(25,1) = +' WidthList(25,2) = + WidthList(25,3) = False + + WidthList(26,0) = com.sun.star.sdbc.DataType.CLOB ' = 2005; +' WidthList(26,1) = +' WidthList(26,2) = + WidthList(26,3) = False + + WidthList(27,0) = com.sun.star.sdbc.DataType.REF ' = 2006; +' WidthList(27,1) = +' WidthList(27,2) = + WidthList(27,3) = False + + ControlList(cCheckBox) = "CheckBox" ' cBoolean + ControlList(cNumericBox) = "NumericField" ' cFloat, cInteger, cLong, cCounter, cDecimal, cShortInt + ControlList(cCurrencyBox) = "CurrencyField" ' cCurrency + ControlList(cDateBox) = "DateField" + ControlList(cTimeBox) = "TimeField" + ControlList(cTextBox) = "TextField" + ControlList(cImageControl) = "ImageControl" +' Todo: Und was ist hiermit? +'const cLabel = 1 +'const cGridControl = 8 +'const cImageControl = 9 + + oModelService(cLabel) = "com.sun.star.form.component.FixedText" + oModelService(cTextBox) = "com.sun.star.form.component.TextField" + oModelService(cCheckBox) = "com.sun.star.form.component.CheckBox" + oModelService(cDateBox) = "com.sun.star.form.component.DateField" + oModelService(cTimeBox) = "com.sun.star.form.component.TimeField" + oModelService(cNumericBox) = "com.sun.star.form.component.NumericField" + oModelService(cCurrencyBox) = "com.sun.star.form.component.CurrencyField" + oModelService(cGridControl) = "com.sun.star.form.component.GridControl" + oModelService(cImageControl) = "com.sun.star.form.component.DatabaseImageControl" +End Sub + + +Sub LoadLibrary(sLibname as String) +Dim oArg(0) as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/Layouter.xba b/wizards/source/formwizard/Layouter.xba new file mode 100644 index 000000000..ac52f0a5c --- /dev/null +++ b/wizards/source/formwizard/Layouter.xba @@ -0,0 +1,279 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Layouter" script:language="StarBasic">Option Explicit + +' Todo: Testplan: ImageControl an erster Stelle im Array der Feldnamen +' Todo: Durchtesten mit allen möglichen Datentypen in allen möglichen Konstellationen +' Was passiert, wenn Felder jenseits der Ränder positioniert werden? +' Todo: Die ObjektArrays oDBShapeList() und oTCShaplist könnten 3-Dimensional sein mit dem Model und dem Control +' in den anderen beiden Dimensionen +Public oProgressbar as Object +Public ProgressValue as Integer +Public oDocument as Object +Public oController as Object +Public oForm as Object +Public oDrawPage as Object +Public nMaxColRightX as Long +Public nMaxTCWidth as Long +Public nMaxRowRightX as Long +Public nMaxRowY as Long +Public MaxIndex as Integer +Public Const cVertDistance = 200 +Public Const cHoriDistance = 300 + +Public nPageWidth as Long +Public nPageHeight as Long +Public nFormWidth as Long +Public nFormHeight as Long +Public nMaxHoriPos as Long +Public nMaxVertPos as Long + +Public CONST SBALIGNLEFT = 0 +Public CONST SBALIGNRIGHT = 2 + +Public Const SBNOBORDER = 0 +Public Const SB3DBORDER = 1 +Public Const SBSIMPLEBORDER = 2 + +Public CurArrangement as Integer +Public CurBorderType as Integer +Public CurAlignmode as Integer + +Public OldArrangement as Integer +Public Const cColumnarLeft = 1 +Public Const cColumnarTop = 2 +Public Const cLeftJustified = 3 +Public Const cTopJustified = 4 +Public Const cTabled = 5 +Public Const cXOffset = 1000 +Public Const cYOffset = 700 +' This is the viewed space that we lose because of the symbol bars +Public Const cSymbolMargin = 2000 +Public Const MaxFieldIndex% = 200 + +Public Const cControlCollectionCount = 9 +Public Const cLabel = 1 +Public Const cTextBox = 2 +Public Const cCheckBox = 3 +Public Const cDateBox = 4 +Public Const cTimeBox = 5 +Public Const cNumericBox = 6 +Public Const cCurrencyBox = 7 +Public Const cGridControl = 8 +Public Const cImageControl = 9 + +Public Styles(8, 50) as String +Public FieldMetaValues(MaxFieldIndex,2) as String +' Description of this List: +' FieldMetaValues(0-MaxFieldIndex,0) (Datafieldtype) +' FieldMetaValues(0-MaxFieldIndex,1) (Datafieldlength) +' FieldMetaValues(0-MaxFieldIndex,2) (ControlType eg. cLabel, cTextbox usw.) + +Public FieldNames(MaxFieldIndex) as string +Public oModelService(cControlCollectionCount) as String +Public oGridModel as Object + +' field label postfix (the label ist the data source followed by a postfix) +Public nFieldPostfixes (MaxFieldIndex%) as string + + +Function InsertControl (oControlObject as object, aPoint as Object, aSize as Object) +Dim oShape as object + oShape = oDocument.CreateInstance ("com.sun.star.drawing.ControlShape") + oShape.Size = aSize + oShape.Position = aPoint + oShape.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PARAGRAPH + oShape.control = oControlObject + oDrawPage.Add (oShape) + InsertControl = oShape +End Function + + +Function ArrangeControls() +Dim oShape as Object +Dim i as Integer +' Todo: Was haben diese Postfixes zu bedeuten? +' nFieldPostfixes() = nFldLabelPostfixes$() + oProgressbar = oDocument.GetCurrentController.GetFrame.CreateStatusIndicator + oProgressbar.Start("", MaxIndex) + If OldArrangement = cTabled Then + oGridshape.Dispose + End If + ToggleLayoutPage(False) +' oDocument.LockControllers + Select Case CurArrangement + Case cTabled + PositionGridControl(MaxIndex) + Case Else + PositionControls(MaxIndex) + End Select +' oDocument.UnlockControllers + ToggleLayoutPage(True) + oProgressbar.End + Exit Function + +ErrorAndCloseForm: + ToggleWindow(True) + MsgBox(Form_gErrMsg$, 16, Form_gWizardName$) + oDocument.Dispose() + Stop + exit function +End function + + +Sub OpenBaseDocument() +Dim NoArgs() as new com.sun.star.beans.PropertyValue +Dim aPageSize As New com.sun.star.awt.Size +Dim aSize As New com.sun.star.awt.Size +Dim oViewSettings as Object +Dim oPageStyle as Object + + oDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 0, NoArgs()) + oController = oDocument.GetCurrentController + oViewSettings = oDocument.CurrentController.ViewSettings +' oDocument.LockControllers + oViewSettings.ShowTableBoundaries = False + oViewSettings.ShowTextBoundaries = False + oViewSettings.ShowOnlineLayout = True + oViewSettings.ShowHoriRuler = True +' oCursor = oDocument.Text.CreateTextCursor +' oCursor.InsertDocumentfromURL(FileStr, NoArgs()) + oDrawPage = oDocument.DrawPage + oPageStyle = oDocument.StyleFamilies.GetByName("PageStyles").GetByName("Standard") + oPageStyle.IsLandscape = True +' Todo: Prozedur schreiben um Seite auf Landscape/Portrait zu setzen + aPageSize = oPageStyle.Size + nPageWidth = aPageSize.Width + nPageHeight = aPageSize.Height + aSize.Width = nPageHeight + aSize.Height = nPageWidth + oPageStyle.Size = aSize + nPageWidth = nPageHeight + nPageHeight = oPageStyle.Size.Height + ' Todo: Es könnte der unterste Grenze in Abhängigkeit von der Anzahl der DB-Felder bestimmt werden. + nFormWidth = nPageWidth - oPageStyle.RightMargin - oPageStyle.LeftMargin - 2 * cXOffset + nFormHeight = nPageHeight - oPageStyle.TopMargin - oPageStyle.BottomMargin - 2 * cYOffset - cSymbolMargin +End Sub + + +' Modify the Borders of the Controls +Sub ChangeBorderLayouts(oEvent as Object) +Dim oModel as Object +Dim OldBorderType as Integer +Dim i as Integer +Dim oCurModel as Object + ToggleLayoutPage(False) + oDocument.LockControllers + OldBorderType = CurBorderType + oModel = oEvent.Source.Model + CurBorderType = oModel.Tag +' Todo: Die Grafikurl des Controls umsetzen, ebenso wie die Grafikurl des +' alten Controls + If OldBorderType <> CurBorderType Then + For i = 0 To MaxIndex + oCurModel = oDBShapeList(i).GetControl + If oCurModel.PropertySetInfo.HasPropertyByName("Border")Then + oCurModel.Border = CurBorderType + End If + Next i + End If + oDocument.UnLockControllers + ToggleLayoutPage(True) +End Sub + + +Sub ChangeLabelAlignments(oEvent as Object) +Dim i as Integer +Dim oCurModel as Object +Dim OldAlignMode as Integer +Dim oModel as Object + ToggleLayoutPage(False) + oDocument.LockControllers() + OldAlignMode = CurAlignMode + oModel = oEvent.Source.Model + CurAlignMode = oEvent.Source.Model.Tag + ' Todo: Es muss festgestellt werden, welches Imagecontrol vorher selectiert war + ' und die GrafikUrls müssen entsprechend angepasst werden. + If OldAlignMode <> CurAlignMode Then + For i = 0 To MaxIndex + oCurModel = oTCShapeList(i).GetControl + oCurModel.Align = CurAlignmode + Next i + End If + oDocument.UnlockControllers() + ToggleLayoutPage(True) +End Sub + + +Sub ChangeArrangemode(oEvent as Object) +Dim oModel as Object + OldArrangement = CurArrangement + oModel = oEvent.Source.Model + oModel.Border = SB3DBORDER + CurArrangement = oModel.Tag + If CurArrangement <> OldArrangement Then + ArrangeControls() + Select Case OldArrangement + Case cTabled + ToggleBorderGroup(True) + ToggleAlignGroup(True) + Case cColumnarTop, cTopJustified, cLeftJustified + ToggleAlignGroup(True) + End Select + + Select Case CurArrangement + Case cTabled + ToggleBorderGroup(False) + ToggleAlignGroup(False) + Case cColumnarTop,cLeftJustified, cTopJustified + ToggleAlignGroup(False) + End Select + End If +End Sub + + +Sub ToggleBorderGroup(bDoEnable as Boolean) + oDialogModel.frmBorderLayout.Enabled = bDoEnable + oDialogModel.imgBorder0.Enabled = bDoEnable + oDialogModel.imgBorder1.Enabled = bDoEnable + oDialogModel.imgBorder2.Enabled = bDoEnable +End Sub + + +Sub ToggleAlignGroup(bDoEnable as Boolean) + oDialogModel.frmAlign.Enabled = bDoEnable + oDialogModel.imgAlign0.Enabled = bDoEnable + oDialogModel.imgAlign2.Enabled = bDoEnable +End Sub + + +Sub ToggleLayoutPage(bDoEnable as Boolean) + oDialogModel.frmArrangements.Enabled = bDoEnable + oDialogModel.imgArrange1.Enabled = bDoEnable + oDialogModel.imgArrange2.Enabled = bDoEnable + oDialogModel.imgArrange3.Enabled = bDoEnable + oDialogModel.imgArrange4.Enabled = bDoEnable + oDialogModel.imgArrange5.Enabled = bDoEnable + oDialogModel.lblStyles.Enabled = bDoEnable + oDialogModel.frmBackground.Enabled = bDoEnable + oDialogModel.optTiled.Enabled = bDoEnable + oDialogModel.optArea.Enabled = bDoEnable + oDialogModel.cmdHelp.Enabled = bDoEnable + oDialogModel.cmdBack.Enabled = bDoEnable + oDialogModel.cmdGoOn.Enabled = bDoEnable + oDialogModel.imgTheme.Enabled = bDoEnable + ToggleAlignGroup(bDoEnable) + ToggleBorderGroup(bDoEnable) +End Sub + + +Sub DestroyControlShapes(oDrawPage as Object) +Dim i as Integer +Dim oShape as Object + For i = oDrawPage.Count-1 To 0 Step -1 + oShape = oDrawPage.GetByIndex(i) + If oShape.ShapeType = "com.sun.star.drawing.ControlShape" Then + oShape.Dispose + End If + Next i +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/develop.xba b/wizards/source/formwizard/develop.xba new file mode 100644 index 000000000..1f58e986c --- /dev/null +++ b/wizards/source/formwizard/develop.xba @@ -0,0 +1,440 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="develop" script:language="StarBasic">REM ***** BASIC ***** +Public oDBShapeList(200) as Object +Public oTCShapeList(200) as Object +Public oGridShape as Object +Public a as Integer +Public StartA as Integer +Public bIsFirstRun as Boolean +Public bIsVeryFirstRun as Boolean + +Public bIsVeryFirstValueField as Boolean +' This boolean variable refers to the following Controltypes: cTextBox, cCheckBox, cDateBox, cTimeBox, cNumericBox, cCurrencyBox + +Public bControlsareCreated as Boolean +Public nDBRefWidth as Integer +Public nDBRefHeight as Integer +Public nXTCPos&, nYTCPos&, nXDBPos&, nYDBPos&, nTCHeight&, nTCWidth&, nDBHeight&, nDBWidth& +Public CurControlType as Integer +Public CurFieldlength as Double +Public CurFieldType as Integer +Public CurFieldName as String +Dim iReduceWidth as Integer + +Function PositionControls(Maxindex as Integer) +Dim oTCModel as Object +Dim oDBModel as Object +Dim i as Integer + InitializePosSizes() + bIsFirstRun = True + bIsVeryFirstRun = True + bIsVeryFirstValueField = True + a = 0 + StartA = 0 + For i = 0 To MaxIndex + CurFieldType = FieldMetaValues(i,0) + CurFieldLength = CDbl(FieldMetaValues(i,1)) + CurControlType = FieldMetaValues(i,2) + CurFieldName = FieldNames(i) + oTCModel = InsertTextControl(i) + InsertDBControl(oDBModel, i) + bIsVeryFirstRun = False + oDBModel.LabelControl = oTCModel + ResetPosSizes(i) + oProgressbar.Value = i + Next i +' ControlCaptionstoStandardLayout() + bControlsareCreated = True +End Function + + +Sub ResetPosSizes(LastIndex as Integer) + Select Case CurArrangement + Case cColumnarLeft + nYDBPos = nYDBPos + nDBHeight + cVertDistance + If (nYDBPos > cYOffset + nFormHeight) Or (LastIndex = MaxIndex) Then + RepositionControls(LastIndex) + nXDBPos = nMaxColRightX + cHoriDistance + nMaxTCWidth + nXTCPos = nMaxColRightX + cHoriDistance + nYDBPos = cYOffset + nYTCPos = cYOffset + bIsFirstRun = True + StartA = a + 1 + a = 0 + Else + a = a + 1 + End If + nYTCPos = nYDBPos + Case cColumnarTop + nYTCPos = nYDBPos + nDBHeight + cVertDistance + If nYTCPos > cYOffset + nFormHeight Then + nXDBPos = nMaxColRightX + cHoriDistance + nXTCPos = nMaxColRightX + cHoriDistance + nYDBPos = cYOffset + nTCHeight + cVertiDistance + nYTCPos = cYOffset + bIsFirstRun = True + StartA = a + 1 + a = 0 + Else + a = a + 1 + End If + Case cLeftJustified,cTopJustified + If nMaxColRightX > cXOffset + nFormWidth Then + Dim nOldYTCPos as Long + nOldYTCPos = nYTCPos + CheckJustifiedPosition() + Else + nXTCPos = nMaxColRightX + CHoriDistance + End If + a = a + 1 + End Select +End Sub + + +Sub RepositionControls(LastIndex as Integer) +Dim aSize As New com.sun.star.awt.Size +Dim aPoint As New com.sun.star.awt.Point +Dim i as Integer +Dim oLocTextShape as Object +Dim oLocDBShape as Object + aSize = GetSize(nMaxTCWidth, nTCHeight) + For i = StartA To LastIndex + Set oLocTextShape = oTCShapeList(i) + Set oLocDBShape = oDBShapeList(i) + oLocTextShape.Size = aSize + If i = StartA Then + nXTCPos = oLocTextShape.Position.X + nXDBPos = nXTCPos + nMaxTCWidth + cHoriDistance + End If + nYDBPos = oLocTextShape.Position.Y + aPoint = GetPoint(nXDBPos,nYDBPos) + oLocDBShape.SetPosition(aPoint) + GroupShapes(oDrawPage, oLocTextShape, oLocDBShape) + Next i +End Sub + + +Sub InitializePosSizes() + nXTCPos = cXOffset + nYTCPos = cYOffset + nTCWidth = 2000 + nTCHeight = 560 + nDBWidth = 2000 + nDBHeight = 560 + iReduceWidth = 0 + Select Case CurArrangement + Case cColumnarLeft, cLeftJustified + nXDBPos = cXOffset + 3050 + nYDBPos = cYOffset + Case cColumnarTop, cTopJustified + nXDBPos = cXOffset + End Select +End Sub + + +Function InsertTextControl(i as Integer) as Object +Dim oShape as Object +Dim oModel as Object +Dim aPoint as New com.sun.star.awt.Point +Dim aSize As New com.sun.star.awt.Size + + If bControlsareCreated Then + Set oShape = oTCShapeList(i) + Set oModel = oShape.GetControl + nTCWidth = oShape.Size.Width + nTCHeight = oShape.Size.Height + oShape.Position = GetPoint(nXTCPos, nYTCPos) + Else + oModel = CreateUnoService(oModelService(cLabel)) + oModel.Name ="Label" + (i+1) + oModel.Label = CurFieldName ' + nFieldPostfixes(i) (Todo: Was ist ein fieldPostfix?) + oDBForm.InsertByName(oModel.Name, oModel) + aPoint = GetPoint(nXTCPos, nYTCPos) + aSize = GetSize(nTCWidth,nTCHeight) + Set oShape = InsertControl(oModel, aPoint, aSize) + Set oTCShapeList(i)= oShape + If bIsVeryFirstRun Then + nTCHeight = GetPreferredHeight(oModel, CurFieldname) + If CurArrangement = cColumnarTop Then + nYDBPos = nYTCPos + nTCHeight + End If + End If + End If + nTCWidth = GetPreferredWidth(oModel, True, CurFieldname) + CheckOuterPoints(oShape.Position.X, nTCWidth, nYTCPos, nTCHeight) + Select Case CurArrangement + Case cLeftJustified + nXDBPos = nMaxColRightX + Case cColumnarLeft + If bIsFirstRun Then + nMaxTCWidth = nTCWidth + bIsFirstRun = False + ElseIf nTCWidth > nMaxTCWidth Then + nMaxTCWidth = nTCWidth + End If + Case cColumnarTop,cTopJustified + nXDBPos = nXTCPos + nYDBPos = nYTCPos + nTCHeight + + If CurFieldLength = 20 And nDBWidth > 2 * nTCWidth Then + iReduceWidth = iReduceWidth + 1 + End If + End Select + oShape.SetSize(GetSize(nTCWidth,nTCHeight)) + InsertTextControl = oModel +End Function + + +Sub InsertDBControl(oDBModel as Object, i as Integer) +Dim aPoint as New com.sun.star.awt.Point +Dim aSize As New com.sun.star.awt.Size +Dim oShape as Object +Dim oControl as Object +Dim iColRightX as Long + + If Not bIsVeryFirstValueField Then + nDBWidth = CInt(CurFieldLength/2 * nDBRefWidth) + Else + nDBWidth = 1 + End If + aPoint = GetPoint(nXDBPos, nYDBPos) + If bControlsAreCreated Then + Set oShape = oDBShapeList(i) + Set oDBModel = oShape.GetControl + oShape.Position = aPoint + Else + aSize = GetSize(nDBWidth,nDBHeight) + oDBModel = CreateUnoService(oModelService(CurControlType)) + oDBModel.Name = ControlList(CurControlType) + ' ToDo: Diese (recht allgemein benamte) Prozedur mit Hilfe von FS anpassen + HandleNumerics(oDBModel) + oShape = InsertControl(oDBModel, aPoint, aSize) + Set oDBShapeList(i)= oShape + oDBForm.InsertByName(oDBModel.Name, oDBModel) + End If + If CurControlType = cImageControl Then + ' Todo: Dies ist nur eine vorsichtige Schätzung + nDBWidth = 2000 + nDBHeight = 2000 + Else + If bIsVeryFirstValueField Then + nDBRefWidth = GetPreferredWidth(oDBModel,True) + ' Todo: Hier wird vereinfachend davon ausgegangen, dass es sich bei DB-Feldern immer um Textfelder handelt! + nDBRefHeight = GetPreferredHeight(oDBModel) + bIsVeryFirstValueField = False + End If + 'Todo: Vielleicht könnte man dieses Feld auch noch tiefer machen + If CurFieldType = com.sun.star.sdbc.DataType.LONGVARCHAR Then + oDBModel.MultiLine = True + nDBHeight = nDBRefHeight * 2 + Else + nDBHeight = nDBRefHeight + End If + nDBWidth = CInt(CurFieldLength/10 * nDBRefWidth) + End If + aSize = GetSize(nDBWidth,nDBHeight) + oShape.SetSize(aSize) + CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight) + oDBModel.DataField = CurFieldName +End Sub + + +Sub CheckJustifiedPosition() +Dim nLeftDist as Long +Dim nRightDist as Long +Dim oLocDBShape as Object +Dim oLocTextShape as Object +Dim nBaseWidth as Long + nBaseWidth = nFormWidth + cXOffset + + nLeftDist = nMaxColRightX - nBaseWidth + nRightDist = nBaseWidth - nXTCPos + cHoriDistance + If nLeftDist < 0.5 * nRightDist and iReduceWidth > 2 Then + ' Können die Felder in der Reihe gestaucht werden? + AdjustLineWidth(StartA, a, nLeftDist, - 1) + If CurArrangement = cLeftjustified Then + nYDBPos = nMaxRowY + cVertDistance + nYTCPos = nYDBPos + nXTCPos = cXOffset + Else + nYTCPos = nMaxRowY + cVertDistance + nYDBPos = nYTCPos + nTCHeight + nXTCPos = cXOffset + nXDBPos = cXOffset + End If + bIsFirstRun = True + StartA = a + 1 + Else + Set oLocDBShape = oDBShapeList(a) + Set oLocTextShape = oTCShapeList(a) + nYTCPos = nMaxRowY + cVertDistance + If CurArrangement = cLeftJustified Then + nYDBPos = nYTCPos + nXDBPos = cXOffset + nTCWidth + oLocTextShape.Position = GetPoint(cXOffset, nYTCPos) + oLocDBShape.Position = GetPoint(nXDBPos, nYDBPos) + ' PosSizes for the next two Controls + nXTCPos = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance + bIsFirstRun = True + CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight) + nXDBPos = nMaxColRightX + cHoriDistance + Else + nYDBPos = nYTCPOS + nTCHeight + nXDBPos = cXOffset + nXTCPos = cXOffset + oLocTextShape.Position = GetPoint(cXOffset, nYTCPos) + oLocDBShape.Position = GetPoint(cXOffset, nYDBPos) + bIsFirstRun = True + If nDBWidth > nXTCWidth Then + CheckOuterPoints(nXDBPos, nDBWidth, nYDBPos, nDBHeight) + Else + CheckOuterPoints(nXDBPos, nTCWidth, nYDBPos, nDBHeight) + End If + nXTCPos = nMaxColRightX + cHoriDistance + nXDBPos = nXTCPos + End If + AdjustLineWidth(StartA, a-1, nRightDist, 1) + StartA = a + End If + iReduceWidth = 0 +End Sub + + +Sub AdjustLineWidth(StartIndex as Integer, EndIndex as Integer, nDist as Long, Widthfactor as Integer) +Dim i as Integer +Dim oLocDBShape as Object +Dim oLocTCShape as Object +Dim CorrWidth as Integer +Dim bAdjustPos as Boolean +Dim iLocTCPosX as Long +Dim iLocDBPosX as Long +Dim ShapeCount as Integer +' Todo: Hier muss berücksichtigt werden, dass gewisse Widths z.B für numerische Controls nicht plötzlich zu klein werden +' Am besten werden nur TextControls gestaucht, so dass vorher geschaut werden muss, ob überhaupt TextControls vorhanden +' sind + If WidthFactor > 0 Then + ShapeCount = EndIndex-StartIndex + 1 + Else + ShapeCount = iReduceWidth + End If + CorrWidth = (nDist)/ShapeCount + bAdjustPos = False + iLocTCPosX = cXOffset + For i = StartIndex To EndIndex + Set oLocDBShape = oDBShapeList(i) + Set oLocTCShape = oTCShapeList(i) + If bAdjustPos Then + oLocTCShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y) + If CurArrangement = cLeftJustified Then + iLocDBPosX = oLocTCShape.Position.X + oLocTCShape.Size.Width + oLocDBShape.Position = GetPoint(iLocDBPosX, oLocDBShape.Position.Y) + Else + oLocDBShape.Position = GetPoint(iLocTCPosX, oLocTCShape.Position.Y + nTCHeight) + End If + Else + bAdjustPos = True + End If + If CDbl(FieldMetaValues(i,1)) > 20 or WidthFactor > 0 Then + oLocDBShape.Size = GetSize(oLocDBShape.Size.Width + WidthFactor * CorrWidth, oLocDBShape.Size.Height) + End If + iLocTCPosX = oLocDBShape.Position.X + oLocDBShape.Size.Width + cHoriDistance + Next i +End Sub + + +Sub CheckOuterPoints(nXPos, nWidth, nYPos, nHeight) +Dim nColRightX +Dim nRowY + If CurArrangement = cLeftJustified Or CurArrangement = cTopJustified Then + If bIsFirstRun Then + nMaxRowY = nYPos + nHeight + Else + nRowY = nYPos + nHeight + If nRowY > nMaxRowY Then + nMaxRowY = nRowY + End If + End If + End If + ' Find the outer right point + If bIsFirstRun Then + nMaxColRightX = nXPos + nWidth + bIsFirstRun = False + Else + nColRightX = nXPos + nWidth + If nColRightX > nMaxColRightX Then + nMaxColRightX = nColRightX + End If + End If +End Sub + + +Function PositionGridControl(MaxIndex as Integer) +Dim oControl as Object +Dim n as Integer +Dim oColumn as Object +Dim aPoint as New com.sun.star.awt.Point +Dim aSize as New com.sun.star.awt.Size +Dim ControlName as String +Dim nWidth as Long + If bControlsareCreated Then + MakeControlsVisible(False) + End If + oGridModel = CreateUnoService(oModelService(cGridControl)) + nWidth = 0 + For n = 0 to MaxIndex + CurType = FieldMetaValues(n,0) + CurControlType = FieldMetaValues(n,2) + CurFieldName = FieldNames(n) + ControlName = ControlList(CurControlType) + oColumn = oGridModel.CreateColumn(ControlName) + oColumn.Name = CalcUniqueContentName(oGridModel, ControlName) +' Todo: Put this in a separate function + HandleNumerics(oColumn) + oColumn.DataField = CurFieldName + oColumn.Label = CurFieldName '+ nFieldPostfixes(n); Todo: Was hat das nFieldPostfix hier zu suchen? + oColumn.Width = 0 'Spaltenbreite richtet sich nach dem Feldnamen + oGridModel.insertByName(oColumn.Name, oColumn) + oProgressbar.Value = n + nWidth = nWidth + oColumn.Width + next n + aPoint = GetPoint(cXOffset, cYOffset) + ' Todo: Man müsste die Größe und die Position der Controls von der Anzahl der + ' Datenbankfelder abhängig machen + aSize = GetSize(nFormWidth, nFormHeight) + oDBForm.InsertByName (oGridModel.Name, oGridModel) + oGridShape = InsertControl (oGridModel, aPoint, aSize) +End function + + +Sub ControlCaptionstoStandardLayout() +Dim i as Integer +Dim iBorderType as Integer +Dim oCurModel as Object +Dim oStyle as Object +Dim iStandardColor as Long + If CurArrangement <> cTabled Then + oStyle = oDocument.StyleFamilies.GetByName("ParagraphStyles").GetByName("Standard") + iStandardColor = oStyle.CharColor + For i = 0 To MaxIndex + oCurModel = oTCShapeList(i).GetControl + If i = 0 Then + If oCurModel.TextColor = iStandardColor Then + Exit Sub + End If + End If + oCurModel.TextColor = iStandardColor + Next i + End If +End Sub + + +Sub GroupShapes(oDrawPage as Object, TextShape as Object, DBShape as Object) +Dim oShapes as Object + oShapes = createUnoService("com.sun.star.drawing.ShapeCollection") + oShapes.Add(oLocTextShape) + oShapes.Add(oLocDBShape) + oDrawPage.Group(oShapes) +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/formwizard/tools.xba b/wizards/source/formwizard/tools.xba new file mode 100644 index 000000000..86c12e09b --- /dev/null +++ b/wizards/source/formwizard/tools.xba @@ -0,0 +1,160 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="tools" script:language="StarBasic">REM ***** BASIC ***** + + +Function SetProgressValue(iValue as Integer) + If iValue = 0 Then + oProgressbar.End + End If + ProgressValue = iValue + oProgressbar.Value = iValue +End Function + + +Function GetPreferredWidth(oModel as Object, bGetMaxWidth as Boolean, Optional LocText) +Dim aPeerSize as new com.sun.star.awt.Size +Dim nWidth as Integer +Dim oControl as Object +' Todo: Wie geht das mit ImageControls + If Not IsMissing(LocText) Then + aPeerSize = GetPeerSize(oModel, oControl, LocText) + Else + aPeerSize = GetPeerSize(oModel, oControl + End If + nWidth = aPeerSize.Width + GetPreferredWidth = PixelTo100thmm(nWidth) +End Function + + +Function GetPreferredHeight(oModel as Object, Optional LocText) +Dim aPeerSize as new com.sun.star.awt.Size +Dim nHeight as Integer +Dim oControl as Object +' Todo: Wie geht das mit ImageControls + If Not IsMissing(LocText) Then + aPeerSize = GetPeerSize(oModel, oControl, LocText) + Else + aPeerSize = GetPeerSize(oModel, oControl) + End If + nHeight = aPeerSize.Height + GetPreferredHeight = PixelTo100thmm(nHeight) +End Function + + +Function GetPeerSize(oModel as Object, oControl as Object, Optional LocText) +Dim oPeer as Object +Dim aPeerSize as new com.sun.star.awt.Size + oControl = oController.GetControl(oModel) + oPeer = oControl.GetPeer() + If HasUnoInterfaces(oControl,"com.sun.star.awt.XNumericField") Then + oControl.Value = oControl.Max + aPeerSize = oPeer.PreferredSize() + oControl.Value = 0 + ElseIf Not IsMissing(LocText) Then + oControl.Text = LocText + aPeerSize = oPeer.PreferredSize() + Else + oControl.Text = "WWWWWWWWWW" + aPeerSize = oPeer.PreferredSize() + oControl.Text = "" + End If + GetPeerSize = aPeerSize +End Function + + +Function TwipToCM(BYVAL nValue as long) as String + TwipToCM = trim(str(nValue / 567)) + "cm" +End function + + +Function TwipTo100telMM(BYVAL nValue as long) as long + TwipTo100telMM = nValue / 0.567 +End function + + +Function TwipToPixel(BYVAL nValue as long) as long ' nur ungefaehre Berechnung + TwipToPixel = nValue / 15 +End function + + +Function PixelTo100thMM(BYVAL nValue as long) as long + PixelTo100thMM = nValue * 28 ' nur ungefähre Berechnung +End function + + +Function GetPoint(xPos, YPos) as New com.sun.star.awt.Point +Dim aPoint as New com.sun.star.awt.Point + aPoint.X = xPos + aPoint.Y = yPos + GetPoint() = aPoint +End Function + + +Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size +Dim aSize As New com.sun.star.awt.Size + aSize.Width = iWidth + aSize.Height = iHeight + GetSize() = aSize +End Function + + +Sub ImportStyles() +Dim CurIndex as Integer +Dim sImportPath as String + oDocument.LockControllers + CurIndex = GetCurIndex(oDialogModel.lstStyles, Styles(), NumberofStyles,8) + sImportPath = Styles(8,CurIndex) + LoadNewStyles(oDocument, oDialogModel, CurIndex, "", Styles(), TexturePath) + ' Todo: Diese Zeile wieder rein wenn Bug #83015 behoben ist +' ControlCaptionsToStandardLayout() + oDocument.UnlockControllers +End Sub + + +' Todo: Einbinden!!! +Function SetMaxNumericValue(ByVal oLocObject as Object, nType as Long) as Object + oLocObject.DecimalAccuracy = 0 ' keine Nachkommastellen + oLocObject.ValueMin = 0 ' Minwerte sind 0 + select Case (nType) + case cLong + oLocObject.ValueMax = 2147483647 ' Maxwert + case cInteger + oLocObject.ValueMax = 32767 ' Maxwert + case cShortInt + oLocObject.ValueMax = 255 ' Maxwert + case cDecimal + oLocObject.DecimalAccuracy = FieldDecimalAccuracy%(n%) ' Nachkommastellen + End Select + SetMaxColumnValue = oLocObject +End Function + + +Sub MakeControlsVisible(bIsVisible as Boolean) +Dim n as Integer +Dim oControl as Object + For n = 0 To MaxIndex + oControl = oController.GetControl(oDBShapeList(n).GetControl) + oControl.SetVisible(bIsVisible) + oControl = oController.GetControl(oTCShapeList(n).GetControl) + oControl.SetVisible(bIsVisible) + Next n +End Sub + + +' Todo: Hier werden allgemeine Einstellungen für numerische Werte vorgenommen +' Was wird mit den Währungen gemacht?; für Dezimalfelder muss die Anzahl der +' Nachkommastellen, Tausenderstellen, festgelegt werden. Stichwort "Formatüberprüfungen" +' im Propertybrowser des Controls +Sub HandleNumerics(oObject) + Select Case CurControlType + Case cNumericBox + oLocObject = SetMaxNumericValue(oLocObject, CurFieldType) + Case cCurrencyBox + oLocObject.CurrencySymbol = s_aCurrencySymbol + oLocObject.PrependCurrencySymbol = s_aPrependCurrencySymbol + End Select +End Sub + + +</script:module>
\ No newline at end of file diff --git a/wizards/source/gimmicks/AutoText.xba b/wizards/source/gimmicks/AutoText.xba new file mode 100644 index 000000000..e40a3f8a7 --- /dev/null +++ b/wizards/source/gimmicks/AutoText.xba @@ -0,0 +1,83 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="AutoText" script:language="StarBasic">' BASIC +Option Explicit + +' Todo: Problem mit der Spaltenbreite lösen +' Internationale Vorlage für Überschrift +Sub Main +Dim oDocument, oTable, oRows, oDocuText, oTitleCursor as Object +Dim oAutoTextContainer, oAutogroup, oAutoText as Object +Dim oCharStyles, oContentStyle, oHeaderStyle, oGroupTitleStyle as Object +Dim n, m, iAutoCount as Integer + + LoadLibrary("tools") + LoadLanguage(StarDesktop.ISOLocale.Language) + + ' Open a new empty document + oDocument = StarDesktop.LoadComponentFromURL("staroffice:factory/swriter","_blank",0,NoArgs) + oDocuText = oDocument.Text + + ' Create The Character-templates + oCharStyles = oDocument.StyleFamilies.GetByName("CharacterStyles") + + ' The Characterstyle for the Header that describes the Title of Autotextgroups + oGroupTitleStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle") + oGroupTitleStyle.charWeight = com.sun.star.awt.FontWeight.BOLD + oGroupTitleStyle.CharHeight = 14 + oCharStyles.InsertbyName("AutoTextGroupTitle", oGroupTitleStyle) + + ' The Characterstyle for the Header that describes the Title of Autotextgroups + oHeaderStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle") + oHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD + oCharStyles.InsertbyName("AutoTextHeading", oHeaderStyle) + + ' "Ordinary" Table Content + oContentStyle = oDocument.createInstance("com.sun.star.style.CharacterStyle") + oCharStyles.InsertbyName("TableContent", oContentStyle) + + oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer") + + oTitleCursor = oDocuText.CreateTextCursor() + oTitleCursor.CharStyle = "AutoTextGroupTitle" + ' Link the Title with the following table + oTitleCursor.ParaKeepTogether = True + + For n = 0 To oAutoTextContainer.Count - 1 + oAutoGroup = oAutoTextContainer.GetByIndex(n) + + oTitleCursor.SetString(oAutoGroup.Title) + oTitleCursor.CollapseToEnd() + oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + oTable = oDocument.CreateInstance("com.sun.star.text.TextTable") + ' Divide the table if necessary + oTable.Split = True +' oTable.KeepTogether = False + oTable.RepeatHeadLine = True + oTitleCursor.Text.InsertTextContent(oCursor,oTable,False) + InsertStringToCell("AutoText-Title",oTable.GetCellbyPosition(0,0), "AutoTextHeading") + InsertStringToCell("AutoText-Name",oTable.GetCellbyPosition(1,0), "AutoTextHeading") + ' Insert one row at the bottom of the table + oRows = oTable.Rows + iAutoCount = oAutoGroup.Count + For m = 0 To iAutoCount-1 + ' Insert the name and the title of all Autotexts + oAutoText = oAutoGroup.GetByIndex(m) + InsertStringToCell(oAutoGroup.Titles(m), oTable.GetCellbyPosition(0, m + 1), "TableContent") + InsertStringToCell(oAutoGroup.ElementNames(m), oTable.GetCellbyPosition(1, m + 1), "TableContent") + If m < iAutoCount-1 Then + oRows.InsertbyIndex(m + 2,1) + End If + Next m + oDocuText.insertControlCharacter(oCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + oCursor.CollapseToEnd() + Next n +End Sub + + +Sub InsertStringToCell(sCellString as String, oCell as Object, sCellStyle as String) +Dim oCellCursor as Object + oCellCursor = oCell.CreateTextCursor() + oCellCursor.CharStyle = sCellStyle + oCell.Text.insertString(oCellCursor,sCellString,False) +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/gimmicks/ChangeAllChars.xba b/wizards/source/gimmicks/ChangeAllChars.xba new file mode 100644 index 000000000..69dcd32b1 --- /dev/null +++ b/wizards/source/gimmicks/ChangeAllChars.xba @@ -0,0 +1,130 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ChangeAllChars" script:language="StarBasic">' This macro replaces all characters in a writer-documet through "x" or "X" signs. +' It works on the currently activated document. +Private const UPPERREPLACECHAR = "X" +Private const LOWERREPLACECHAR = "x" + +Private MSGBOXTITLE +Private NOTSAVEDTEXT +Private WARNING + +Sub ChangeAllChars ' Change all chars in the active document +Dim oSheets, oPages as Object +Dim i as Integer +Const MBYES = 6 +Const MBABORT = 2 +Const MBNO = 7 + LoadLibrary("tools") + Call SetLanguage + + On Local Error GoTo NODOCUMENT + oDocument = StarDesktop.ActiveFrame.Controller.Model + NODOCUMENT: + If Err <> 0 Then + Msgbox("This Macro extracts all Data of a displayed Writer-Document." & chr(13) & "Activate a Writer-Document!" , 16, "StarOffice 5.2") + Exit Sub + End If + On Local Error Goto 0 + + sDocType = GetDocumentType(oDocument) + + If oDocument.IsModified And oDocument.Url <> "" Then + Status = MsgBox(NOTSAVEDTEXT, 3+32, MSGBOXTITLE) + Select Case Status + Case MBYES + oDocument.Store + Case MBABORT, MBNO + End + End Select + Else + Status = MsgBox(WARNING, 3+32, MSGBOXTITLE) + If Status = MBNO Or Status = MBABORT Then ' No, Abort + End + End If + End If + + Select Case sDocType + Case "sWriter" + ReplaceAllStrings(oDocument) + + Case Else + Msgbox("This Macro only works with Writer-Documents!", 16, "StarOffice 5.2") + End Select +End Sub + + +Sub ReplaceAllStrings(oContainer as Object) + ReplaceStrings(oContainer, "[a-z]", LOWERREPLACECHAR) + ReplaceStrings(oContainer, "[à-þ]", LOWERREPLACECHAR) + ReplaceStrings(oContainer, "[A-Z]", UPPERREPLACECHAR) + ReplaceStrings(oContainer, "[À-ß]", UPPERREPLACECHAR) + ReplaceStrings(oContainer, "[0-9]", UPPERREPLACECHAR) +End Sub + + +Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString as String) + oReplaceDesc = oContainer.createReplaceDescriptor() + oReplaceDesc.SearchCaseSensitive = True + oReplaceDesc.SearchRegularExpression = True + oReplaceDesc.Searchstring = sSearchString + oReplaceDesc.ReplaceString = sReplaceString + oReplCount = oContainer.ReplaceAll(oReplaceDesc) +End Sub + + +Sub SetLanguage +Dim ISOLanguage as String + ISOLanguage = StarDesktop.ISOLocale.Language + + Select Case ISOLanguage + + Case "en" + MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?" + WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document." + + Case "fr" + MSGBOXTITLE = "Remplacer tous les caractères par '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "Le document a été modifé, la macro remplacera tous les caractères par '" & UPPERREPLACECHAR & "'. Enregistrer avant de procéder?" + WARNING = "La macro remplacera tous les caractères et nombres par '" & UPPERREPLACECHAR & "' dans le document." + + Case "it" + MSGBOXTITLE = "Sostituire tutti i caratteri '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "Il documento è stato modificato, la macro sostituerà tutti i caratteri con '" & UPPERREPLACECHAR & "'. Salvare il documento prima di procedere?" + WARNING = "La macro sostituirà tutti i caratteri e numeri con '" & UPPERREPLACECHAR & "' nel documento attivo." + + Case "es" + MSGBOXTITLE = "Sustituir todos los caracteres por '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "Este documento fue cambiado: todos los caracteres fueron sustituidos por " & UPPERREPLACECHAR & "'. Desea guardar el documento?" + WARNING = "Esta macro sustitue todos los caracteres y números en este documento por '" & UPPERREPLACECHAR & "'." + + Case "pt" + MSGBOXTITLE = "Substituir todos os caracteres por '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "Este documento foi modificado: todos os caracteres foram substituídos por " & UPPERREPLACECHAR & "'. Deseja guardar o documento?" + WARNING = "Esta macro substitui todos os caracteres e números neste documento por '" & UPPERREPLACECHAR & "'." + + Case "nl" + MSGBOXTITLE = "Verander alle tekens in een'" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "Dit document is veranderd. Alle tekens zijn veranderd in een " & UPPERREPLACECHAR & "'. Wilt u het document nu opslaan?" + WARNING = "Dit macro verandert alle tekens en cijfers in een '" & UPPERREPLACECHAR & "' in dit document." + + Case "sv" + MSGBOXTITLE = "Byt ut alla bokstäver mot en '" & UPPERREPLACECHAR & "' " + NOTSAVEDTEXT = "Dokumentet har ändrats, med detta makro kommer alla bokstäver att bytas ut mot en '" & UPPERREPLACECHAR & "' . Ska dokumentet säkras/sparas innan?" + WARNING = "Makrot ersätter alla bokstäver och tal i detta dokument med en '" & UPPERREPLACECHAR & "'." + +' Case "da" + +' Case "pl" + +' Case "ru" + + ' English & fallback/default + Case Else + MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'" + NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?" + WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document." + End Select +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/gimmicks/GetTexts.xba b/wizards/source/gimmicks/GetTexts.xba new file mode 100644 index 000000000..0788bec81 --- /dev/null +++ b/wizards/source/gimmicks/GetTexts.xba @@ -0,0 +1,612 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="GetTexts" script:language="StarBasic">Option Explicit +' Option für doppelte Strings +' Alternativtexte, Namen usw für HTML-Seiten--> ist Anbindung an StarOfficeAPI geplant? +' Verlustanzeige "Wo ist Peggy?" +' Überschriften für Textfelder +' GetTextFrames mit Peter absprechen +' Ole - Objekte auch mit einbeziehen? +' Redimensionierung des LogArrays, wenn Implementierung so weit ist +' Namen von Notizenseiten mit Peter durchsprechen + +' Macro-Description: +' This Macro extracts the Strings out of the currently activated document und inserts them into a logdocument +' The aim of the macro is to provide the programmer an insight into the StarOffice API +' It focusses on how document-Objects are accessed. +' Therefor not only texts of the document-body are retrieved but also Texts of general +' document Objects like, Annotations, charts and general Document Information + +Public oLogDocument, oLogText, oLogCursor, oLogHeaderStyle, oLogBodyTextStyle as Object +Public oDocument as Object +Public LogArray(1000) as String +Public LogIndex as Integer +Public oLocHeaderStyle as Object + +Sub Main +Dim sDocType as String +Dim oHyperCursor as Object +Dim oCharStyles as Object + + LoadLibrary("tools") + + On Local Error GoTo NODOCUMENT + oDocument = StarDesktop.ActiveFrame.Controller.Model + sDocType = GetDocumentType(oDocument) + NODOCUMENT: + If Err <> 0 Then + Msgbox("This Macro extracts all Data of the displayed Writer-, Calc or Draw-Documents." & 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 + + ' Open a new document where all the texts are inserted + oLogDocument = StarDesktop.LoadComponentFromURL( "staroffice:factory/swriter","_blank",0,NoArgs()) + oLogText = oLogDocument.Text + + ' create and define the character styles of the Log-document + oCharStyles = oLogDocument.StyleFamilies.GetByName("CharacterStyles") + oLogHeaderStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle") + oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD + oLogBodyTextStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle") + oCharStyles.InsertbyName("LogHeading", oLogHeaderStyle) + oCharStyles.InsertbyName("LogBodyText", oLogBodyTextStyle) + + ' Insert the title of the activated document as a hyperlink + oHyperCursor = oLogText.createTextCursor() + oHyperCursor.charWeight = com.sun.star.awt.FontWeight.BOLD + oHyperCursor.gotoStart(False) + oHyperCursor.HyperLinkURL = oDocument.URL + oHyperCursor.HyperLinkTarget = oDocument.URL + If oDocument.DocumentInfo.Title <> "" Then + oHyperCursor.HyperlinkName = oDocument.DocumentInfo.Title + End If + oLogText.insertString(oHyperCursor, oDocument.DocumentInfo.Title, False) + oLogText.insertControlCharacter(oHyperCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + + oLogCursor = oLogText.createTextCursor() + oLogCursor.GotoEnd(False) + ' "Switch off" the Hyperlink - Properties + oLogCursor.SetPropertyToDefault("HyperLinkURL") + oLogCursor.SetPropertyToDefault("HyperLinkTarget") + oLogCursor.SetPropertyToDefault("HyperLinkName") + LogIndex = 0 + + ' Get the Properties of the document Info + GetDocumentInfo() + + Select Case sDocType + Case "sWriter" + GetWriterStrings() + Case "sCalc" + GetCalcStrings() + Case "sDraw" + GetDrawStrings() + Case Else + Msgbox("This Macro only works with Writer-, Calc or Draw/Impress-Documents!", 16, "StarOffice 5.2") + End Select + +End Sub + + +' ***********************************************Calc-Documents************************************************** + +Sub GetCalcStrings() +Dim i, n as integer +Dim oSheet as Object +Dim SheetName as String +Dim oSheets as Object + ' Create a sequence of all sheets within the document + oSheets = oDocument.Sheets + + For i = 0 to osheets.Count - 1 + oSheet = osheets.GetbyIndex(i) + SheetName = oSheet.Name + MakeLogHeadLine("Sheet No " & i & "(" & SheetName & ")" ) + + ' Check the "body" of the sheet + GetCellTexts(oSheet) + + If oSheet.IsScenario then + MakeLogHeadLine("Scenario-Comments of " & SheetName & "'") + WriteStringtoLogFile(osheet.ScenarioComment) + End if + + GetAnnotations(oSheet, "Annotations of '" & SheetName & "'") + + GetChartStrings(oSheet, "Charts of '" & SheetName & "'") + + GetControlStrings(oSheet.DrawPage, "Controls of '" & SheetName & "'") + Next + + ' Pictures + GetCalcGraphicNames() + + GetNamedRanges() +End Sub + + +Sub GetCellTexts(oSheet as Object) +Dim BigRange, BigEnum, oCell as Object + BigRange = oDocument.CreateInstance("com.sun.star.sheet.SheetCellRanges") + BigRange.InsertbyName("",oSheet) + BigEnum = BigRange.GetCells.CreateEnumeration + While BigEnum.hasmoreElements + oCell = BigEnum.NextElement + If (oCell.Type = com.sun.star.util.NumberFormat.TEXT) AND (oCell.String <> "") then + WriteStringtoLogFile(oCell.String) + End If + Wend +End Sub + + +Sub GetAnnotations(oSheet as Object, HeaderLine as String) +Dim oNotes as Object +Dim n as Integer + oNotes = oSheet.getAnnotations + If oNotes.hasElements() then + MakeLogHeadLine(HeaderLine) + For n = 0 to oNotes.Count-1 + WriteStringtoLogFile(oNotes.GetbyIndex(n).String) + Next + End if +End Sub + + +Sub GetNamedRanges() +Dim i as integer + MakeLogHeadLine("Named Ranges") + For i = 0 To oDocument.NamedRanges.Count - 1 + WriteStringtoLogFile(oDocument.NamedRanges.GetbyIndex(i).Name) + Next +End Sub + + +Sub GetCalcGraphicNames() +Dim n,m as integer + MakeLogHeadLine("Pictures") + For n = 0 To oDocument.Drawpages.count-1 + For m = 0 To oDocument.Drawpages.GetbyIndex(n).Count - 1 + WriteStringtoLogFile(oDocument.DrawPages.GetbyIndex(n).GetbyIndex(m).Text.String) + Next m + Next n +End Sub + + +' ***********************************************Writer-Documents************************************************** + +Sub GetParagraphTexts(oParaObject as Object, HeadLine as String) +Dim ParaEnum as Object +Dim oPara as Object +Dim oTextPortEnum as Object +Dim oTextPortion as Object +Dim i as integer +Dim oCellNames() +Dim oCell as Object + + MakeLogHeadLine(HeadLine) + ParaEnum = oParaObject.Text.CreateEnumeration + + While ParaEnum.HasMoreElements + oPara = ParaEnum.NextElement + + ' Note: The Enumeration ParaEnum lists all tables and Paragraphs. + ' Therefor we have to find out what kind of object "oPara" actually is + If oPara.supportsService("com.sun.star.text.Paragraph") Then + ' "oPara" is a Paragraph + oTextPortEnum = oPara.createEnumeration + While oTextPortEnum.hasmoreElements + oTextPortion = oTextPortEnum.nextElement() + WriteStringToLogFile(oTextPortion.String) + Wend + Else + ' "oPara" is a table + oCellNames = oPara.CellNames + For i = 0 To Ubound(oCellNames()) + If oCellNames(i) <> "" Then + oCell = oPara.getCellByName(oCellNames(i)) + WriteStringToLogFile(oCell.String) + End If + Next + End If + Wend +End Sub + + + +Sub GetChartStrings(oSheet as Object, HeaderLine as String) +Dim i as Integer +Dim aChartObject as Object +Dim aChartDiagram as Object + + MakeLogHeadLine(HeaderLine) + + For i = 0 to oSheet.Charts.Count-1 + aChartObject = oSheet.Charts.GetByIndex(i).EmbeddedObject + If aChartObject.HasSubTitle then + WriteStringToLogFile(aChartObject.SubTitle.String) + End If + + If aChartObject.HasMainTitle then + WriteStringToLogFile(aChartObject.Title.String) + End If + + aChartDiagram = aChartObject.Diagram + + If aChartDiagram.hasXAxisTitle Then + WriteStringToLogFile(aChartDiagram.XAxisTitle) + End If + + If aChartDiagram.hasYAxisTitle Then + WriteStringToLogFile(aChartDiagram.YAxisTitle) + End If + + If aChartDiagram.hasZAxisTitle Then + WriteStringToLogFile(aChartDiagram.ZAxisTitle) + End If + Next i +End Sub + + + +Sub GetFrameTexts() +Dim i as integer +Dim oTextFrame as object +Dim oFrameEnum as Object +Dim oFramePort as Object +Dim oFrameTextEnum as Object +Dim oFrameTextPort as Object + + MakeLogHeadLine("Text Frames") + For i = 0 to oDocument.TextFrames.Count-1 + oTextFrame = oDocument.TextFrames.GetbyIndex(i) + WriteStringToLogFile(oTextFrame.Name) + + ' Is the frame bound to the Page + If oTextFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE Then + GetParagraphTexts(oTextFrame, "Textframe Content") + End If + + oFrameEnum = oTextFrame.CreateEnumeration + While oFrameEnum.HasMoreElements + oFramePort = oFrameEnum.NextElement + If oFramePort.supportsService("com.sun.star.text.Paragraph") then + oFrameTextEnum = oFramePort.createEnumeration + While oFrameTextEnum.HasMoreElements + oFrameTextPort = oFrameTextEnum.NextElement + If oFrameTextPort.SupportsService("com.sun.star.text.TextFrame") Then + WriteStringtoLogFile(oFrameTextPort.String) + End If + Wend + Else + WriteStringtoLogFile(oFramePort.Name) + End if + Wend + Next +End Sub + + +Sub GetTextFieldStrings() +Dim aTextField as Object +Dim i as integer +Dim CurElement as Object + MakeLogHeadLine("TextFields") + aTextfield = oDocument.getTextfields.CreateEnumeration + While aTextField.hasmoreElements + CurElement = aTextField.NextElement + If CurElement.PropertySetInfo.hasPropertybyName("Content") Then + WriteStringtoLogFile(CurElement.Content) + ElseIf CurElement.PropertySetInfo.hasPropertybyName("PlaceHolder") Then + WriteStringtoLogFile(CurElement.PlaceHolder) + WriteStringtoLogFile(CurElement.Hint) + ElseIf Curelement.TextFieldMaster.PropertySetInfo.HasPropertybyName("Content") then + WriteStringtoLogFile(CurElement.TextFieldMaster.Content) + End If + Wend +End Sub + + + +Sub GetLinkedFileNames() +Dim oDocSections as Object +Dim LinkedFileName as String +Dim i as Integer + If Right(oDocument.URL,3) = "sgl" Then + MakeLogHeadLine("Sub Documents") + oDocSections = oDocument.TextSections + For i = 0 to oDocSections.Count - 1 + LinkedFileName = oDocSections.GetbyIndex(i).FileLink.FileURL + If LinkedFileName <> "" Then + WriteStringToLogFile(LinkedFileName) + End If + Next i + End If +End Sub + + +Sub GetSectionNames() +Dim i as integer +Dim oDocSections as Object + MakeLogHeadLine("Sections") + oDocSections = oDocument.TextSections + For i = 0 to oDocSections.Count-1 + WriteStringtoLogFile(oDocSections.GetbyIndex(i).Name) + Next +End Sub + + +Sub GetWriterStrings() + GetParagraphTexts(oDocument, "Document Body") + GetGraphicNames() + GetStyles() + GetControlStrings(oDocument.DrawPage, "Controls") + GetTextFieldStrings() + GetSectionNames() + GetFrameTexts() + GetHyperLinks + GetLinkedFileNames() +End Sub + + +' ***********************************************Draw-Documents************************************************** + +Sub GetDrawPageTitles(LocObject as Object) +Dim n as integer +Dim oPage as Object + + For n = 0 to LocObject.Count - 1 + oPage = LocObject.GetbyIndex(n) + WriteStringtoLogFile(oPage.Name) + ' Is the Page a DrawPage and not a MasterPage? + If oPage.supportsService("com.sun.star.drawing.DrawPage")then + ' Get the Name of the NotesPage (only relevant for Impress-Documents) + If oDocument.supportsService("com.sun.star.presentation.PresentationDocument") then + WriteStringtoLogFile(oPage.NotesPage.Name) + End If + End If + Next +End Sub + + +Sub GetPageStrings(oPages as Object) +Dim m, n, s as Integer +Dim oPage, oPageElement, oShape as Object + For n = 0 to oPages.Count-1 + oPage = oPages.GetbyIndex(n) + If oPage.HasElements then + For m = 0 to oPage.Count-1 + oPageElement = oPage.GetByIndex(m) + If HasUnoInterfaces(oPageElement,"com.sun.star.container.XIndexAccess") Then + ' The Object "oPageElement" a group of Shapes, that can be accessed by their index + For s = 0 To oPageElement.Count - 1 + WriteStringToLogFile(oPageElement.GetByIndex(s).String) + Next s + Else + WriteStringtoLogFile(oPageElement.String) + End If + Next + End If + Next +End Sub + + +Sub GetDrawStrings() +Dim oDPages, oMPages as Object + + oDPages = oDocument.DrawPages + oMPages = oDocument.Masterpages + + MakeLogHeadLine("Titles") + GetDrawPageTitles(oDPages) + GetDrawPageTitles(oMPages) + + MakeLogHeadLine("Document Body") + GetPageStrings(oDPages) + GetPageStrings(oMPages) +End Sub + + +' ***********************************************Misc************************************************** + +Sub GetDocumentInfo() +Dim oDocuInfo as Object + MakeLogHeadLine("Document Info") + oDocuInfo = oDocument.DocumentInfo + WriteStringToLogFile(oDocuInfo.Title) + WriteStringToLogFile(oDocuInfo.Description) + WriteStringToLogFile(oDocuInfo.Theme) + WriteStringToLogFile(oDocuInfo.Author) + WriteStringToLogFile(oDocuInfo.ReplyTo) + WriteStringToLogFile(oDocuInfo.Recipient) + WriteStringToLogFile(oDocuInfo.References) + WriteStringToLogFile(oDocuInfo.Keywords) +End Sub + + +Sub GetHyperlinks() +Dim i as integer +Dim oCrsr as Object +Dim oAllHyperLinks as Object +Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue +Dim oSearchDesc as Object + + MakeLogHeadLine("HyperLinks") + ' create a Search-Descriptor + oSearchDesc = oDocument.CreateSearchDescriptor + oSearchDesc.Valuesearch = False + + ' define the Search-attributes + srchattributes(0).Name = "HyperLinkURL" + srchattributes(0).Value = "" + oSearchDesc.SetSearchAttributes(SrchAttributes()) + + oAllHyperLinks = oDocument.findAll(oSearchDesc()) + + For i = 0 to oAllHyperLinks.Count - 1 + oFound = oAllHyperLinks(i) + oCrsr = oFound.Text.createTextCursorByRange(oFound) + WriteStringToLogFile(oCrs.HyperLinkURL) 'Url + WriteStringToLogFile(oCrs.HyperLinkTarget) 'Name + WriteStringToLogFile(oCrs.HyperLinkName) 'Frame + Next i +End Sub + + +Sub GetGraphicNames() +Dim i as integer +Dim oDocGraphics as Object + MakeLogHeadLine("Pictures") + oDocGraphics = oDocument.GraphicObjects + For i = 0 to oDocGraphics.count - 1 + WriteStringtoLogFile(oDocGraphics.GetbyIndex(i).Name) + Next +End Sub + + +Sub GetStyles() +Dim m,n as integer + MakeLogHeadLine("Userdefined Templates") + + ' Check all StyleFamilies(i.e. PageStyles, ParagraphStyles, CharacterStyles, cellStyles) + For n = 0 to oDocument.StyleFamilies.Count - 1 + For m = 0 to oDocument.StyleFamilies.getbyIndex(n).Count-1 + If oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).IsUserDefined then + WriteStringtoLogFile(oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).Name) + End If + Next + Next +End Sub + + +Sub GetControlStrings(oDPage as Object, HeaderLine as String) +Dim aForm as Object +Dim m,n as integer + MakeLogHeadLine(HeaderLine) + 'SearchFor all possible Controls + For n = 0 to oDPage.Forms.Count - 1 + aForm = oDPage.Forms(n) + For m = 0 to aForm.Count-1 + GetControlContent(aForm.GetbyIndex(m)) + Next + Next +End Sub + + +Sub GetControlContent(LocControl as Object) +Dim i as integer + + If LocControl.PropertySetInfo.HasPropertybyName("Label") then + WriteStringtoLogFile(LocControl.Label) + + ElseIf LocControl.SupportsService("com.sun.star.form.component.ListBox") then + For i = 0 to Ubound(LocControl.StringItemList()) + WriteStringtoLogFile(LocControl.StringItemList(i)) + Next + End If + If LocControl.PropertySetInfo.HasPropertybyName("HelpText") then + WriteStringtoLogFile(LocControl.Helptext) + End If +End Sub + +' ***********************************************LogDocument************************************************** + +Sub WriteStringtoLogFile( sString as String) + + ' Schreibt den String in ein Array + If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then + LogArray(LogIndex) = sString + LogIndex = LogIndex + 1 + oLogText.insertString(oLogCursor,sString,False) + oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + End If +End Sub + + +Sub MakeLogHeadLine(HeadText as String) + oLogCursor.CharStyle = "LogHeading" + oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + oLogText.insertString(oLogCursor,HeadText,False) + oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + oLogCursor.CharStyle = "LogBodyText" +End Sub + + + +'Sub GetHTMLStrings(SearchString as String) +'Dim i,AsciiCount as integer +'Dim AsciiLocChar as string +'Dim TTString,AddString as String +'Dim oTextCursor as object +'Dim LeaveLoop as Boolean + +' oSearchDesc = oDocument.createSearchDescriptor() +' oSearchDesc.SearchRegularExpression = True +' oSearchDesc.Searchstring = SearchString & """" & "*" & """" +' oFoundall = oDocument.FindAll(oSearchDesc) + +' For i = 0 to oFoundAll.Count-1 +' oFound = oFoundall(i) +' oTextCursor = oDocument.text.CreateTextCursorbyRange(oFound) +' oTextCursor.GotoNextWord(false) +' oTextCursor.GotoStartofWord(True) +' oTextCursor.GoRight(1,True) +' TTString = oTextCursor.String +' If Left(TTString,1) = """" Then +' LeaveLoop = False +' oTextCursor.GoRight(1,True) +' Do +' oTextCursor.GoRight(1,True) +' TTString = TTString + Right(oTextCursor.String,1) +' If Right(oTextCursor.String,1) = """" Then +' TTString = ReplaceString(TTString,"","""") +' LeaveLoop = True +' End If +' Loop Until LeaveLoop = True +' +' End If +' +' If TTString <> "" then +' TTString = ReplaceHTMLChars(TTString) +' WriteStringtoLogFile(TTString) +' End if +' Next i +' +'End Sub + +' If sDocMimeType = "text/html" then +' FileProperties(0).Name = "FilterName" +' FileProperties(0).Value = "swriter: TEXT" +' FilePath = oDocument.URL +' oDocument.Dispose +' +' oDocument = OpenDocument(FilePath,FileProperties(),StarDesktop) '!!!!!!! +' +' MakeLogHeadLine("Alternativtexte") +' GetHTMLStrings("ALT=") +' +' MakeLogHeadLine("Referenzen") +' GetHTMLStrings("HREF=") +' +' MakeLogHeadLine("Namen") +' GetHTMLStrings("NAME=") +' Else + + +Sub LoadLibrary(sLibname as String) +Dim oArg(0) as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/gimmicks/ReadDir.xba b/wizards/source/gimmicks/ReadDir.xba new file mode 100644 index 000000000..806188cc4 --- /dev/null +++ b/wizards/source/gimmicks/ReadDir.xba @@ -0,0 +1,298 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ReadDir" script:language="StarBasic">Option Explicit +' Verzeichnis StarOne überprüfen (letzte beiden Dateien) +' Ordnung nach Verzeichnis und dann die Dateien ( indem "AAAA" vor den Verzeichnisnamen gesetzt wird). +' Nicht-Verzeichnisnamen abfangen +Const SBBASEWIDTH = 8000 +Const SBBASEHEIGHT = 1000 +Const SBPAGEX = 800 +Const SBPAGEY = 800 +Const SBBASECHARHEIGHT = 12 +Const SBRELDIST = 1.1 + +REM Names of the second Dimension of the Array iLevelPos +Const SBBASEX = 0 +Const SBBASEY = 1 + +Const SBOLDSTARTX = 2 +Const SBOLDSTARTY = 3 + +Const SBOLDENDX = 4 +Const SBOLDENDY = 5 + +Const SBNEWSTARTX = 6 +Const SBNEWSTARTY = 7 + +Const SBNEWENDX = 8 +Const SBNEWENDY = 9 + +Public ConnectLevel As Integer +Public iLevelPos(10,9) As Integer +Public Source as String +Public iCurLevel, nConnectLevel as Integer +Public nOldWidth, nOldHeight As Integer +Public nOldX, nOldY, nOldLevel As Integer +Public oOldLeavingLine As Object +Public oOldArrivingLine As Object + + +Sub Main + LoadLibrary("tools") + LoadLibrary("template") + ReadDirDlg.Load + ReadDirDlg.Show +End Sub + + +Sub TreeInfo() +Dim oCurTextShape As Object +Dim oDesktop As Object +Dim oDocument As Object +Dim iCurPage As Integer +Dim oPage As Object +Dim oOldPage As Object +Dim i, n, s as Integer +Dim bStartUpRun As Boolean +Dim FileNames(600,2) as String +Dim CurFile as String +Dim BaseLevel as Integer +Dim oController as Object +Dim FileCount as Integer +Dim oStatusline as Object + ReadDirDlg.Unload + bStartUpRun = TRUE + nOldHeight = 200 + nOldY = SBPAGEY + nOldX = SBPAGEX + nOldWidth = SBPAGEX + iCurPage = 0 + + oDesktop = createUnoService("com.sun.star.frame.Desktop") + oDocument = StarDesktop.ActiveFrame.Controller.Model + oPage = oDocument.DrawPages(iCurPage) + oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator + oStatusLine.Start("Fortschritt:",100) + oController = oDocument.GetCurrentController + Source = ConvertToURL(ReadDirdlg.Textbox1.Text) + BaseLevel = CountCharsInString(Source, "/", 1) + + oStatusline.SetValue(2) + FileNames() = ReadSourceDirectory(Source) + oStatusline.SetValue(8) + FileNames() = BubbleSortList(FileNames()) + oStatusline.SetValue(10) + + FileCount = Val(FileNames(0,0)) + For i = 1 To FileCount + oStatusLine.SetValue(10 + i/FileCount * 90) + CurFile = FileNames(i,1) + iCurLevel= CountCharsInString(FileNames(i,0), "/", 1) - BaseLevel + If iCurLevel <> 0 Then + nConnectLevel = iCurLevel- 1 + Else + nConnectLevel = iCurLevel + End If + +REM Add New page If necessary +REM ck IF nOldY + nOldHeight * 1/SBRELDIST > oPage.Height - SBPAGEY Then + IF nOldY + (nOldHeight + SBBASECHARHEIGHT) * 1.5 > oPage.Height - SBPAGEY Then + iCurPage = iCurPage + 1 + oDocument.getDrawPages.InsertNewbyIndex(iCurPage) + + oPage = oDocument.DrawPages(iCurPage) + oController.SetCurrentPage (oPage) + + For n = 0 To nConnectLevel + iLevelPos(n,SBNEWENDY) = nOldY + nOldHeight REM oOldPage.Height + oOldLeavingLine = DrawLine(n, SBNEWSTARTX, SBNEWSTARTY, SBNEWSTARTX, SBNEWENDY, oOldPage) +REM ck SBNEWENDX, SBNEWENDY) + Next + For n = 0 To nConnectLevel + iLevelPos(n,SBNEWSTARTY) = SBPAGEY + Next + nOldY = SBPAGEY + End If + oCurTextShape = CreateTextShape(oPage, CurFile) + +REM The Current TextShape has To be connected with a TextShape +REM one Level higher +REM - except For a TextShape In Level 0 + +REM Line Coordinates + If Not bStartUpRun Then + +REM A leaving Line Is only drawn when level is not 0 + If iCurLevel<> 0 Then +REM Determine the Coordinates of the arriving Line + iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX) + iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height + + iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX) + iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height + + oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage) + +REM Determine the End-Coordinates of the last leaving Line + iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX) + iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height + Else +REM On Level 0 the last Leaving Line's endpoint +REM is the upper edge of the textShape + iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX) + End If +REM Draw the Connectors To the previous TextShapes + oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage) + Else +REM StartingPoint of the leaving edge + bStartUpRun = FALSE + End If + +REM Determine the beginning Coordinates of the leaving Line + iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width + iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height + +REM Save the values For the Next run + nOldHeight = oCurTextShape.Size.Height + nOldX = oCurTextShape.Position.X + nOldWidth = oCurTextShape.Size.Width + nOldLevel = iCurLevel + Set oOldPage = oPage + Next i + oStatusLine.End + Exit Sub +ErrorHandler: + MsgBox error, 0,"Error in Line" & erl +End Sub + + + +Function CreateTextShape(oPage as Object, Filename as String) +Dim oTextShape As Object +Dim PageWidth, BaseX, TextWidth +Dim aPoint As New com.sun.star.awt.Point +Dim aSize As New com.sun.star.awt.Size + + aSize.Width = SBBASEWIDTH + aSize.Height = SBBASEHEIGHT + + aPoint.x = CalculateXPoint() + aPoint.y = nOldY + SBRELDIST * nOldHeight + nOldY = aPoint.y + + oTextShape = oDocument.createInstance("com.sun.star.drawing.TextShape") + oTextShape.Size = aSize + oTextShape.Position = aPoint + + oPage.add(oTextShape) + oTextShape.LineStyle = 1 + oTextShape.Charheight = SBBASECHARHEIGHT + oTextShape.TextAutoGrowWidth = TRUE + oTextShape.TextAutoGrowHeight = TRUE + oTextShape.String = FileName + +REM Configure Size And Position of the TextShape according to its Scripting + aPoint.x = iLevelPos(iCurLevel,SBBASEX) + oTextShape.Position = aPoint + aSize.Height = SBRELDIST * oTextShape.CharHeight + aSize.Width = SBRELDIST * oTextShape.Size.Width + + PageWidth = oPage.Width + TextWidth = aSize.Width + BaseX = aPoint.x + If BaseX + TextWidth > PageWidth - 1000 Then + oPage.Width = 1000 + BaseX + TextWidth + End If + oTextShape.Size = aSize + iLevelPos(iCurLevel,SBBASEY) = oTextShape.Position.Y + CreateTextShape = oTextShape +End Function + + + +Function CalculateXPoint() + +REM The current level Is lower than the Old one + If (iCurLevel< nOldLevel) And (iCurLevel<> 0) Then +REM ClearArray(iLevelPos(),iCurLevel+1) + Elseif iCurLevel= 0 Then + iLevelPos(iCurLevel,SBBASEX) = SBPAGEX +REM The current level Is higher than the old one + Elseif iCurLevel> nOldLevel Then + iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100 + End If + CalculateXPoint = iLevelPos(iCurLevel,SBBASEX) +End Function + + + +Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object) +Dim oConnect As Object + + aPoint.X = iLevelPos(nLevel,nStartX) + aPoint.Y = iLevelPos(nLevel,nStartY) + aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX) + aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY) + + oConnect = oDocument.createInstance("com.sun.star.drawing.LineShape") + + oConnect.Position = aPoint + oConnect.Size = aSize + oPage.Add(oConnect) + + DrawLine = oConnect +End Function + + +Sub SourceSearchDialog() + Source = Application.FileDialog( "P", "Wählen Sie ein Verzeichnis", "D:\Arbeitsverzeichnis" ) ' "Wählen Sie ein Verzeichnis" + If Len( Source ) > 0 Then + ReadDirDlg.Textbox1.Text = Source + End If +End Sub + + + +Function ReadSourceDirectory(ByVal Source As String) +Dim i, m, n, s as integer +Dim FileCount As Integer +Dim FileCountinDir as Integer +Dim FileName as string +Dim FileNameList(2000,1) as String +Dim DirList(200) as String +Dim oUCBobject as Object + + oUcbobject = createUnoService("com.sun.star.ucb.SimpleFileAccess") + 'isfolder + m = 0 + s = 1 + DirList(0) = Source + FileNameList(1,0) = Source + FileNameList(1,1) = GetFileNameoutofPath(Source) + n = 2 + Do + Source = DirList(m) + m = m + 1 + + DirContent = oUcbObject.GetFolderContents(Source,True) + + If Ubound(DirContent()) <> -1 Then + FileCountinDir = Ubound(DirContent()) + 1 + For i = 0 to FilecountinDir -1 + FileName = DirContent(i) + FilenameList(n,0) = FileName + FileNameList(n,1) = GetFileNameOutofPath(FileName) + n = n + 1 + If oUcbObject.IsFolder(FileName) Then + DirList(s) = FileName + DirList(0) = CStr(s) + s = s + 1 + End If + Next i + End If + Loop Until m = cInt(DirList(0))+ 1 + FileNameList(0,0) = n - 1 + ReadSourceDirectory = FileNameList() +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/gimmicks/UserfieldDlg.xdl b/wizards/source/gimmicks/UserfieldDlg.xdl new file mode 100644 index 000000000..7b3049c68 --- /dev/null +++ b/wizards/source/gimmicks/UserfieldDlg.xdl @@ -0,0 +1,7 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="UserfieldDlg" dlg:style-id="0"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + </dlg:styles> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/gimmicks/Userfields.xba b/wizards/source/gimmicks/Userfields.xba new file mode 100644 index 000000000..de7f789d7 --- /dev/null +++ b/wizards/source/gimmicks/Userfields.xba @@ -0,0 +1,196 @@ +<?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 + + 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>
\ No newline at end of file diff --git a/wizards/source/importwizard/API.xba b/wizards/source/importwizard/API.xba new file mode 100644 index 000000000..5959d5d45 --- /dev/null +++ b/wizards/source/importwizard/API.xba @@ -0,0 +1,204 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="API" script:language="StarBasic">Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _ + (ByVal hKey As Long, _ + ByVal lpSubKey As String, _ + ByVal ulOptions As Long, _ + ByVal samDesired As Long, _ + phkResult As Long) As Long + +Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _ + (ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + lpData As String, _ + lpcbData As Long) As Long + +Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _ + (ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + lpData As Long, _ + lpcbData As Long) As Long + +Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _ + (ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + ByVal lpData As Long, _ + lpcbData As Long) As Long + +Declare Function RegCloseKey Lib "advapi32.dll" _ + (ByVal hKey As Long) As Long + +Declare Function RegCloseKey Lib "advapi32.dll" (hKey As Long) As Long + +Public Const HKEY_CLASSES_ROOT = &H80000000 +Public Const HKEY_CURRENT_USER = &H80000001 +Public Const HKEY_LOCAL_MACHINE = &H80000002 +Public Const HKEY_USERS = &H80000003 +Public Const KEY_ALL_ACCESS = &H3F +Public Const REG_OPTION_NON_VOLATILE = 0 +Public Const REG_SZ As Long = 1 +Public Const REG_DWORD As Long = 4 +Public Const ERROR_NONE = 0 +Public Const ERROR_BADDB = 1 +Public Const ERROR_BADKEY = 2 +Public Const ERROR_CANTOPEN = 3 +Public Const ERROR_CANTREAD = 4 +Public Const ERROR_CANTWRITE = 5 +Public Const ERROR_OUTOFMEMORY = 6 +Public Const ERROR_INVALID_PARAMETER = 7 +Public Const ERROR_ACCESS_DENIED = 8 +Public Const ERROR_INVALID_PARAMETERS = 87 +Public Const ERROR_NO_MORE_ITEMS = 259 +'Public Const KEY_READ = &H20019 + + +Function OpenRegKey(lBaseKey As Long, sKeyName As String) As Variant +Dim LocKeyValue +Dim hKey as Long +Dim lRetValue as Long + lRetValue = RegOpenKeyEx(lBaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) +' lRetValue = QueryValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Outlook Express\5.0\Default Settings", "Revocation Checking") + If hKey <> 0 Then + RegCloseKey (hKey) + End If + OpenRegKey() = lRetValue +End Function + + +Function GetDefaultPath(CurOffice as Integer) As String +Dim sPath as String +Dim Index as Integer + Select Case Wizardmode + Case SBMICROSOFTMODE + Index = Val(Application(CurOffice,9)) + If GetGUIType = 1 Then ' Windows + sPath = QueryValue(HKEY_CURRENT_USER, sKeyName(Index), sValueName(Index)) + Else + sPath = "" + End If + If sPath = "" Then +' Todo: das User/Work Verzeichnis kann man hier wohl kaum nehmen + sPath = SOWorkPath + End If + GetDefaultPath = sPath + Case SBXMLMODE + GetDefaultPath = SOWorkPath + End Select +End Function + + +Function GetTemplateDefaultPath(Index as Integer) As String +Dim sLocTemplatePath as String +Dim sLocProgrampath as String +Dim Progstring as String +Dim PathList()as String +Dim Maxindex as Integer +Dim OldsLocTemplatePath +Dim sTemplateKeyName as String +Dim sTemplateValueName as String + Select Case WizardMode + Case SBMICROSOFTMODE + If GetGUIType = 1 Then ' Windows + + ' Template directory of Office 97 + sTemplateKeyName = "Software\Microsoft\Office\8.0\Common\FileNew\LocalTemplates" + sTemplateValueName = "" + sLocTemplatePath = QueryValue(HKEY_CURRENT_USER, sTemplateKeyName, sTemplateValueName) + + If sLocTemplatePath = "" Then + ' Retrieve the template directory of Office 2000 + ' Unfortunately there is no existing note about the template directory in + ' the whole registry. + + ' Programdirectory of Office 2000 + sTemplateKeyName = "Software\Microsoft\Office\9.0\Common\InstallRoot" + sTemplateValueName = "Path" + sLocProgrampath = QueryValue(HKEY_LOCAL_MACHINE, sTemplateKeyName, sTemplateValueName) + If sLocProgrampath <> "" Then + If Right(sLocProgrampath, 1) <> "\" Then + sLocProgrampath = sLocProgrampath & "\" + End If + PathList() = ArrayoutofString(sLocProgrampath,"\",Maxindex) + Progstring = "\" & PathList(Maxindex-1) & "\" + OldsLocTemplatePath = DeleteStr(sLocProgramPath,Progstring) + + sLocTemplatePath = OldsLocTemplatePath & "\" & "Templates" + + ' Does this subdirectory "templates" exist at all + If oUcb.Exists(sLocTemplatePath) Then + ' If Not the main directory of the office is the base + sLocTemplatePath = OldsLocTemplatePath + End If + Else + sLocTemplatePath = "" + End If + End If + GetTemplateDefaultPath = ConvertToUrl(sLocTemplatePath) + Else + GetTemplateDefaultPath = "" + End If + Case SBXMLMODE + If Index = 3 Then + ' Helper Application with no templates + GetTemplateDefaultPath = SOWorkPath + Else + GetTemplateDefaultPath = SOTemplatePath + End If + End Select +End Function + + +Function QueryValueEx(ByVal lhKey, ByVal szValueName As String, vValue As String) As Long +Dim cch As Long +Dim lrc As Long +Dim lType As Long +Dim lValue As Long +Dim sValue As String +Dim Empty + + On Error GoTo QueryValueExError + + lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch) + If lrc <> ERROR_NONE Then Error 5 + Select Case lType + Case REG_SZ: + sValue = String(cch, 0) + lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch) + If lrc = ERROR_NONE Then + vValue = Left$(sValue, cch) + Else + vValue = Empty + End If + Case REG_DWORD: + lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch) + If lrc = ERROR_NONE Then + vValue = lValue + End If + Case Else + lrc = -1 + End Select +QueryValueExExit: + QueryValueEx = lrc + Exit Function +QueryValueExError: + Resume QueryValueExExit +End Function + + +Function QueryValue(BaseKey As Long, sKeyName As String, sValueName As String) As Variant +Dim lRetVal As Long ' Returnvalue API-Call +Dim hKey As Long ' Onen key handle +Dim vValue As String ' Key value + + lRetVal = RegOpenKeyEx(BaseKey, sKeyName, 0, KEY_ALL_ACCESS, hKey) + lRetVal = QueryValueEx(hKey, sValueName, vValue) + RegCloseKey (hKey) + QueryValue = vValue +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/importwizard/DialogModul.xba b/wizards/source/importwizard/DialogModul.xba new file mode 100644 index 000000000..fbc58bd03 --- /dev/null +++ b/wizards/source/importwizard/DialogModul.xba @@ -0,0 +1,500 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DialogModul" script:language="StarBasic">Option Explicit + +Public Const bDebugWizard=True + +Public Const SBFIRSTAPPLCHECKED = 0 +Public Const SBSECONDAPPLCHECKED = 1 +Public Const SBTHIRDAPPLCHECKED = 2 +Public Const SBFOURTHAPPLCHECKED = 3 +'Public bDoKeepApplValues as Boolean +Public WizardMode as String +Public Const SBMICROSOFTMODE = "MS" +Public Const SBXMLMODE = "XML" +' The absolute maximal Number of possible Applications +Public Const Twip = 425 +Public Const SBMAXAPPLCOUNT = 4 +Public MaxApplCount as Integer +Public CurOffice As Integer +Public SOBitmapPath As String +Public SOWorkPath As String +Public SOTemplatePath as String +Public bCancelTask As Boolean +Public iApplSection as Integer +Public oUcb as Object +Public PathSeparator as String + +Public ApplCount as Integer +Public sKeyName(SBMAXAPPLCOUNT-1) as String +Public sValueName(SBMAXAPPLCOUNT-1) as String +Public sCRLF as String +Public MSFilterName(5,2) as String +Public XMLFilterName(7,2) + +' e.g.: +' XMLFilterName(x,0) = "sdw" ' in documents we take the extensions; in SO-templates the appropriate Filtername +' XMLFilterName(x,1) = "swriter: StarWriter 5.0" ' the filtername of the target-format +' XMLFilterName(x,2) = "sxw" ' the target extension + +Public ChkApplication(SBMAXAPPLCOUNT-1) as Object +Public Applications(SBMAXAPPLCOUNT-1,9) + +' Application-relating Data are stored in this Array +' according to the following structure: +' Applications(X,0) = "TRUE/FALSE" (Application is to be converted) +' Applications(X,1) = "TRUE/FALSE" (Documents are to be converted) +' Applications(X,2) = "TRUE/FALSE" (Including Subdirectories) +' Applications(X,3) = "File:///..." (SourceUrl of the documents) +' Applications(X,4) = "File///:..." (TargetUrl of the documents) +' Applications(X,5) = "TRUE/FALSE" (Templates are to be converted) +' Applications(X,6) = "TRUE/FALSE" (Including Subdirectories) +' Applications(X,7) = "File:///..." (SourceUrl of the templates) +' Applications(X,8) = "File:///..." (TargetUrl of the templates) +' Applications(X,9) = "0" (Key to the original Index of the Applications) + + +Sub FillStep_Welcome() +Dim i as Integer +' bDoKeepApplValues = False + With ImportDialog + .cbHelp.Label = sHelpButton + .cbCancel.Label = sCancelButton + .cbBack.Label = sBackButton + .cbGoOn.Label = sNextButton + .WelcomeTextLabel.Label = sWelcomeTextLabel1 + .WelcomeTextLabel2.Label = sWelcomeTextLabel2 + .WelcomeTextLabel3.Label = sWelcomeTextLabel3 + + .OptMSDocuments.Label = sContainerName(0) + .ChkFirstMSApplication.Label = sMsDocumentCheckbox(0) + .ChkSecondMSApplication.Label = sMsDocumentCheckbox(1) + .ChkThirdMSApplication.Label = sMsDocumentCheckbox(2) + + .OptSODocuments.Label = sContainerName(1) + .ChkFirstSOApplication.Label = sSODocumentCheckbox(0) + .ChkSecondSOApplication.Label = sSODocumentCheckbox(1) + .ChkThirdSOApplication.Label = sSODocumentCheckbox(2) + .ChkFourthSOApplication.Label = sSODocumentCheckbox(3) + .cbBack.Enabled = False + .Step = 1 + End With + DisorEnableNextButton() +End Sub + + +Sub FillStep_InputPaths(OfficeIndex as Integer, bStartup as Boolean) +Dim Index as Integer + If bStartup Then + If ImportDialog.OptMSDocuments.State Then + SetupMSConfiguration() + Else + SetupXMLConfiguration() + End If + ' TemplateCheckBox-Captions + GetApplResourceArray(1008 + iApplSection, ApplCount, sTemplateCheckBox()) + ' DocumentCheckbox- Captions + GetApplResourceArray(1012 + iApplSection, ApplCount, sDocumentCheckBox()) + + AssignCheckboxObjects() + + FillUpApplicationList() + End If + + CurOffice = OfficeIndex + + Index = Val(Applications(CurOffice,9)) + With ImportDialog + .TemplateCheckbox.Label = sTemplateCheckbox(Index) + .TemplateSearchSubDir.Label = sSearchInSubDir + + .DocumentImportLabel.Label = sImportLabel + .DocumentExportLabel.Label = sExportLabel + .DocumentSearchSubDir.Label = sSearchInSubDir + + .DocumentPathCheckbox.State = Val(Applications(CurOffice,1)) + .DocumentSearchSubDir.State = Val(Applications(CurOffice,2)) + .DocumentImportPath.Text = ConvertFromUrl(Applications(CurOffice,3)) + .DocumentExportPath.Text = ConvertFromUrl(Applications(CurOffice,4)) + .DocumentFrame.Label = sProgressMoreDocs + + If WizardMode = SBXMLMODE AND Index = 3 Then + ' Note: SO-Helper Applications are partly treated like templates although they only have documents + .TemplateFrame.Label = sProgressMoreDocs + .TemplateCheckbox.Label = sSOHelperDocuments(0) + .DocumentPathCheckbox.Label = sSOHelperDocuments(1) + Else + .TemplateCheckbox.Label = sTemplateCheckbox(Index) + .DocumentPathCheckbox.Label = sDocumentCheckbox(Index) + .TemplateFrame.Label = sProgressMoreTemplates + End If +'Todo: Enable this Checkbox as soon as an XML-Template-Format is defined + .TemplateCheckbox.State = Val(Applications(CurOffice,5)) + .TemplateSearchSubDir.State = Val(Applications(CurOffice,6)) + .TemplateImportPath.Text = ConvertFromUrl(Applications(CurOffice,7)) + .TemplateImportLabel.Label = sImportLabel + .TemplateExportPath.Text = ConvertFromUrl(Applications(CurOffice,8)) + .TemplateExportLabel.Label = sExportLabel + +' Call SetEnabledTemplate_InputPath() +' Call SetEnabledDocument_InputPath() + .cbGoOn.Label = sNextButton + .cbBack.Enabled = True + ImportDialog.Step = 2 + End With + DisOrEnableNextButton() +End Sub + + +Sub FillUpApplicationList() +Dim i as Integer +Dim a as Integer +Dim sBoolValue as String + +' If Not bDoKeepApplValues Then + a = 0 + For i = 0 To ApplCount - 1 + sBoolValue = CStr(ChkApplication(i).State) + Applications(a,0) = sBoolValue + Applications(a,1) = sBoolValue + Applications(a,2) = sBoolValue + Applications(a,3) = GetDefaultPath(i) + Applications(a,4) = SOWorkPath + Applications(a,5) = sBoolValue + Applications(a,6) = sBoolValue + Applications(a,7) = GetTemplateDefaultPath(i) + Applications(a,8) = GetTargetTemplatePath(i) + Applications(a,9) = CStr(i) + If ChkApplication(i).State = 1 Then a = a + 1 + Next i + ApplCount = a +' End If +End Sub + + + +Function SaveStep_InputPath() as Boolean +Dim bSaveConfiguration as Boolean + bSaveConfiguration = CheckInputPaths + If bSaveConfiguration Then + Applications(CurOffice,1) = CStr(ImportDialog.DocumentPathCheckbox.State) + Applications(CurOffice,2) = CStr(ImportDialog.DocumentSearchSubDir.State) + Applications(CurOffice,3) = ConvertToURL(ImportDialog.DocumentImportPath.Text) + Applications(CurOffice,4) = ConvertToUrl(ImportDialog.DocumentExportPath.Text) + Applications(CurOffice,5) = CStr(ImportDialog.TemplateCheckbox.State) + Applications(CurOffice,6) = CStr(ImportDialog.TemplateSearchSubDir.State) + Applications(CurOffice,7) = ConvertToURL(ImportDialog.TemplateImportPath.Text) + Applications(CurOffice,8) = ConvertToURL(ImportDialog.TemplateExportPath.Text) + End If + SaveStep_InputPath = bSaveConfiguration +End Function + + +Sub SetEnabledTemplate_InputPath() +Dim bDoEnable as Boolean + With ImportDialog + bDoEnable = ImportDialog.TemplateCheckbox.State = 1 + .TemplateImportLabel.Enabled = bDoEnable + .TemplateExportLabel.Enabled = bDoEnable + .TemplateImportPath.Enabled = bDoEnable + .TemplateExportPath.Enabled = bDoEnable + .TemplateSearchSubDir.Enabled = bDoEnable + .TemplateImportPath.Enabled = bDoEnable +'Note: The following lines have bee disabled due to Bug 82532 +' If Not bDoEnable Then +' .cbGoOn.Enabled = .DocumentPathCheckBox.State +' Else +' .cbGoOn.Enabled = True +' End If + End With +End Sub + + +Sub SetEnabledDocument_InputPath() +Dim bDoEnable as Boolean + With ImportDialog + bDoEnable = .DocumentPathCheckbox.State = 1 + .DocumentImportLabel.Enabled = bDoEnable + .DocumentExportLabel.Enabled = bDoEnable + .DocumentSearchSubDir.Enabled = bDoEnable + .DocumentImportPath.Enabled = bDoEnable + .DocumentExportPath.Enabled = bDoEnable +'Note: The following lines have bee disabled due to Bug 82532 + +' If Not bDoEnable Then +' .cbGoOn.Enabled = .TemplateCheckBox.State +' Else +' .cbGoOn.Enabled = True +' End If + End With +End Sub + + +Function MakeSummaryString() +Dim sTmpText As String +Dim i as Integer +Dim Index as Integer +Dim sAddText as String + For i = 0 To ApplCount -1 + Index = Val(Applications(i,9)) + If Applications(i,5) = "1" Then + ' Templates are to be converted + If Index = 3 Then + sAddText = ReplaceString(sSumDocuments(Index),sSOHelperDocuments(0),"%1") & sCRLF + Else + sAddText = ReplaceString(sSumDocuments(Index),sTemplateCheckBox(Index),"%1") & sCRLF + End If + sTmpText = sTmpText & sAddText & Applications(i,7) & sCRLF + If Applications(i,6) = "1" Then + ' Including Subdirectories + sTmpText = sTmpText & sSumInclusiveSubDir & sCRLF + End If + sTmpText = sTmpText & sSumSaveDocuments & sCRLF + sTmpText = sTmpText & Applications(i,8) & sCRLF + sTmpText = sTmpText & sCRLF + End If + + If Applications(i,1) = "1" Then + ' Documents are to be converted + If Index = 3 Then + sAddText = ReplaceString(sSumDocuments(Index),sSOHelperDocuments(1),"%1") & sCRLF + Else + sAddText = ReplaceString(sSumDocuments(Index),sDocumentCheckBox(Index),"%1") & sCRLF + End If + sTmpText = sTmpText & sAddText & Applications(i,3) & sCRLF + + If Applications(i,2) = "1" Then + ' Including Subdirectories + sTmpText = sTmpText & sSumInclusiveSubDir & sCRLF + End If + + sTmpText = sTmpText & sSumSaveDocuments & sCRLF + sTmpText = sTmpText & Applications(i,4) & sCRLF + sTmpText = sTmpText & sCRLF + End If + Next i + MakeSummaryString = sTmpText +End Function + + +Sub FillStep_Summary() +' Todo: Angabe über die Vorlagengruppen,bzw. Template-Exportpfad + With ImportDialog + .SummaryTextbox.Text = MakeSummaryString() + .cbGoOn.Enabled = .SummaryTextbox.Text <> "" + .cbGoOn.Label = sBeginButton + .SummaryHeaderLabel.Label = sSummaryHeader + .Step = 3 + End With +End Sub + + +Sub FillStep_Progress() + With ImportDialog + .cbBack.Enabled = False + .cbGoOn.Enabled = False + .FrameProgress.Label = sProgressPage_1 + .LabelRetrieval.FontWeight = com.sun.star.awt.FontWeight.BOLD + .LabelRetrieval.Label = sProgressPage_2 + .LabelCurProgress.Label = sProgressPage_3 + .LabelCurDocumentRetrieval.Label = "" + .LabelCurTemplateRetrieval.Label = "" + .LabelCurDocument.Label = "" + .Step = 4 + End With +End Sub + + +Sub DocumentDirSearchDialog() + CallDirSearchDialog(ImportDialog.DocumentImportPath) +End Sub + + +Sub StarDocumentDirSearchDialog() + CallDirSearchDialog(ImportDialog.DocumentExportPath) +End Sub + + +Sub CallDirSearchDialog(oTargetControl as Object) +Dim sDirName as String + sDirName = Application.FileDialog("P", sPathDialogMessage, oTargetControl.Text) + If Len(sDirName) > 0 Then + oTargetControl.Text = sDirName + End If +End Sub + + +Sub SetupMSConfiguration() + iApplSection = 0 + Wizardmode = SBMICROSOFTMODE + MaxApplCount = 3 + ApplCount = 3 + + sKeyName(0) = "Software\Microsoft\Office\8.0\Word\Options" + sKeyName(1) = "Software\Microsoft\Office\8.0\Excel\Microsoft Excel" + sKeyName(2) = "Software\Microsoft\Office\8.0\PowerPoint\Recent Folder List\Default" + + sValueName(0) = "DOC-PATH" + sValueName(1) = "DefaultPath" + sValueName(2) = "" + +' See definition of Filtername-Array about meaning of fields + MSFilterName(0,0) = "doc" + MSFilterName(0,1) = "swriter: StarOffice XML (Writer)" + MSFilterName(0,2) = "sxw" + + MSFilterName(1,0) = "xls" + MSFilterName(1,1) = "scalc: StarOffice XML (Calc)" + MSFilterName(1,2) = "sxc" + + MSFilterName(2,0) = "pod" + MSFilterName(2,1) = "simpress: StarOffice XML (Impress)" + MSFilterName(2,2) = "sxi" + + MSFilterName(3,0) = "dot" + MSFilterName(3,1) = "swriter: writer_StarOffice_XML_Writer_Template" + MSFilterName(3,2) = "stw" + + MSFilterName(4,0) = "xlt" + MSFilterName(4,1) = "scalc: calc_StarOffice_XML_Calc_Template" + MSFilterName(4,2) = "stc" + + MSFilterName(5,0) = "pot" + MSFilterName(5,1) = "simpress: impress_StarOffice_XML_Impress_Template" + MSFilterName(5,2) = "sti" +End Sub + + + +Sub SetupXMLConfiguration() + iApplSection = 1000 + Wizardmode = SBXMLMODE + ApplCount = 4 + MaxApplCount = 4 + + XMLFilterName(0,0) = "sdw" + XMLFilterName(0,1) = "swriter: StarOffice XML (Writer)" + XMLFilterName(0,2) = "sxw" + + XMLFilterName(1,0) = "sdc" + XMLFilterName(1,1) = "scalc: StarOffice XML (Calc)" + XMLFilterName(1,2) = "sxc" + + XMLFilterName(2,0) = "sdd|sda" + XMLFilterName(2,1) = "simpress: StarOffice XML (Impress)|sdraw: StarOffice XML (Draw)" + XMLFilterName(2,2) = "sxi|sxd" + + XMLFilterName(3,0) = "smf" + XMLFilterName(3,1) = "smath: MathML XML (Math)" + XMLFilterName(3,2) = "mml" + + XMLFilterName(4,0) = "application/vnd.stardivision.writer;application/x-starwriter" + XMLFilterName(4,1) = "swriter: writer_StarOffice_XML_Writer_Template" + XMLFilterName(4,2) = "stw" + + XMLFilterName(5,0) = "application/vnd.stardivision.calc;application/x-starcalc" + XMLFilterName(5,1) = "scalc: calc_StarOffice_XML_Calc_Template" + XMLFilterName(5,2) = "stc" + + XMLFilterName(6,0) = "application/vnd.stardivision.impress;application/x-starimpress|application/vnd.stardivision.draw;application/x-stardraw" + XMLFilterName(6,1) = "simpress: impress_StarOffice_XML_Impress_Template|draw_StarOffice_XML_Draw_Template" + XMLFilterName(6,2) = "sti|std" + +' ToDo: define Filter for Masterdocument + XMLFilterName(7,0) = "sgl" + XMLFilterName(7,1) = "swriter: writer_globaldocument_StarOffice_XML_Writer_GlobalDocument" + XMLFilterName(7,2) = "sxg" +End Sub + + +Function CheckControlPath(oTextBox as Object, ByVal bDoEnable as Boolean) +Dim Path as String + If Not bDoEnable Then + CheckControlPath = False + Else + CheckControlPath = oTextBox.Text <> "" + End If +End Function + + +Sub AssignCheckboxObjects() + With ImportDialog + If .OptSODocuments.State Then + Set ChkApplication(0) = .ChkFirstSOApplication + Set ChkApplication(1) = .ChkSecondSOApplication + Set ChkApplication(2) = .ChkThirdSOApplication + Set ChkApplication(3) = .ChkFourthSOApplication + Else + Set ChkApplication(0) = .ChkFirstMSApplication + Set ChkApplication(1) = .ChkSecondMSApplication + Set ChkApplication(2) = .ChkThirdMSApplication + End If + End With +End Sub + + +Function CheckInputPaths() as Boolean +Dim bChangePage as Boolean + bChangePage = CheckTextBoxPath(ImportDialog.TemplateImportPath, True, False) + bChangePage = CheckTextBoxPath(ImportDialog.TemplateExportPath, bChangePage, True) + bChangePage = CheckTextBoxPath(ImportDialog.DocumentImportPath, bChangePage, False) + bChangePage = CheckTextBoxPath(ImportDialog.DocumentExportPath, bChangePage, True) + CheckInputPaths = bChangePage +End Function + + +Function CheckTextBoxPath(oTextBox as Object, ByVal bCheck as Boolean, bCreateNew as Boolean) as Boolean +Dim iCreate as Integer +Dim sQueryMessage as String +Dim sUrlPath as String +Dim sMessageNoDir as String +Dim sShowPath as String + If oTextBox.Enabled Then + If bCheck Then + sShowPath = ConvertToUrl(oTextBox.Text) + sUrlPath = ConvertToUrl(sShowPath) + If Not oUcb.Exists(sUrlPath) Then + If Not bCreateNew Then + ' Sourcedirectories must be existing, Targetdirectories may be created new + sQueryMessage = ReplaceString(sMsgDirNotThere, sShowPath,"%1") + Msgbox(sQueryMessage,16,sTitle) + CheckTextBoxPath() = False + Exit Function + Else + sQueryMessage = ReplaceString(sMsgDirNotThere, sShowPath,"%1") + sQueryMessage = sQueryMessage & Chr(13) & sQueryForNewCreation + iCreate = Msgbox (sQueryMessage, 36, sTitle) + If iCreate = 6 Then + On Local Error Goto NOVALIDPATH + oUcb.CreateFolder(sUrlPath) + If Not oUcb.Exists(sUrlPath) Then + Goto NOVALIDPATH + End If + Else + CheckTextBoxPath() = False + Exit Function + End If + End If + End If + CheckTextBoxPath() = True + Else + CheckTextBoxPath() = False + End If + Else + CheckTextBoxPath() = True + End If + Exit Function +NOVALIDPATH: + sMessageNoDir = ReplaceString(sNoDirCreation, sShowPath, "%1") + Msgbox(sMessageNoDir, 16, sTitle) + CheckTextBoxPath() = False +End Function + + +Sub InitializeProgressPage(oDialog as Object) + 'oDialog.LabelRetrieval.Label = "" + 'oDialog.LabelCurProgress.Label = "" + oDialog.LabelRetrieval.FontWeight = com.sun.star.awt.FontWeight.NORMAL + oDialog.LabelCurProgress.FontWeight = com.sun.star.awt.FontWeight.BOLD +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/importwizard/FilesModul.xba b/wizards/source/importwizard/FilesModul.xba new file mode 100644 index 000000000..8e0089957 --- /dev/null +++ b/wizards/source/importwizard/FilesModul.xba @@ -0,0 +1,276 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FilesModul" script:language="StarBasic">Option Explicit + +Public AbsTemplateFound as Integer +Public AbsDocuFound as Integer + + +Function ReadApplicationDirectories(ApplIndex as Integer, FilesList(),bIsDocument as Boolean, sFiltername()) as Integer +Dim bCheckDocuType as Boolean +Dim FilterIndex as Integer +Dim bRecursive as Boolean +Dim sSourceDir as String +Dim bCheckRealType as Boolean +Dim a as Integer +Dim sFileContent() as String +Dim NewList(200,1) as String +Dim Index as Integer +Dim sLocExtension as String + Index = Val(Applications(ApplIndex,9) + sLocExtension = "" + If bIsDocument Then + ' Documents + bCheckDocuType = ControlStateToBool(Applications(ApplIndex,1)) + bCheckRealType = False + bRecursive = ControlStateToBool(Applications(ApplIndex,2)) + FilterIndex = Index + sSourceDir = Applications(ApplIndex,3) + Else + ' Templates + bCheckDocuType = ControlStateToBool(Applications(ApplIndex,5)) + ' In SO the documenttype cannot be derived from the extension name + bCheckRealType = WizardMode = SBXMLMODE + If bCheckRealType Then + ' Note: StarOffice-Math-Documents cannot be treated like templates + bCheckRealType = Index <> 3 + If bCheckRealType Then + sLocExtension = "vor" + End If + bIsDocument = Not bCheckRealType + End If + bRecursive = ControlStateToBool(Applications(ApplIndex,6)) + FilterIndex = Index + MaxApplCount + sSourceDir = Applications(ApplIndex,7) + End If + If bCheckDocuType Then + sFileContent() = GetMimeTypeList(sFilterName(FilterIndex)) + NewList() = ReadDirectories(sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension) + AddListtoList(FilesList(), NewList(), ApplIndex) + LabelRetrieval.Caption = sProgressPage_2 & " " & ReplaceString(sProgressPage_5, FilesList(0,0) & " ", "%1") + End If + ReadApplicationDirectories() = Val(NewList(0,0)) +End Function + + + +Sub ShowCurrentProgress(bIsDocument as Boolean, CurFound as Integer) + If bIsDocument Then + AbsDocuFound = AbsDocuFound + CurFound + ImportDialog.LabelCurDocumentRetrieval.Label = sProgressFound & " " & CStr(AbsDocuFound) & " " & sProgressMoreDocs + Else + AbsTemplateFound = AbsTemplateFound + CurFound + ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound & " " & CStr(AbsTemplateFound) & " " & sProgressMoreTemplates + End If +End Sub + +Sub ConvertAllDocuments(sFilterName()) +Dim FileProperties(0) as new com.sun.star.beans.PropertyValue +Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue +Dim FilesList(500,2) as String +Dim sViewPath as String +Dim i as Integer +Dim FilterIndex as Integer +Dim sFullName as String +Dim sFileName as String +Dim oDocument as Object +Dim sExtension as String +Dim OldExtension as String +Dim CurFound as Integer +Dim TargetStemDir as String +Dim SourceStemDir as String +Dim TargetDir as String +Dim TargetFile as String +Dim CurFilterName as String +Dim ApplIndex as Integer +Dim Index as Integer +Dim bIsDocument as Boolean +Dim iOverWrite as Integer +Dim bDoSave as Boolean +Dim sCurFileExists as String +Dim oTaskEnum as Object +Dim oTask as Object +Dim oModel as Object +Dim oTaskController as Object + AbsTemplateFound = 0 + AbsDocuFound = 0 + For i = 0 To ApplCount-1 + 'templates + bIsDocument = False + CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) + ShowCurrentProgress(bIsDocument, CurFound) + Next i + + For i = 0 To ApplCount-1 + 'documents + bIsDocument = True + CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) + ShowCurrentProgress(bIsDocument, CurFound) + Next i + + InitializeProgressPage(ImportDialog) + + OpenProperties(0).Name = "Hidden" + OpenProperties(0).Value = True + For i = 1 To cInt(FilesList(0, 0)) + bDoSave = True + If bCancelTask Then + Call CancelTask() + End if + + sFullName = FilesList(i,0) + CurFiltername = GetFilterName(FilesList(i,1), sFilterName(), sExtension, FilterIndex) + ApplIndex = FilesList(i,2) + sViewPath = CutPathView(sFullName, 60) + ImportDialog.LabelCurDocument.Label = Str(i) & "/" & FilesList(0,0) & " (" & sViewPath & ")" + If i = 1 Then + + End If + oDocument = StarDesktop.LoadComponentFromURL(sFullName, "_blank", 0, OpenProperties()) + If Not IsNull(oDocument) Then + Select Case sExtension + Case "sxw", "sxc", "sxi", "sxd", "sxs", "mml" + SourceStemDir = RTrimStr(Applications(ApplIndex,3), "/") + TargetStemDir = RTrimStr(Applications(ApplIndex,4), "/") + Case Else ' Templates and Helper-Applications remain + SourceStemDir = RTrimStr(Applications(ApplIndex,7), "/") + TargetStemDir = RTrimStr(Applications(ApplIndex,8), "/") + End Select + + TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir) + sFileName = GetFileNameWithoutExtension(TargetFile, "/") + OldExtension = GetFileNameExtension(TargetFile) + + TargetFile = RTrimStr(TargetFile, OldExtension) + TargetFile = TargetFile & sExtension + TargetDir = RTrimStr(TargetFile, sFileName & "." & sExtension) + If Not oUcb.Exists(TargetDir) Then + oUcb.CreateFolder(TargetDir) + End If + If oUcb.Exists(TargetFile) Then + sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), "<1>") + sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>") + iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle) + Select Case iOverWrite + Case 1 ' OK + ' In the FileProperty-Bean this is already default + bDoSave = True + Case 2 ' Abort + Call CancelTask() + Case 7 ' No + bDoSave = False + End Select + End If + If bDoSave Then + On Local Error Resume Next + FileProperties(0).Name = "FilterName" + FileProperties(0).Value = CurFilterName + oDocument.StoreToUrl(TargetFile,FileProperties()) + oDocument.Dispose() + On Local Error Goto 0 + End If + oTaskenum = StarDesktop.Tasks.CreateEnumeration +' While oTaskEnum.HasmoreElements +' oTask = oTaskenum.NextElement +' If oTask.Name <> "" Then +' oTaskController = oTask.Controller +' PrintdbgInfo oTaskController +' If hasUnoInterfaces(oTaskController,"com.sun.star.frame.XModel") then +' oModel = oTaskController.Model +' If Ucase(oModel.Url) = Ucase(sFullName) Then +' oTask.Close +' End If +' End If +' End If +' Wend + End If + Next i + Msgbox sReady, 64, sTitle + ImportDialogArea.endExecute + ImportDialogArea.Dispose + End + + Exit Sub +RTError: + Msgbox sRTErrorDesc, 16, sRTErrorHeader +End Sub + + +Sub AddListtoList(FirstList(), SecList(), ApplIndex as Integer) +Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, s as Integer + FirstStart = Val(FirstList(0,0)) + 1 + FirstEnd = FirstStart + Val(SecList(0,0)) + s = 1 + For i = FirstStart To FirstEnd + FirstList(i,0) = SecList(s,0) + FirstList(i,1) = SecList(s,1) + FirstList(i,2) = CStr(ApplIndex) + s = s + 1 + Next i + FirstList(0,0) = i-2 +End Sub + + +Function GetTargetTemplatePath(Index as Integer) + Select Case WizardMode + Case SBMICROSOFTMODE + GetTargetTemplatePath() = SOTemplatePath & "/" & sTemplateGroupName(Index) + Case SBXMLMODE + If Index = 3 Then + ' Helper Application + GetTargetTemplatePath = SOWorkPath + Else + GetTargetTemplatePath = SOTemplatePath + End If + End Select +End Function + + +' Retrieves the second value for a next to 'SearchString' in +' a two-dimensional string-Array +Function GetFilterName(sMimetypeorExtension as String, sFilterName(), sExtension as string, FilterIndex as Integer) as String +Dim i as Integer +Dim MaxIndex as Integer +Dim sLocFilterlist() as String + For i = 0 To Ubound(sFiltername(),1) + If Instr(1,sFilterName(i,0),sMimeTypeOrExtension) <> 0 Then + sLocFilterList() = ArrayoutofString(sFiltername(i,0),"|", MaxIndex) + If MaxIndex = 0 Then + sExtension = sFiltername(i,2) + GetFilterName = sFilterName(i,1) + Else + Dim a as Integer + Dim sLocExtensionList() as String + a = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList()) + sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex) + GetFilterName = sLocFilterList(a) + sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex) + sExtension = sLocExtensionList(a) + End If + Exit For + End If + Next + FilterIndex = i +End Function + + +Function SearchArrayforPartString(SearchString as String, LocList()) as Integer +Dim i as integer + For i = Lbound(LocList(),1) to Ubound(LocList(),1) + If Instr(1,LocList(i), SearchString) <> 0 Then + SearchArrayForPartString() = i + Exit Function + End if + Next + IndexinArray = -1 +End Function + + +Function GetMimeTypeList(BigFiltername as STring) +Dim sMimeTypeList() + sMimeTypeList() = ArrayoutofString(BigFilterName,";") + If Instr(sMimetypeList(0), "|") <> 0 Then + sMimeTypeList() = ArrayoutofString(sMimeTypeList(0),"|") + End If + GetMimetypeList() = sMimeTypeList() +End Function</script:module>
\ No newline at end of file diff --git a/wizards/source/importwizard/Language.xba b/wizards/source/importwizard/Language.xba new file mode 100644 index 000000000..c4d9a2da1 --- /dev/null +++ b/wizards/source/importwizard/Language.xba @@ -0,0 +1,131 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit + +Public sMSTemplateCheckbox(2) As String +Public sMSDocumentCheckbox(2) As String +Public sSODocumentCheckbox(4) As String +Public sSOHelperdocuments(1) As String +Public sTemplateCheckbox(SBMAXAPPLCOUNT-1) As String +Public sDocumentCheckbox(SBMAXAPPLCOUNT-1) As String +Public sTemplateGroupName(SBMAXAPPLCOUNT-1) As String +Public sSumDocuments As String ' Todo: Platzhalter einfügen +Public sPathErrorTemplates(SBMAXAPPLCOUNT-1) As String +Public sPathErrorDocument(SBMAXAPPLCOUNT-1) As String +Public sPathErrorStarDoc(SBMAXAPPLCOUNT-1) As String +Public sStarDocLabel(SBMAXAPPLCOUNT-1) As String +Public sImportLabel As String, sExportLabel As String +Public sSearchInSubDir As String +Public SOApplicationName(5) As String +Public sHelpButton As String, sCancelButton As String, sBackButton As String, sNextButton As String +Public sSumInclusiveSubDir As String, sSumSaveDocuments As String +Public sSummaryHeader As String +Public sWelcometextLabel1 As String, sWelcometextLabel2 As String, sWelcometextLabel3 As String +Public sBeginButton As String, sMsgDirNotThere As String +Public sQueryForNewCreation As String, sPathError3 As String +Public sNoDirCreation As String +Public sProgressMoreDocs As String, sProgressMoreTemplates as String +Public sFileExists As String, sMorePathsError3 As String +Public sConvertError1 As String, sConvertError2 As String, sPathDialogMessage As String +Public sRTErrorDesc As String, sRTErrorHeader As String +Public sProgressPage_1 As String, sProgressPage_2 As String, sProgressPage_3 as String +Public sProgressFound as String, sProgresspage_5 as String +Public sContainerName(1) as String +Public sReady as String, sTitle as String + + +Sub LoadLanguage() + If InitResources("ImportWizard","imp") then + sHelpButton = GetResText(1000) + sCancelButton = GetResText(1001) + sBackButton = GetResText(1002) + sNextButton = GetResText(1003) + sBeginButton = GetResText(1004) + + sWelcometextLabel1 = ReplaceString(GetResText(1005), GetProductName(),"%PRODUCTNAME") + sWelcometextLabel2 = GetResText(1006) + sWelcometextLabel3 = GetResText(1007) + + ' Microsoft Documents + GetApplResourceArray(1008, 3, sMSTemplateCheckBox()) + + ' DocumentCheckbox- Captions + GetApplResourceArray(1012, 3, sMSDocumentCheckBox()) + + ' DocumentCheckbox- Captions + GetApplResourceArray(2012, 5, sSODocumentCheckBox()) + + 'StarOffice Applicationnames + GetApplResourceArray(2016,2, sSOHelperDocuments()) + + sImportLabel = GetResText(1033) + sExportLabel = GetResText(1034) + + sContainerName(0) = GetResText(1030) + + sContainerName(1) = "StarOffice" + + sSearchInSubDir = GetResText(1022) + sSumInclusiveSubDir = GetResText(1023) + sSumSaveDocuments = GetResText(1024) + sSumDocuments = GetResText(1025) + sSummaryHeader = GetResText(1031) + + sTemplateGroupName(0) = GetResText(1036) + sTemplateGroupName(1) = GetResText(1037) + sTemplateGroupName(2) = GetResText(1038) + + sProgressMoreDocs = GetResText(1041) + sProgressMoreTemplates = GetResText(1042) + sNoDirCreation = GetResText(1050) + sMsgDirNotThere = GetResText(1051) + sQueryForNewCreation = GetResText(1052) + sFileExists = GetResText(1053) + sMorePathsError3 = GetResText(1054) + sConvertError1 = GetResText(1055) + sConvertError2 = GetResText(1056) + sRTErrorDesc = GetResText(1057) + sRTErrorHeader = GetResText(1058) + sPathDialogMessage = GetResText(1080) + sTitle = GetResText(1081) + + sProgressPage_1 = GetResText(1090) + sProgressPage_2 = GetResText(1091) + sProgressPage_3 = GetResText(1092) + sProgressFound = GetResText(1093) + sProgressPage_5 = GetResText(1094) + sReady = GetResText(1100) + ImportDialogArea.Title = sTitle + End If +End Sub + + +Sub GetApplResourceArray(StartResIndex as Integer, Count as Integer, BigArray()) +Dim i as Integer +Dim a as Integer + a = 0 + For i = StartResIndex To StartResIndex + Count-1 + BigArray(a) = GetResText(i) + a = a + 1 + Next +End Sub + + +Sub LoadLibrary(sLibname as String) +Dim oArg(0) as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/importwizard/Main.xba b/wizards/source/importwizard/Main.xba new file mode 100644 index 000000000..856a7b74f --- /dev/null +++ b/wizards/source/importwizard/Main.xba @@ -0,0 +1,224 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Main" script:language="StarBasic">' ***** BASIC ***** +' Todo: Problematik der VBA-Makros, die angeblich nicht mit abgespeichert werden können. +' Evt. Erkennen der Arbeitsverzeichnisse von MS Office +' Filternamen für Ziel-XML-Dokumente und deren Extensionen feststellen (auch für StarMath) +' Extension für XML-Vorlagen klären +Public HeaderPreviews(4) as Object +Public ImportDialog as Object +Public ImportDialogArea as Object + +Sub Main + LoadLibrary("Tools") + sCRLF = CHR(10) & CHR(13) + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + If Not bDebugWizard Then + On Error Goto RTError + End If + SOBitmapPath = GetOfficeSubPath("Template", "wizard/bitmap") + SOWorkPath = ConvertToUrl(GetPathSettings("Work", False)) + SOTemplatePath = ConvertToUrl(GetPathSettings("Template",False,1)) + bCancelTask = False + CurOffice = 0 + ImportDialogArea = LoadDialog("ImportWizard","ImportDialog") + + ImportDialog = ImportDialogArea.Model + LoadLanguage() + FillStep_Welcome() + RepaintHeaderPreview() + SetStates() + ImportDialogArea.execute + Exit Sub +RTError: + Msgbox sRTErrorDesc, 16, sRTErrorHeader +End Sub + + +Sub SetStates + With ImportDialog + .OptSODocuments.State = 1 + .OptMSDocuments.State = 0 + .TemplateCheckbox.State = 1 + .DocumentPathCheckbox.State = 0 + End With +End Sub + + +Sub NextStep +Dim iCurStep as Integer + If Not bDebugWizard Then + On Error Goto RTError + End If + + iCurStep = ImportDialog.Step + Select Case iCurStep + Case 1 + FillStep_InputPaths(0, True) + Case 2 + If SaveStep_InputPath Then + If CurOffice < ApplCount - 1 Then + CurOffice = CurOffice + 1 + FillStep_InputPaths(CurOffice, False) + RepaintHeaderPreview() + Else + FillStep_Summary() + End If + End If + Case 3 + FillStep_Progress() + Select Case WizardMode + Case SBMICROSOFTMODE + Call ConvertAllDocuments(MSFilterName()) + CASE SBXMLMODE + Call ConvertAllDocuments(XMLFilterName()) + End Select + Case 4 + End Select + Exit Sub +RTError: + Msgbox sRTErrorDesc, 16, sRTErrorHeader +End Sub + + + +Sub PrevStep +Dim iCurStep as Integer + If Not bDebugWizard Then + On Error Goto RTError + End If + iCurStep = ImportDialog.Step + Select Case iCurStep + Case 4 + FillStep_Summary() + Case 3 +'Todo: müssen auch beim Zurücksteppen wirklich die Importpfade auf ihre Gültigkeit hin überprüft werden? + FillStep_InputPaths(Applcount-1, False) + Case 2 + If SaveStep_InputPath Then + If CurOffice > 0 Then + CurOffice = CurOffice - 1 + FillStep_InputPaths(CurOffice, False) + RepaintHeaderPreview() + Else + FillStep_Welcome() +' bDoKeepApplValues = True + End If + End If + End Select + + Exit Sub +RTError: + Msgbox sRTErrorDesc, 16, sRTErrorHeader +End Sub + + +Sub CancelButton + If ImportDialog.Step = 4 Then + Call CancelButtonPressed() + Else + ImportDialogArea.EndExecute + ImportDialogArea.Dispose + End + End If +End Sub + + +Sub CancelTask() + If Msgbox(sConvertError1, 36, sConvertError2) = 6 Then + ImportDialogArea.EndExecute + ImportDialogArea.Dispose + End + Else + bCancelTask = False + ImportDialog.cbCancel.Enabled = True + End If +End Sub + + +Sub CancelButtonPressed() + ImportDialog.cbCancel.Enabled = False + bCancelTask = True +End Sub + + +Sub TemplateDirSearchDialog() + CallDirSearchDialog(ImportDialog.TemplateImportPath) +End Sub + + +Sub RepaintHeaderPreview() +Dim Bitmap As Object +Dim CurStep as Integer +Dim sBitmapPath as String + CurStep = ImportDialog.Step + If CurStep = 2 Then + sBitmapPath = SOBitmapPath & WizardMode & "-Import_" & CurStep & "-" & Val(Applications(CurOffice,9))+1 & ".bmp" + Else + sBitmapPath = SOBitmapPath & "Import_" & CurStep & ".bmp" + End If + Set Bitmap = LoadPicture (sBitmapPath) + ImportDialog.ImportPreview.ImageURL = sBitmapPath +End Sub + + +Sub HelperDialog() +'Todo: The String "start" can be replaced by a HelpIndex + StarDesktop.LoadComponentfromUrl("vnd.sun.star.help://" & sDocType & "/start", "_OFFICE_HELP", 64, NoArgs()) +End Sub + + +Sub DisorEnableCheckboxes(oEvent as Object) +Dim bMSEnable, bXMLEnable as Boolean + Select Case oEvent.Source.Model.Tag + Case "MS" + bMSEnable = true + bXMLEnable = false + Case "XML" + bMSEnable = false + bXMLEnable = true + End Select + With ImportDialog + .ChkFirstSOApplication.Enabled = bXMLEnable + .ChkSecondSOApplication.Enabled = bXMLEnable + .ChkThirdSOApplication.Enabled = bXMLEnable + .ChkFourthSOApplication.Enabled = bXMLEnable + .ChkFirstMSApplication.Enabled = bMSEnable + .ChkSecondMSApplication.Enabled = bMSEnable + .ChkThirdMSApplication.Enabled = bMSEnable + .WelcomeTextLabel2.Enabled = bMSEnable + End With + DisOrEnableNextButton() +End Sub + + +Sub DisOrEnableNextButton() +Dim iCurStep as Integer +Dim bDoEnable as Boolean +Dim i as Integer + + iCurStep = ImportDialog.Step + Select Case iCurStep + Case 1 + With ImportDialog + If .OptMSDocuments.State Then + bDoEnable = .ChkFirstMSApplication.State Or .ChkSecondMSApplication.State Or .ChkThirdMSApplication.State + Else + bDoEnable = .ChkFirstSOApplication.State Or .ChkSecondSOApplication.State Or .ChkThirdSOApplication.State Or .ChkFourthSOApplication.State + End If + End With +' bDoKeepApplValues = False + Case 2 + bDoEnable = CheckControlPath(ImportDialog.TemplateImportPath, True) + bDoEnable = CheckControlPath(ImportDialog.TemplateExportPath, bDoEnable) + bDoEnable = CheckControlPath(ImportDialog.DocumentImportPath, bDoEnable) + bDoEnable = CheckControlPath(ImportDialog.DocumentExportPath, bDoenable) + End Select + ImportDialog.cbGoOn.Enabled = bDoEnable +End Sub + + +Function ControlStateToBool(iState) + ControlStateToBool = (Val(iState) = 1) +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/BankHoliday.xba b/wizards/source/schedule/BankHoliday.xba new file mode 100644 index 000000000..efaf77180 --- /dev/null +++ b/wizards/source/schedule/BankHoliday.xba @@ -0,0 +1,156 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="BankHoliday" script:language="StarBasic">Option Explicit + +Sub Main() + Call CalAutopilotTable() +End Sub + + +Function CalEasterTable&(byval Year%) + + Dim B,C,D,E,F,G,H,I,K,L,M,N,O, nMonth, nDay As Integer + + N = Year% mod 19 + B = int(Year% / 100) + C = Year% mod 100 + D = int(B / 4) + E = B mod 4 + F = int((B + 8) / 25) + G = int((B - F + 1) / 3) + H =(19 * N + B - D - G + 15) mod 30 + I = int(C / 4) + K = C mod 4 + L =(32 + 2 * E + 2 * I - H - K) mod 7 + M = int((N + 11 * H + 22 * L) / 451) + O = H + L - 7 * M + 114 + nDay = O mod 31 + 1 + nMonth = int(O / 31) + CalEasterTable& = DateSerial(Year%, nMonth,nDay) +End Function + + + +Sub CalInitGlobalVariablesDate() + Dim Count% + + For Count% = 1 To 374 + CalBankholidayName$(Count%) = "" + CalTypeOfBankHoliday%(Count%) = cHolidayType_None + Next +End Sub + + + +Sub CalInsertBankholiday(byval actDate&, byval Event$, ByVal nBankholidayLevel%) + Dim DayInYear% + ' Fuegt ein Ereignis in das globale EventArray ein. + ' Der Sonderfall der eintreten kann, ist der, dass das Datum + ' an dem eingefuegt werden soll, bereits ein Ereignis enthaelt. + ' Dann werden beide Ereignisse mit einem Schraegstrich verbunden. + DayInYear% =(Month(actDate&)-1)*31 +Day(actDate&) + + ' Hoehere Prioritaet des Feiertagtyps + If (0 <> CalTypeOfBankHoliday%(DayInYear%)) Then + If (nBankholidayLevel% < CalTypeOfBankHoliday%(DayInYear%)) Then + CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% + End If + Else + CalTypeOfBankHoliday%(DayInYear%) = nBankholidayLevel% + End If + + If (CalBankHolidayName$(DayInYear%) = "") Then + CalBankHolidayName$(DayInYear%) = Event$ + Else + CalBankHolidayName$(DayInYear%) = CalBankHolidayName$(DayInYear%) + " / " + Event$ + End If +End Sub + + + +Function CalIsLeapYear%(ByVal TheYear%) + CalIsLeapYear% = TheYear Mod 4 = 0 +End Function + + +Function CalMaxDayInMonth%(byval YearVal%, byval MonthVal%) + ' Liefert den maximalen Tag eines Monats in einem + ' bestimmten Jahr. + + Dim tmpDate& + Dim MaxDay% + + MaxDay = 28 + tmpDate& = DateSerial(YearVal%, MonthVal%, MaxDay) + + While Month(tmpDate&) = MonthVal% + MaxDay% = MaxDay% + 1 + tmpDate& = tmpDate& + 1 + Wend + Maxday% = MaxDay% - 1 + CalMaxDayInMonth% = MaxDay% +End Function + + +Function CalGetIntOfShortMonthName%(byval MonthName$) + + Dim nCount%, nMonth% + + nMonth% = Val(MonthName$) + + If (1 <= nMonth% And 12 >= nMonth%) Then + CalGetIntOfShortMonthName% = nMonth% + Exit Function + End If + + MonthName$ = UCase(Trim(Left(MonthName, 3))) + + For nCount% = 1 To 12 + If (UCase(cCalShortMonthNames$(nCount%)) = MonthName$) Then + CalGetIntOfShortMonthName% = nCount% + Exit Function + End If + Next + + ' Not Found + CalGetIntOfShortMonthName% = 0 +End Function + + +Sub CalInsertOwnDataInTables(byval YearToInsert%) + ' Fügt die eigenen Individuellen Daten aus der Tabelle in die + ' bereits erstellte unsortierte Tabelle ein. + Dim i%, actYear%, actMonth%, actDay%, theEvent$ + + For i = 0 To lbOwnData.ListCount() - 1 + actYear% = Val(Mid$(lbOwnData.List(i%), 10, 4)) + If (actYear%=YearToInsert%) Or (actYear%=0) Then + actMonth% = CalGetIntOfShortMonthname%(Mid$(lbOwnData.List(i%), 5, 3)) + actDay% = Val(Left$(lbOwnData.List(i%), 2)) + theEvent$ = Trim(Mid$(lbOwnData.List(i%), 16)) + CalInsertBankholiday(DateSerial(actYear%, actMonth%, actDay%), theEvent$, cHolidayType_Own) + End If + Next +End Sub + + +' Finds eg the first,second Monday in a month +' Note: in This Function the week starts with the Sunday +Function GetMonthDate(iWeekDay, iMonth, iCount as Integer) +Dim bFound as Boolean +Dim nCount%,lDate as Integer + ' 1st Tue in Nov : Election Day, Half + bFound = False + nCount% = 0 + lDate = DateSerial(YearInt%, iMonth, 1) + While Not bFound + If (iWeekDay = WeekDay(lDate)) Then nCount% = nCount% + 1 + If (nCount < iCount) Then + lDate = lDate + 1 + Else + bFound = True + End If + Wend + GetMonthDate = lDate +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CalendarMain.xba b/wizards/source/schedule/CalendarMain.xba new file mode 100644 index 000000000..845416371 --- /dev/null +++ b/wizards/source/schedule/CalendarMain.xba @@ -0,0 +1,212 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CalendarMain" script:language="StarBasic">Option Explicit + +Const _DEBUG = 0 + +' CalenderMain +Public sCurLangLocale as String + +' Dieses Flag dient zur Abfrage ob die individuellen Daten abgespeichert werden sollen. +Public CalOwnDataChanged% + +'BankHolidayFunctions +Public CalBankholidayName$ (1 To 374) +Public CalTypeOfBankHoliday% (1 To 374) + +Public Const cHolidayType_None = 0 +Public Const cHolidayType_Full = 1 +Public Const cHolidayType_Half = 2 +Public Const cHolidayType_Own = 4 + +'Dlg_Control +Public CalTWIPSPicHeight%, CalTWIPSPicWidth%, CalStartX%, CalStartY% + +Public CalPicWidth%, CalPicHeight% + +Public cCalSubCmdDeleteSelect_DeleteSelEntry$ +Public cCalSubCmdDeleteSelect_DeleteSelEntryTitle$ +Public cCalSubcmdSwitchOwnDataOrGeneral_Back$ +Public cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ + +'Language +Public cCalLongMonthNames$(12) +Public cCalShortMonthNames$(12) + +Public sBitmapFilename$ +Public sCalendarTitle$, sMonthTitle$, sWizardTitle$, sError$ +Public cCalStyleWorkday$, cCalStyleWeekend$ + +' German only +' Variablen, die zur Verwaltung der Eingabe der Bundesländer dienen +Public CalChoosenLand%, MouseClicked%, LandWhenClick% +Public LastMousePosX, LastMousePosY As Single + +Public oDocument as Object +Public oSheets as Object +Public oSheet as Object +Public DlgBuffer as Object +Public oStatusLine as Object + +' BL* bedeutet BundesLand* +Public CONST CalBLBayern = 1 +Public CONST CalBLBadenWuert = 2 +Public CONST CalBLBerlin = 3 +Public CONST CalBLBremen = 4 +Public CONST CalBLBrandenburg = 5 +Public CONST CalBLHamburg = 6 +Public CONST CalBLHessen = 7 +Public CONST CalBLMeckPomm = 8 +Public CONST CalBLNiedersachsen = 9 +Public CONST CalBLNordrheinWest = 10 +Public CONST CalBLRheinlandPfalz = 11 +Public CONST CalBLSaarland = 12 +Public CONST CalBLSachsen = 13 +Public CONST CalBLSachsenAnhalt = 14 +Public CONST CalBLSchlHolstein = 15 +Public CONST CalBLThueringen = 16 + + +Sub CalAutopilotTable() + +' On Error Goto ErrorHandler + Application.LoadLibrary("tools") + ' HauptRoutine zur Erstellung des Kalenders + Set DlgBuffer = DlgCalendar + + DlgBuffer.Load() + sCurLangLocale = StarDesktop.ISOLocale.Language + LoadLanguage(sCurLangLocale) + ' Da modulübergreifende Variablen unsicher sind, + ' wird ihre Initialisierung noch einmal explizit + ' angegeben. + CalInitGlobalVariablesDate() + CalCalcPictureData() + CalChoosenLand% = -2 + MouseClicked% = False + + ' Die Daten für die eigenen Ereignisdaten werden geladen. + CalLoadOwnData() + DlgBuffer.lbOwnData.FontName = "Courier" + DlgBuffer.cmdDelete.Enabled = False + DlgBuffer.txtMonth.Text = cCalShortMonthNames$(Month(Now())) + DlgBuffer.txtMonth.Tag = DlgBuffer.txtMonth.Text + DlgBuffer.OptYear.SetFocus() + DlgBuffer.OptYear.Value = True + CalChooseCalendar() ' month + + ' Jahr und Monat werden ermittelt + DlgBuffer.txtYear.Text = Year(Now()) + DlgBuffer.txtYear.Tag = DlgBuffer.txtYear.Text + + DlgBuffer.cmbState.ListIndex = 0 + + DlgBuffer.CurrentStep = 1 + + DlgBuffer.Show() + Exit Sub + +ErrorHandler: + MsgBox(sError$, 16, sWizardTitle$) +End Sub + + +Sub CalChooseCalendar() + DlgBuffer.lblYear.Enabled = True + DlgBuffer.txtYear.Enabled = True + DlgBuffer.spinButton1.Enabled = True + DlgBuffer.cmbState.Enabled = True + + DlgBuffer.txtMonth.Enabled = DlgBuffer.optMonth.Value + DlgBuffer.lblMonth.Enabled = DlgBuffer.optMonth.Value + DlgBuffer.spinButton3.Enabled = DlgBuffer.optMonth.Value +End Sub + + +Sub CalCmdCancel() + If CalOwnDataChanged% Then + Call CalSaveOwnData() + End If + DlgBuffer.Unload() +End Sub + + + +Sub CalCmdOk() + ' cmdOk is called when the Button 'Read' is clicked on + ' It is either given out a month or a year + Dim i, iSelYear as Integer + Dim SelYear as String + DlgBuffer.Hide() + + If cLANGUAGE_GERMAN = sCurLangLocale Then + If MouseClicked% Then + CalChoosenLand%=LandWhenClick% + Else + CalChoosenLand% = 0 + End If + End If + + oDocument = StarDesktop.ActiveFrame.Controller.Model + oSheets = oDocument.sheets + If CalOwnDataChanged% Then + Call CalSaveOwnData() + End If + + ' Unprotect all tables so they can be deleted or modified + For i = 0 To oSheets.Count - 1 + oSheets.GetbyIndex(i).unprotect("") + Next + oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) + + iSelYear = Val(txtYear.Text) + Select Case sCurLangLocale + Case cLANGUAGE_GERMAN + Call CalFindWholeYearHolidays_GERMANY(iSelYear, CalChoosenLand%) + Case cLANGUAGE_ENGLISH + Call FindWholeYearHolidays_US(iSelYear) + Case cLANGUAGE_FRENCH + Call FindWholeYearHolidays_FRANCE(iSelYear) + Case cLANGUAGE_ITALIAN + Call FindWholeYearHolidays_ITA(iSelYear) + Case cLANGUAGE_SPANISH + Call FindWholeYearHolidays_SPAIN(iSelYear) + Case cLANGUAGE_PORTUGUESE + Call FindWholeYearHolidays_PORT(iSelYear) + Case cLANGUAGE_DUTCH + Call FindWholeYearHolidays_NL(iSelYear) + Case cLANGUAGE_SWEDISH + Call FindWholeYearHolidays_SWED(iSelYear) + Case cLANGUAGE_DANISH + Call FindWholeYearHolidays_DK(iSelYear) + Case cLANGUAGE_POLISH + Call FindWholeYearHolidays_PL(iSelYear) + Case cLANGUAGE_RUSSIAN + Call FindWholeYearHolidays_RU(iSelYear) + End Select + + Call CalInsertOwnDataInTables(iSelYear) + + oStatusline = oDocument.GetCurrentController.GetFrame.GetStatusIndicator + + If optYear.Value Then + oSheets.RemovebyName(oSheets.GetbyIndex(0).Name) + oSheet = oSheets.GetbyIndex(0) + oSheet.Name = sCalendarTitle$ + " " + txtYear.Text + oDocument.AddActionLock + Call CalCreateYearTable(iSelYear) + ElseIf optMonth.Value Then + oSheets.RemovebyName(oSheets.GetbyIndex(1).Name) + oSheet = oSheets.GetbyIndex(0) + oSheet.Name = sMonthTitle$ + " " + cCalLongMonthNames$(CalGetIntOfShortMonthName%(txtMonth.Text)) + oDocument.AddActionLock + Call CalCreateMonthTable(iSelYear, CalGetIntOfShortMonthName%(txtMonth.Text)) + End If + + oDocument.RemoveActionLock + ' Protect the remaining sheet + oSheet.protect("") + oStatusLine.End + DlgBuffer.Unload() +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/CreateTable.xba b/wizards/source/schedule/CreateTable.xba new file mode 100644 index 000000000..5ef472639 --- /dev/null +++ b/wizards/source/schedule/CreateTable.xba @@ -0,0 +1,137 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="CreateTable" script:language="StarBasic">Option Explicit + +Public Const FirstDayRow = 5 ' Row on month sheet for first day of month +Public Const DateColumn% = 3 ' Column on month sheet with days +Public Const NewYearRow = 4 ' Row on year sheet for January 1st +Public Const NewYearColumn = 2 ' Column on year sheet for January 1st + + +Sub CalCreateYearTable(ByVal YearInt%) +' Completes the overview for whole year + +' Needed by StarOffice Calc and StarOffice Schedule +Dim CalDay%, CalMonth%, Count%, nCount% + +' Only needed by StarOffice Schedule +Dim oYearCell as object +Dim iDate +Dim i, s as Integer +Dim ColPos, RowPos as Integer +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long +Dim oRangeFebCell, oCellAddress, oFebcell as Object +Dim oRangeBlank as Object +Dim sBlankStyle as String + On Error Goto ErrorHandling + oStatusLine.Start(GetResText(sProgress),140) + + iDate = DateSerial(Val(DlgBuffer.txtYear.Text),1,1) + + ' Insert year + oYearCell = oSheet.GetCellRangeByName("Year") + oYearCell.Value = Val(DlgBuffer.txtYear.Text) + ' Insert holidays + CalMonth% = 1 + CalDay% = 0 + s = 10 + oStatusLine.SetValue(s) + For i = 1 To 374 + CalDay = CalDay+1 + If CalDay = 32 Then + CalDay = 1 + CalMonth = CalMonth+1 + s = s + 10 + oStatusLine.SetValue(s) + End If + ColPos = NewYearColumn+(2*CalMonth) + RowPos = NewYearRow + CalDay + FormatCalCells(ColPos,RowPos,i) + Next + If NOT CalIsLeapYear(Val(txtYear.Text)) Then + ' Delete 29th February if necessary + oRangeFebCell = oSheet.GetCellRangeByName("Feb29") + oCellAddress = oRangeFebCell.RangeAddress + oFebCell = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) + oFebCell.String = "" + ' Change the CellStyle according to the Range "Blank" + oRangeBlank = oSheet.GetCellRangebyName("Blank") + sBlankStyle = oRangeBlank.CellStyle + oRangeFebCell.CellStyle = sBlankStyle + End If + oStatusLine.SetValue(150) + ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub CalCreateMonthTable(ByVal YearInt%, ByVal MonthInt%) +Dim oMonthCell, oDateCell as Object +Dim iDate as Date +Dim oAddress +Dim i, s as Integer +Dim StartDay%, TargetMonth% + +' Completes the monthly calendar +On Error Goto ErrorHandling + oStatusLine.Start(GetResText(sProgess),40) + ' Set month + TargetMonth% = CalGetIntOfShortMonthName%(txtMonth.Text) + oMonthCell = oSheet.GetCellRangeByName("Month") + + iDate = DateSerial(Val(DlgBuffer.txtYear.Text),TargetMonth%,1) + oMonthCell.Value = iDate + ' Inserting holidays + StartDay% = (TargetMonth% - 1) * 31 + 1 + s = 5 + For i = StartDay% To StartDay%+30 + oStatusLine.SetValue(s) + s = s + 1 + FormatCalCells(DateColumn+1,FirstDayRow+i-StartDay,i) + Next + oDateCell = oSheet.GetCellbyPosition(DateColumn,FirstDayRow+i-StartDay - 1) + oAddress = oDateCell.RangeAddress + + Select Case TargetMonth + Case 2,4,6,9,11 + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If TargetMonth = 2 Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + If Not CalIsLeapYear(Val(txtYear.Text)) Then + oAddress.StartRow = oAddress.StartRow - 1 + oAddress.EndRow = oAddress.StartRow + oSheet.RemoveRange(oAddress, com.sun.star.sheet.CellDeleteMode.ROWS) + End If + End If + End Select + oStatusLine.SetValue(45) +ErrorHandling: + If Err <> 0 Then + MsgBox sError$, 16, sWizardTitle$ + End If +End Sub + + + +Sub FormatCalCells(ColPos,RowPos,i as Integer) +Dim oNameCell, oDateCell as Object +Dim iCellValue as Long + oDateCell = oSheet.GetCellbyPosition(ColPos-1,RowPos) + If oDateCell.Value <> 0 Then + iCellValue = oDateCell.Value + oDateCell.Value = iCellValue + If CalBankHolidayName$(i) <> "" Then + oNameCell = oSheet.GetCellbyPosition(ColPos,RowPos) + oNameCell.String = CalBankHolidayName$(i) + If CalTypeOfBankHoliday%(i) = cHolidayType_Full Then + oDateCell.CellStyle = cCalStyleWeekend$ + End If + End If + End If +End Sub</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/DlgCalendar.xdl b/wizards/source/schedule/DlgCalendar.xdl new file mode 100644 index 000000000..b3874d002 --- /dev/null +++ b/wizards/source/schedule/DlgCalendar.xdl @@ -0,0 +1,7 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="DlgCalendar" dlg:style-id="0"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + </dlg:styles> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/schedule/DlgControl.xba b/wizards/source/schedule/DlgControl.xba new file mode 100644 index 000000000..659f8c02f --- /dev/null +++ b/wizards/source/schedule/DlgControl.xba @@ -0,0 +1,369 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="DlgControl" script:language="StarBasic">Option Explicit + +Dim CalBitmap As Object + + +Sub Main() + Call CalAutopilotTable() +End Sub + + +Sub CalSaveTextValues() + txtYear.Tag = txtYear.Text + txtMonth.Tag = txtMonth.Text +End Sub + + +Sub CalRestoreOldValues() + Beep + ' Start of the Gregorian Calendar + If int(Val(txtyear.Text)) < 1583 then + txtYear.Text = "1583" + Else + ' last year where the easter Routin works + txtYear.Text = "9956" + End If + txtMonth.Text = txtMonth.Tag +End Sub + + + +Sub CalChangeYear() + Dim ValNewYear& + ValNewYear& = Val(txtYear.Text) + If ((1583 > ValNewYear&) Or (9956 < ValNewYear&)) Then + Call CalRestoreOldValues() + End If +End Sub + + + +Sub CalCalcPictureData() + Dim bFittingX%, bFittingY%, DlgWidth%, DlgHeight%, nXMove%, nYMove%, Width%, Height% + Dim x#, y# + + Width% = 152 + Height% = 189 + BitmapDir = GetBitmapDir() + + Set CalBitmap = LoadPicture(BitmapDir & GetPathSeparator() & sBitmapFilename$ '(sCurLangLocale)) + If 1 = GetGUIType() Then + DlgHeight% = CInt(DlgBuffer.Preview1.Height * GetDialogZoomFactorY(DlgBuffer.Preview1.Height)) + DlgWidth% = CInt(DlgBuffer.Preview1.Width * GetDialogZoomFactorX(DlgBuffer.Preview1.Width)) + nXMove% = TwipsPerPixelX() * 3 + nYMove% = TwipsPerPixelX() * 3 + Else + DlgHeight% = CInt((DlgBuffer.Preview1.Height - TwipsPerPixelY() * 3) * GetDialogZoomFactorY(DlgBuffer.Preview1.Height)) + DlgWidth% = CInt((DlgBuffer.Preview1.Width - TwipsPerPixelX() * 3) * GetDialogZoomFactorX(DlgBuffer.Preview1.Width)) + nXMove% = 0 + nYMove% = 0 + End If + + CalTWIPSPicWidth% = TwipsPerPixelX() * Width% + CalTWIPSPicHeight% = TwipsPerPixelY() * Height% + + ' Beste Möglichkeit: Bild in Orignalgroesse zentrieren + ' Alternative : Nach schlchechter passenden Faktor skalieren + If (Not ((CalTWIPSPicWidth% <= DlgWidth%) And (CalTWIPSPicHeight% <= DlgHeight%))) Then + x# = (CalTWIPSPicWidth% / DlgWidth%) + y# = (CalTWIPSPicHeight% / DlgHeight%) + If (x# > y#) Then + CalTWIPSPicWidth% = CInt(DlgWidth%) + CalTWIPSPicHeight% = CInt(CalTWIPSPicHeight% / x#) + Else + CalTWIPSPicHeight% = CInt(DlgHeight%) + CalTWIPSPicWidth% = CInt(CalTWIPSPicWidth% / y#) + End If + End If + + CalStartX% = CInt((DlgWidth% / 2) - (CalTWIPSPicWidth% / 2)) - nXMove% + CalStartY% = CInt((DlgHeight% / 2) - (CalTWIPSPicHeight% / 2)) - nYMove% +End Sub + + + +Sub CalPreviewPaint() + Preview1.Cls() + Preview1.DrawPicture(CalBitmap, CalStartX%, CalStartY%, CalStartX% + CalTWIPSPicWidth%, CalStartY% + CalTWIPSPicHeight%) + Preview1.DrawBox(CalStartX%, CalStartY%, CalStartX% + CalTWIPSPicWidth%, CalStartY% + CalTWIPSPicHeight%) +End Sub + + + +Sub CalcmdDeleteSelect() + + Dim Count%, CountMarked%, MsgBoxResult%, AllSelected% + + AllSelected = False + CountMarked% = 0 + For Count% = 0 To lbOwnData.ListCount-1 + If (DlgBuffer.lbOwnData.Selected(Count%) = True) Then CountMarked% = CountMarked% + 1 + Next + + If (CountMarked% > 0) Then + MsgBoxResult% = MsgBox(cCalSubCmdDeleteSelect_DeleteSelEntry$, 4+32, cCalSubCmdDeleteSelect_DeleteSelEntryTitle$) + + If MsgBoxResult% = 6 Then + If Not AllSelected% Then + Call CalDeleteAllSelected() + Else + DlgBuffer.lbOwnData.Clear() + End If + ' Flag zum Speichern der neuen Daten. + CalOwnDataChanged% = True + + cmdDelete.Enabled = False + Call CalClearInputMask() + End If + End If +End Sub + + + +Sub CalDeleteAllSelected() + + Dim Count%, LastSelPos% + + While LastSelPos% <> -1 + LastSelPos% = -1 + For Count%=0 To lbOwnData.ListCount()-1 + If DlgBuffer.lbOwnData.Selected(Count%) Then LastSelPos% = Count% + Next + If LastSelPos% <> - 1 Then + DlgBuffer.lbOwnData.RemoveItem(LastSelPos%) + End If + Wend + DlgBuffer.lbOwnData.Refresh() +End Sub + + + +Sub CalSaveOwnEventControls() + DlgBuffer.txtOwnEventDay.Tag = DlgBuffer.txtOwnEventDay.Text + DlgBuffer.txtOwnEventMonth.Tag = DlgBuffer.txtOwnEventMonth.Text + DlgBuffer.txtOwnEventYear.Tag = DlgBuffer.txtOwnEventYear.Text +End Sub + + + +Sub ModIntTextBox (txtYear As Object, ByVal nMax%, ByVal nMin%, ByVal sDefault$, IncFactor as Integer) + Dim nActVal& + nActVal& = Val(txtYear.Text) + If ((0 = nActVal&) Or (nMax% < nActVal&) Or (nMin% > nActVal&)) Then + Beep + txtYear.Text = sDefault$ + Exit Sub + End If + If IncFactor = 1 Then + If nMax% > nActVal& Then + txtYear.Text = Trim(Str(nActVal& + 1)) + Else + Beep + txtYear.Text = nMax% + End if + ElseIf IncFactor = -1 Then + If nMin% < nActVal& Then + txtYear.Text = Trim(Str(nActVal& - 1)) + Else + Beep + txtYear.Text = nMin% + End if + End If +End Sub + + +Sub CalSpinOwnEventDayUp() + Call ModIntTextBox(txtOwnEventDay, 31, 1, "1", 1) +End Sub + + +Sub CalSpinOwnEventDayDown() + Call ModIntTextBox(txtOwnEventDay, 31, 1, "1", -1) +End Sub + + +Sub CalSpinGeneralYearUp() + Call ModIntTextBox(txtYear, 9956, 1583, Trim(Str(Year(Now()))),1) +End Sub + + +Sub CalSpinGeneralYearDown() + Call ModIntTextBox(txtYear, 9956, 1583, Trim(Str(Year(Now()))), -1 ) +End Sub + + +Sub CalSpinOwnEventYearDown() + Call ModIntTextBox(txtOwnEventYear, 9956, 1583, Trim(Str(Year(Now()))), -1 ) +End Sub + + +Sub CalSpinOwnEventYearUp() + Call ModIntTextBox(txtOwnEventYear, 9956, 1583, Trim(Str(Year(Now()))) , 1) +End Sub + + +Sub CalModMonthTextBox(txtMonth As Object,IncFactor as Integer) + Dim nActVal& + nActVal& = Val(txtMonth.Text) + If (1 <= nActVal& And 12 >= nActVal) Then + txtMonth.Text = cCalShortMonthNames$(nActVal&) + End If + nActVal& = CalGetIntOfShortMonthName%(txtMonth.Text) + If 0 = nActVal& Then + Beep + txtMonth.Text = cCalShortMonthNames$(1) + ElseIf (1 < nActVal&) AND (IncFactor = -1) Then + txtMonth.Text = cCalShortMonthNames$(nActVal& + IncFactor) + ElseIf (12 > nActVal&)AND (IncFactor = 1) Then + txtMonth.Text = cCalShortMonthNames$(nActVal& + IncFactor) + End If +End Sub + + +Sub CalSpinGeneralMonthUp() + CalModMonthTextBox(txtMonth, 1) +End Sub + + +Sub CalSpinGeneralMonthDown() + CalModMonthTextBox(txtMonth,-1) +End Sub + + +Sub CalSpinOwnEventMonthDown() + Call CalModMonthTextBox(txtOwnEventMonth, -1) +End Sub + + +Sub CalSpinOwnEventMonthUp() + Call CalModMonthTextBox(txtOwnEventMonth, 1) +End Sub + + +Sub CalChkYearEnDisabled() + ' Falls der RadioButton für einen Jahreskalender angeklickt + ' worden ist, müssen die Controls für den Monat Disabled + ' werden, da ihre Werte in einer Jahrestabelle aufgehen. + lblEventYear.Enabled = Not lblEventYear.Enabled + txtownEventYear.Enabled = Not txtownEventYear.Enabled + SpinOwnEventYear.Enabled = Not SpinOwnEventYear.Enabled + If (txtOwnEventYear.Text = "") And (lblEventYear.Enabled = True) Then + txtOwnEventYear.Text = Trim$(Str$(Year(Now()))) + End If +End Sub + + +Sub CalMouseMoved(Button as integer, Shift as integer, X as single, Y as single) + + ' Nimmt Mousemoves ueber dem Bitmap entgegen, und wertet sie je nach + ' Land aus. + + Select Case sCurLangLocale + Case "de" 'cLANGUAGE_GERMAN + ' Ermittelt das Land auf dem sich der MausCursor befindet, und + ' aktualisiert die Textbox mit der Bundeslandbezeichnung, falls + ' ein Mausklick stattfandt. + Dim Land$ + If (Button = 1) Or (MouseClicked% = False)Then + cmbState.ListIndex = CalGetGermanLandAtMousePos(X, Y, Land$) + End If + End Select + + LastMousePosX = X + LastMousePosY = Y +End Sub + + +Sub CalChangeGeneralMonth() + + Dim MonthToCheck$ + Dim ValMonthToCheck% + + MonthToCheck$ = DlgBuffer.txtMonth.Text + ValMonthToCheck% = Val(MonthToCheck$) + + If (ValMonthToCheck% >= 1) And (ValMonthToCheck% <=12) Then + DlgBuffer.txtMonth.Text = cCalShortMonthNames$(ValMonthToCheck%) + Exit Sub + End If + + If CalGetIntOfShortMonthName%(Trim(Left(MonthToCheck$, 3))) = 0 Then + Beep + DlgBuffer.txtMonth.Text = DlgBuffer.txtMonth.Tag + Else + DlgBuffer.txtMonth.Text = Trim(Left(MonthToCheck, 3)) + End If + +End Sub + + + +Sub CalChkForChangeInsertAccept + ' Aktualisiert die Caption des Insert/Accept Buttons + If (DataSelectedFromList=True) And (ButtonCaptionIsInsert) Then + DlgBuffer.cmdInsert.Caption = cSubChkForChangeInsertAccept_Accpet$ + End If +End Sub + + + +Sub CalClearInputMask() + ' Löscht die Werte der Eingabe Controls für ein + ' neues Ereignis. + chkEventOnce.Value = False + lblEventYear.Enabled = False + txtownEventYear.Enabled = False + SpinOwnEventYear.Enabled = False + txtOwnEventYear.Text = "" + txtEvent.Text = "" + txtOwnEventDay.Text = "" + txtOwnEventMonth.Text = "" + + txtEvent.SetFocus() +End Sub + + + +Function CalCountSelected%(ByVal listBox as Object, PosSelect%) + ' Zählt die selekierten Einträge im Control listBox. + ' PosSelect liefert den Index des selektierten Eintrags + ' zurück. Dieser Wert ist natürlich nur zu gebrachen, + ' wenn nur ein Eintrag selektiert ist. + Dim Count%, Result% + + Result% = 0 + For Count% = 0 To listBox.ListCount-1 + If ListBox.Selected(Count%) Then + Result% = Result% + 1 + PosSelect% = Count% + End If + Next + CalCountSelected% = Result% +End Function + + + +Sub CalmdSwitchOwnDataOrGeneral() + + 'Ändert den Titel der Dialogbox beim Seitenwechsel und die + 'Beschriftungen der Knöpfe + If DlgBuffer.CurrentStep = 1 Then + DlgBuffer.CurrentStep = 2 + DlgBuffer.DlgCmdOwnData.Caption = cCalSubcmdSwitchOwnDataOrGeneral_Back$ + Else + DlgBuffer.CurrentStep = 1 + DlgBuffer.DlgCmdOwnData.Caption = cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ + End If +End Sub + + +Sub LoadDialog() + DlgBuffer.load +End Sub + +Sub ShowDialog() + DlgBuffer.Show +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/Language.xba b/wizards/source/schedule/Language.xba new file mode 100644 index 000000000..2289db2c1 --- /dev/null +++ b/wizards/source/schedule/Language.xba @@ -0,0 +1,155 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit + + +' L a n g u a g e c o n s t a n t s +' ----------------------------------- +Public Const cLANGUAGE_SYSTEM = "", cLANGUAGE_CHINESE = "zh", cLANGUAGE_DANISH = "da" +Public Const cLANGUAGE_DUTCH = "nl", cLANGUAGE_ENGLISH = "en", cLANGUAGE_FINNISH = "fi" +Public Const cLANGUAGE_FRENCH = "fr", cLANGUAGE_GERMAN = "de", cLANGUAGE_GREEK = "el" +Public Const cLANGUAGE_ITALIAN = "it", cLANGUAGE_JAPANESE = "ja", cLANGUAGE_NORWEGIAN = "no" +Public Const cLANGUAGE_POLISH = "pl", cLANGUAGE_PORTUGUESE = "pt", cLANGUAGE_RUSSIAN = "ru" +Public Const cLANGUAGE_SPANISH = "es", cLANGUAGE_SWEDISH = "sv", cLANGUAGE_TURKISH = "tr" + +Public BLNameList(1 To 16) as String + + +' R e s o u r c e s t r i n g c o n s t a n t s +' ------------------------------------------------- +' Dialog labels start at 1000 +Const dlgCalTitle = 1000 +Const dlgCalTitleBack = 1001 +Const dlgCalTitleOwnData = 1002 +Const dlgSchdlTitle = 1003 +Const dlgOK = 1004 +Const dlgCancel = 1005 +Const dlgCalFrameOption = 1006 +Const dlgCalOptionYear = 1007 +Const dlgCalOptionMonth = 1008 +Const dlgSchdlDescription = 1009 +Const dlgSchdlCountry = 1010 +Const dlgTime = 1011 +Const dlgYear = 1012 +Const dlgCalMonth = 1013 +Const dlgSpecificBankholidays = 1014 +Const dlgCalOwnData = 1015 +Const dlgCalInsert = 1016 +Const dlgCalDelete = 1017 +Const dlgCalNewEvent = 1018 +Const dlgCalEvent = 1019 +Const dlgCalEventOnce = 1020 +Const dlgCalEventDay = 1021 +Const dlgCalEventMonth = 1022 +Const dlgCalEventYear = 1023 +' Bitmap file is 1099 +Const dlgBitmapFile = 1099 +' Names of states start at 1100 +Const dlgState = 1100 +' Months start at 1200 +Const dlgMonth = 1200 +' Abreviated months start 1225 +Const dlgShortMonth = 1225 +' Messages start at 1300 +Const msgCalErrorTitle = 1300 +Const msgCalError = 1301 +Const msgCalRemoveTitle = 1302 +Const msgCalRemove = 1303 +' Styles start at 1400 +Const stlWorkday = 1400 +Const stlWeekend = 1401 +' Sheet names start at 1410 +Const nameCalYear = 1410 +Const nameCalMonth = 1411 +' Misc. schedule data starts at 1500 +Const sProgess = 1500 + + + +Sub LoadLanguage%(ByVal LangLocale) +Dim Dummy$, i, Count% + + If InitResources("Calendar-template", "cal") Then + + ' C o u n t r y s p p e c i f i c s e t t i n g s + ' --------------------------------------------------- + If LangLocale = cLANGUAGE_GERMAN Then + DlgBuffer.lblSpecBankholidays.Visible = True + DlgBuffer.cmbState.Visible = True + + ' Load all states + BLNameList(1) = "Bayern" + BLNameList(2) = "Baden-Württemberg" + BLNameList(3) = "Berlin" + BLNameList(4) = "Bremen" + BLNameList(5) = "Brandenburg" + BLNameList(6) = "Hamburg" + BLNameList(7) = "Hessen" + BLNameList(8) = "Mecklenburg-Vorpommern" + BLNameList(9) = "Niedersachsen" + BLNameList(10) = "Nordrhein-Westfalen" + BLNameList(11) = "Rheinland-Pfalz" + BLNameList(12) = "Saarland" + BLNameList(13) = "Sachsen" + BLNameList(14) = "Sachsen-Anhalt" + BLNameList(15) = "Schleswig Holstein" + BLNameList(16) = "Thüringen" + Dim FirstItem as String + + FirstItem = GetResText(dlgState) + DlgBuffer.cmbState.AddItem(FirstItem) + For i = 1 To Ubound(BLNameList()) + DlgBuffer.cmbState.AddItem(BLNameList(i)) + Next i + Else + DlgBuffer.lblSpecBankholidays.Visible = False + DlgBuffer.cmbState.Visible = False + End If + + ' L o a d r e s o u r c e s t r i n g s + ' ----------------------------------------- + ' Load dialog captions + sWizardTitle$ = GetResText(msgCalErrorTitle) + sError$ = GetResText(msgCalError) + cCalSubCmdDeleteSelect_DeleteSelEntryTitle$ = GetResText(msgCalRemoveTitle) + cCalSubCmdDeleteSelect_DeleteSelEntry$ = GetResText(msgCalRemove) + cCalSubcmdSwitchOwnDataOrGeneral_OwnData$ = GetResText(dlgCalTitleOwnData) + cCalSubcmdSwitchOwnDataOrGeneral_Back$ = GetResText(dlgCalTitleBack) + DlgBuffer.frmTime.Caption = GetResText(dlgTime) + DlgBuffer.lblYear.Caption = GetResText(dlgYear) + DlgBuffer.DlgCmdCancel.Caption = GetResText(dlgCancel) + DlgBuffer.DlgCmdOk.Caption = GetResText(dlgOK) + DlgBuffer.lblSpecBankholidays.Caption = GetResText(dlgSpecificBankholidays) + + ' Load bitmap file + sBitmapFilename$ = GetResText(dlgBitmapFile) + + ' Load calendar specific strings + DlgBuffer.Caption = GetResText(dlgCalTitle) + DlgBuffer.frmCalender.Caption = GetResText(dlgCalFrameOption) + DlgBuffer.optYear.Caption = GetResText(dlgCalOptionYear) + DlgBuffer.optMonth.Caption = GetResText(dlgCalOptionMonth) + DlgBuffer.lblMonth.Caption = GetResText(dlgCalMonth) + DlgBuffer.DlgCmdOwnData.Caption = GetResText(dlgCalOwnData) + DlgBuffer.frmNewEvent.Caption = GetResText(dlgCalNewEvent) + DlgBuffer.lblEvent.Caption = GetResText(dlgCalEvent) + DlgBuffer.lblEventDay.Caption = GetResText(dlgCalEventDay) + DlgBuffer.lblEventMonth.Caption = GetResText(dlgCalEventMonth) + DlgBuffer.lblEventYear.Caption = GetResText(dlgCalEventYear) + DlgBuffer.chkEventOnce.Caption = GetResText(dlgCalEventOnce) + DlgBuffer.cmdInsert.Caption = GetResText(dlgCalInsert) + DlgBuffer.cmdDelete.Caption = GetResText(dlgCalDelete) + ' Load long month names + For Count% = 0 To 11 + cCalLongMonthNames$(Count%+1) = GetResText(dlgMonth+Count%) + cCalShortMonthNames$(Count%+1)= Left$(cCalLongMonthNames$(Count%+1), 3) + Next + ' Load sheet names + sCalendarTitle$ = GetResText(nameCalYear) + sMonthTitle$ = GetResText(nameCalMonth) + ' Load names of styles + cCalStyleWorkday$ = GetResText(stlWorkday) + cCalStyleWeekend$ = GetResText(stlWeekend) + End If +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/schedule/OwnEvents.xba b/wizards/source/schedule/OwnEvents.xba new file mode 100644 index 000000000..e05a3cd5c --- /dev/null +++ b/wizards/source/schedule/OwnEvents.xba @@ -0,0 +1,348 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="OwnEvents" script:language="StarBasic">Option Explicit + +Sub Main + Call CalAutopilotTable() +End Sub + +Sub CalSaveOwnData() + ' Sichert die Daten, die im lbOwnData Control eingegeben wurden. + ' Die Datei heißt Date.Dat und wird ins Unterverzeichnis Konfiguration + ' des Office3 Verzeichnis geschrieben. + + Dim FileName$ + Dim FileChannel%, Count% + FileName$ = GetPathSettings("Config", False)+ GetPathSeparator() + "DATE.DAT" + ' Falls die Datei neu geschrieben wird, muß sie vorher gelöscht werden + If Dir$(FileName$) = "DATE.DAT" Then + kill(FileName$) + End If + + FileChannel% = FreeFile() + Open FileName$ For OUTPUT Access WRITE LOCK WRITE As FileChannel% + + Write #FileChannel%, "==========================================================" + Write #FileChannel%, "Don't edit this file," + Write #FileChannel%, "Don't edit this file!" + Write #FileChannel%, "----------------------------------------------------------" + Write #FileChannel%, "It is not allowed to edit this file! Don't edit this file!" + Write #FileChannel%, "==========================================================" + + For Count%=0 To DlgBuffer.lbOwnData.ListCount()-1 + Write #FileChannel%, DlgBuffer.lbOwnData.List(Count%) + Next + + Close #FileChannel% +End Sub + + +Sub CalLoadOwnData() + ' Lädt die Daten der persönlichen Ereignisse und + ' schreibt diese dann in das Control lbOwnData. + + Dim FileName$, tempStr$ + Dim FileChannel%, Count% + FileName$ = GetPathSettings("Config", False)+ GetPathSeparator() + "DATE.DAT" + + If Dir(FileName$) = "DATE.DAT" Then + FileChannel% = FreeFile() + Open FileName$ For INPUT Access READ LOCK READ As FileChannel% + + ' Kommentare werden eingelesen + For Count% = 1 To 6 + Line Input #FileChannel%, tempStr$ + Next + + ' Einfügen nach Reihenfolge sortiert. + While (not eof(#FileChannel%)) + Input #FileChannel%, tempStr$ + DlgBuffer.lbOwnData.AddItem(tempStr$) + Wend + + Close #FileChannel% + End If +End Sub + + +Function CalIsDataCorrect%() + ' Verifiziert die Eingaben der persönlichen Ereignisseite + ' und setzt, wenn ein Feld mit unsinnigen, oder fehlerhaften, + Dim sEvent$, sEvMonth$, sEvDay$, sEvYear$ + Dim nEvMonth% + sEvent$ = txtEvent.Text + sEvMonth$ = txtOwnEventMonth.Text + sEvDay$ = txtOwnEventDay.Text + sEvYear$ = txtOwnEventYear.Text + + CalIsDataCorrect% = True + + If "" = sEvent$ Then + CalIsDataCorrect% = SetFocusToControl(txtEvent) + Exit Function + End If + + If "" = sEvMonth$ Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + + If "" = sEvDay$ Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventDay) + Exit Function + End If + + nEvMonth% = Val(sEvMonth$) + + If 0 = nEvMonth% Then + nEvMonth% = CalGetIntOfShortMonthName%(sEvMonth$) + End If + + If (nEvMonth% < 1) Or (nEvMonth% > 12) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + + If chkEventOnce.Value And (sEvYear$ <> "") Then + If (Val(sEvYear$) <= 1582) Or (Val(sEvYear$) >= 9957) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventMonth) + Exit Function + End If + End If + + If (Val (sEvDay$) < 1) Or (Val (sEvDay$) > CalMaxDayInMonth%(Val(sEvYear$), nEvMonth%)) Then + CalIsDataCorrect% = SetFocusToControl(txtOwnEventDay) + Exit Function + End If +End Function + + +Function SetFocusToControl(oControl as Object) + Beep + oControl.SetFocus + SetFocusToControl = False +End Function + + +Function CalCreateDateFromInput&() + ' Generiert aus den Eingabedaten der Ereignisseite + ' ein Datum im Dateserial Format, + Dim newDate&, nMonth% + + nMonth% = Val (txtOwnEventMonth.Text) + If 0 = nMonth% Then + nMonth% = CalGetIntOfShortMonthName% (txtOwnEventMonth.Text) + End If + + newDate& = DateSerial(0, nMonth%, Val(txtOwnEventDay.Text)) + + If chkEventOnce.Value Then + newDate& = DateSerial(Val(txtOwnEventYear.Text), Month(newDate&), Day(newDate&)) + End If + CalCreateDateFromInput& = newDate& +End Function + + +Function CalCreateDateStrOfInput$() +Dim DateStr$ +Dim nMonth% + + If Not CalIsDataCorrect%() Then + CalCreateDateStrOfInput$ = "" + Exit Function + End If + + If Val(txtOwnEventDay.Text) < 10 Then + DateStr$ = " " + End If + + DateStr$ = DateStr$ + Trim(txtOwnEventDay.Text) + ". " + nMonth% = CalGetIntOfShortMonthName% (Trim(txtOwnEventMonth.Text)) + DateStr$ = DateStr$ + cCalShortMonthNames$ (nMonth%) + + If chkEventOnce.Value And txtOwnEventYear.Text <> "" Then + DateStr$ = DateStr$ + " " + Trim(txtOwnEventYear.Text) + Else + DateStr$ = DateStr$ + " " + End If + DateStr$ = DateStr$ + " " + Trim(txtEvent.Text) + CalCreateDateStrOfInput$ = DateStr$ +End Function + + +Function CalGetDateWithoutYear&(byval Pos%) + CalGetDateWithoutYear& = DateSerial(0, CalGetMonthOfEvent(Pos%), CalGetDayOfEvent(Pos%)) +End Function + + +Function CalExistDateInList%(byval newDate&) + + Dim Count%, lbActDate&, lbActEvent$, Result% + Dim nEvYear%, nEvMonth%, nEvDay% + + Result% = False + For Count%=0 To lbOwnData.ListCount()-1 + nEvYear% = CalGetYearOfEvent(Count%) + nEvMonth% = CalGetMonthOfEvent(Count%) + nEvDay% = CalGetDayOfEvent(Count%) + lbActDate& = DateSerial(nEvYear%, nEvMonth%, nEvDay%) + Result% = (lbactDate& = newDate&) + Next + CalExistDateInList% = Result% +End Function + + +Sub CalCmdInsertData() +Dim DateStr$, newDate&, Count%, Inserted%, Found% + + Inserted% = False + DateStr$ = CalCreateDateStrOfInput$() + If DateStr$ = "" Then Exit Sub + + ' Es ist noch garnichts vorhanden + If Not Inserted% And lbOwnData.ListCount()=0 Then + lbOwnData.AddItem(DateStr$) + Inserted% = True + End If + + ' Doppeltes Datum + newDate& = CalCreateDateFromInput&() + If ((False = Inserted%) And (True = CalExistDateInList (newDate))) Then + ' gleiche jahre(auch keine Jahre sind gleiche jahre)->alt löschen neu rein + Count% = 0 + While (DateSerial(CalGetYearOfEvent(Count%), CalGetMonthOfEvent(Count%), CalGetDayOfEvent(Count%))<>DateSerial(Year(newDate&), Month(newDate&), Day(newDate&))) + Count% = Count + 1 + Wend + ' beide Jahre gleich (auch: kein datum gesetzt) -> alt löschen neu rein + If ((CalGetYearOfEvent(Count%)=0 And Not chkEventOnce.Value) Or (chkEventOnce.Value And Val(txtOwnEventYear.Text)=CalGetYearOfEvent%(Count%))) Then + lbOwnData.RemoveItem(Count%) + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + + ' Es existiert ein Datum mit Jahreszahl. Es wird dasselbe Datum + ' ohne Angabe der Jahreszahl angegeben. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If Not Inserted% And Not chkEventOnce.Value Then + Dim temp& + Count% = 0 + While (Not Found%) And (Count% < lbOwnData.ListCount()) + temp& = CalGetDateWithoutYear%(Count%) + If (temp& = newDate&) Then + Found% = True + Else + Count% = Count% + 1 + End If + Wend + If Found% Then + If (CalGetYearOfEvent%(Count%)<>0) Then + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + End If + + ' Das einzufügende Datum besitzt eine Jahreszahl, es gibt bereits + ' das Datum in der Liste, jedoch ohne Datum. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If Not Inserted% And chkEventOnce.Value Then + Found% = False + Count% = 0 + While (Not Found%) And (Count% < lbOwnData.ListCount) + If (CalGetDateWithoutYear(Count%) = newDate&) Then + Found% = True + Else + Count% = Count% + 1 + End If + Wend + If Found% Then + Count% = Count% + 1 + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + End If + + ' Das Datum ist noch nicht vorhanden. + newDate& = CalCreateDateFromInput&() + newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + ' newDate& = Dateserial(0, Month(newDate&), Day(newDate&)) + If (Inserted%=False And CalExistDateInList(newDate)=False) Then + Found% = False + Count% = 0 + While (Count% < lbOwnData.ListCount() And Found% = False) + If (newDate& > CalGetDateWithoutYear&(Count%)) Then + Count% = Count% + 1 + Else + Found% = True + End If + Wend + lbOwnData.AddItem(DateStr$, Count%) + Inserted% = True + End If + + ' Flag zum Speichern der neuen Daten. + If Inserted% = True Then + CalOwnDataChanged% = True + End If + + ' Nachdem die Daten übernommen worden sind, werden sie aus + ' der Eingabe gelöscht + Call CalClearInputMask() +End Sub + + +Sub CalUpdateNewEventFrame() + Dim bEnable as Boolean + Dim Result%, actPos%, Count% + Dim sSelData$ + + Result% = CalCountSelected%(DlgBuffer.lbOwnData, actPos%) + If Result% = 1 Then + ' Daten unten anzeigen + sSelData$ = lbOwnData.List (actPos%) + txtEvent.Text = Trim (Mid$ (sSelData$, 16)) + txtOwnEventDay.Text = Trim (Left$ (sSelData$, 2)) + txtOwnEventMonth.Text = Str$ (Mid$ (sSelData$, 5, 3)) + + bEnable = Val (Trim (Mid$ (sSelData$, 10, 4))) > 0 + If bEnable Then + txtOwnEventYear.Text = Trim (Mid$ (sSelData$, 10, 4)) + Else + txtOwnEventYear.Text = "" + End If + chkEventOnce.Value = bEnable + lblEventYear.Enabled = bEnable + txtownEventYear.Enabled = bEnable + SpinOwnEventYear.Enabled = bEnable + Else + Call CalClearInputMask() + End If + + cmdDelete.Enabled = (1 <= Result%) +End Sub + + +Function CalGetYearOfEvent%(byval Pos%) + CalGetYearOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 10, 4)) +End Function + + +Function CalGetDayOfEvent%(byval Pos%) + CalGetDayOfEvent% = Val(Mid$(lbOwnData.List(Pos%), 1, 2)) +End Function + + +Function CalGetMonthOfEvent%(byval Pos%) + ' Liefert den Monat eines Ereignisses aus dem + ' Control lbOwnData als Zahl. + Dim sMonth$ + + sMonth$ = Mid$ (lbOwnData.List(Pos%), 5, 3) + CalGetMonthOfEvent% = CalGetIntOfShortMonthName% (sMonth$) +End Function + + +</script:module>
\ No newline at end of file diff --git a/wizards/source/template/Autotext.xba b/wizards/source/template/Autotext.xba new file mode 100644 index 000000000..96037115d --- /dev/null +++ b/wizards/source/template/Autotext.xba @@ -0,0 +1,138 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Autotext" script:language="StarBasic">Public UserfieldDataType(14) as String +Public oDocument as Object +Public BulletList(7) as Integer + +Sub Main() + ' Initialization... + 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 + + oDocument = StarDesktop.ActiveFrame.Controller.Model + oStyles = oDocument.Stylefamilies.NumberingStyles + + ' Prepare the Search-Descriptor + oSearchDesc = oDocument.createsearchDescriptor() + oSearchDesc.SearchRegularExpression = True + oSearchDesc.SearchWords = True + oSearchDesc.SearchString = "<[^>]+>" + oFoundall = oDocument.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 = oDocument.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 + oUserfield = oDocument.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 + StyleSet = False + For s = 0 To Ubound(BulletList()) + For n = 0 To oStyles.Count - 1 + ostyle = oStyles.getbyindex(n) + oStyleName = 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 = oStyle.Name + 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, sFoundContent as String) +Dim MaxIndex as Integer + oPlaceholder = oDocument.CreateInstance("com.sun.star.text.TextField.JumpEdit") + sFoundList() = ArrayoutofString(sFoundContent, ":" & chr(34),MaxIndex) + ' Delete The Double-quotes + oPlaceHolder.Hint = DeleteStr(sFoundList(1),chr(34)) + oPlaceHolder.placeholder = DeleteStr(sFoundList(2),chr(34)) + oCursor.Text.InsertTextContent(oCursor,oPlaceholder,True) +End Sub + + +</script:module>
\ No newline at end of file diff --git a/wizards/source/template/Correspondence.xba b/wizards/source/template/Correspondence.xba new file mode 100644 index 000000000..9a8883efd --- /dev/null +++ b/wizards/source/template/Correspondence.xba @@ -0,0 +1,215 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Correspondence" script:language="StarBasic">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 + +Sub Main + LoadLibrary("tools") + TemplateDialog = LoadDialog("Template", "TemplateDialog") + DialogModel = TemplateDialog.Model + DialogModel.Step = 2 + DialogModel.Optmerge.State = True + If LoadLanguageCorrespondence() Then + TemplateDialog.Execute + End If +End Sub + + +Function LoadLanguageCorrespondence() as Boolean +Dim oDBAccess as Object +Dim oAddressDialog as Object +Dim oFields as Object + + If InitResources("'Template'", "tpl") Then + oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") + sAddressbook = oDBAccess.DataSourceName + If sAddressbook = "" Then + oAddressDialog = CreateUnoService("com.sun.star.ui.AddressBookSourceDialog") + oAddressDialog.Execute + oDBAccess = GetRegistryKeyContent("org.openoffice.Office.DataAccess/AddressBook/") + sAddressbook = oDBAccess.DataSourceName + If sAddressbook = "" Then + LoadLanguageCorrespondence() = False + Exit Function + End If + End If + oFields = oDBAccess.GetByName("Fields") + Table = oDBAccess.GetByName("Command") + sCompany = GetFieldname(oFields, "Company") + sFirstName = GetFieldname(oFields, "FirstName") + sLastName = GetFieldname(oFields, "LastName") + sStreet = GetFieldname(oFields, "Street") + sPostalCode = GetFieldname(oFields, "Zip") + sCity = GetFieldname(oFields, "City") + sState = GetFieldname(oFields, "State") + sInitials = GetFieldname(oFields, "Code") + sPosition = GetFieldname(oFields, "Position") + msgNoTextmark$ = GetResText(1303) & Chr(13) & Chr(10) & GetResText(1301) + msgError$ = GetResText(1302) + DialogModel.Title = GetResText(1303) + DialogModel.CmdCancel.Label = GetResText(1102) + DialogModel.CmdCorrGoOn.Label = GetResText(1103) + DialogModel.OptSingle.Label = GetResText(1303 + 1) + DialogModel.Optmerge.Label = GetResText(1303 + 2) + LoadLanguageCorrespondence() = True + Else +' Todo: Meldung, was Passiert wenn Datenbank nicht angelegt werden konnte + LoadLanguageCorrespondence() = False + End If +End Function + + +Function GetFieldName(oFieldKnot as Object, GeneralFieldName as String) + If oFieldKnot.HasbyName(GeneralFieldName) Then + GetFieldName = oFieldKnot.GetbyName(GeneralFieldName).FieldName + Else + GetFieldName = "" + End If +End Function + + +Sub OK +Dim ParaBreak +Dim sDocLang as String +Dim bMerge as Boolean + bMerge = DialogModel.Optmerge.State +' Todo: das muss wieder rein! + DialogTemplate.EndExecute() + DialogExited = TRUE + If bMerge Then + ParaBreak = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK + oDocument = StarDesktop.ActiveFrame.Controller.Model + oBookmarks = oDocument.Bookmarks + oText = oDocument.Text + If oBookmarks.HasbyName("Recipient")Then + oBookMark = oDocument.BookMarks.GetbyName("Recipient") + Else + MsgBox msgNoTextmark, 16, msgError + Exit Sub + End If + oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) + OBookText = oBookMarkCursor.Text + sDocLang = oDocument.CharLocale.Language + Select Case sDocLang + Case "nl" + InsertDBField(sAddressbook, Table, sCompany) + oBookMarkCursor.Text.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertBookMarkString("T.a.v. ") + InsertDBField(sAddressbook, Table, sFirstName) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sLastName) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sStreet) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sPostalCode) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sCity) + + Case "en" + InsertDBField(sAddressbook, Table, sCompany) + oBookMarkCursor.Text.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sFirstName) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sLastName) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sStreet) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sCity) + InsertBookMarkString(", ") + InsertDBField(sAddressbook, Table, sState) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sPostalCode) + + Case "sv" + InsertDBField(sAddressbook, Table, sCompany) + oBookMarkCursor.Text.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sFirstName) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sLastName) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sStreet) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sPostalCode) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sCity) + + Case "ru" + InsertDBField(sAddressbook, Table, sPosition) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sCompany) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sLastName) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sInitials) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sPostalCode) + InsertBookMarkString(", ") + InsertDBField(sAddressbook, Table, sCity) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sStreet) + + Case Else + InsertDBField(sAddressbook, Table, sCompany) + oBookMarkCursor.Text.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sFirstName) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sLastName) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sStreet) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + oBookText.insertControlCharacter(oBookMarkCursor, ParaBreak, False) + InsertDBField(sAddressbook, Table, sPostalCode) + InsertBookMarkString(" ") + InsertDBField(sAddressbook, Table, sCity) + End Select + End If +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 InsertBookmarkString(sBookmarkString as String) + oBookText.InsertString(oBookMarkCursor, sBookmarkString, True) + oBookMarkCursor.CollapseToEnd() +End Sub + + +Sub LoadLibrary(sLibname as String) +Dim oArg(0) as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/template/DialogStyles.xdl b/wizards/source/template/DialogStyles.xdl new file mode 100644 index 000000000..84b22e802 --- /dev/null +++ b/wizards/source/template/DialogStyles.xdl @@ -0,0 +1,18 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="DialogStyles" dlg:left="170" dlg:top="93" dlg:width="120" dlg:height="169"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + </dlg:styles> + <dlg:bulletinboard> + <dlg:button dlg:style-id="0" dlg:id="cmdCancel" dlg:left="5" dlg:top="150" dlg:width="50" dlg:height="13" dlg:value="cmdCancel"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="Template.Samples.RestoreCurrentStyles"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="cmdOk" dlg:left="65" dlg:top="150" dlg:width="50" dlg:height="12" dlg:value="cmdOk"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="Template.Samples.CloseStyleDialog"/> + </dlg:button> + <dlg:menulist dlg:style-id="0" dlg:id="lbStyles" dlg:left="5" dlg:top="5" dlg:width="110" dlg:height="133"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="Template.Samples.SelectStyle"/> + </dlg:menulist> + </dlg:bulletinboard> +</dlg:window>
\ 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..829194001 --- /dev/null +++ b/wizards/source/template/ModuleAgenda.xba @@ -0,0 +1,203 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleAgenda" script:language="StarBasic">' 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 +'Dim DlgAgenda_gMsgNoCancel$ +Public TemplateDialog as Object +Public DialogModel as Object +Public sTrueContent as String +Public Bookmarkname as String + + + +Sub Initialize() +' User sets the type of minutes + LoadLibrary( "Tools" ) + TemplateDialog = LoadDialog("Template", "TemplateDialog") + DialogModel = TemplateDialog.Model + DialogModel.Step = 1 + LoadLanguageAgenda() + DialogModel.OptAgenda2.State = TRUE + DialogExited = FALSE + TemplateDialog.Execute +End Sub + + +Sub LoadLanguageAgenda() + If InitResources("'Template'", "tpl") Then + DlgAgenda_gMyName = GetResText(1200) + DialogModel.CmdCancel.Label = GetResText(1102) + DialogModel.CmdAgdGoon.Label = GetResText(1103) +' DlgAgenda_gMsgNoCancel$ = GetResText(1201) + DialogModel.FrmAgenda.Label = GetResText(1202) + DialogModel.OptAgenda1.Label = GetResText(1203) + DialogModel.OptAgenda2.Label = GetResText(1204) +' DialogModel.OptAgenda1.State = 1 + End If +End Sub + + +Sub ModifyTemplate() +Dim oDocument, oBookmarks, oBookmark, oBookmarkCursor, oTextField as Object +Dim i as Integer + + oDocument = StarDesktop.ActiveFrame.Controller.Model + oBookMarks = oDocument.Bookmarks + + On Local Error Goto NOBOOKMARK +' Todo: auch beim Schließen des Dialogs muss was passieren + 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 +' Todo: Was ist mit der Property 'TrueContent' geschehen? +' oTextField.TrueContent = sTrueContent + oTextField.Content = sTrueContent + End If + + NOBOOKMARK: + If Err <> 0 Then + RESUME NEXT + End If +End Sub + + +' Attention This Sub is also called from the correspondence stuff +Sub DisposeDocument + TemplateDialog.EndExecute + oDocument = StarDesktop.ActiveFrame.Controller.Model + oDocument.Dispose +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 = StarDesktop.ActiveFrame.Controller.Model + 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 + + LoadLibrary( "Tools" ) + oDocument = StarDesktop.ActiveFrame.Controller.Model + + 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 = StarDesktop.ActiveFrame.Controller.Model + + 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(aEvent as Object) +Dim CurTag as String +Dim Taglist() as String + CurTag = aEvent.Source.Model.Tag + Taglist() = ArrayoutOfString(CurTag, ";") + Bookmarkname = TagList(0) + sTrueContent = TagList(1) +End Sub +</script:module>
\ No newline at end of file diff --git a/wizards/source/template/Samples.xba b/wizards/source/template/Samples.xba new file mode 100644 index 000000000..d02e2da42 --- /dev/null +++ b/wizards/source/template/Samples.xba @@ -0,0 +1,179 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Samples" script:language="StarBasic">Option Explicit + +Const SAMPLES = 1000 +Const STYLES = 1100 +Const aTempFileName = "Berend_Ilko_Peter_Tom.vor" +Public Const Twip = 425 +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 + + +'-------------------------------------------------------------------------------------- +'Miscellaneous Section starts here + +Function PrepareForEditing(Optional ByVal oDocument) +'This sub is called when sample documents are loaded (load event). +'It checks whether the documents is read-only, in which case it +'offers the user to create a new (writable) document using the original +'as a template. +Dim DocPath as String +Dim MMessage as String +Dim MTitle as String +Dim RValue as Integer +Dim oNewDocument as Object +Dim mFileProperties(0) as New com.sun.star.beans.PropertyValue + PrepareForEditing = NULL + LoadLibrary( "Tools" ) + If InitResources("'Template'", "tpl") then + If IsMissing(oDocument) Then + oDocument = StarDesktop.ActiveFrame.Controller.Model + End If + If oDocument.IsReadOnly then + MMessage = GetResText(SAMPLES) + MTitle = GetResText(SAMPLES + 1) + RValue = Msgbox(MMessage, (128+48+1), MTitle) + If RValue = 1 Then + DocPath = oDocument.URL + mFileProperties(0).Name = "AsTemplate" + mFileProperties(0).Value = True + oNewDocument = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0, mFileProperties()) + PrepareForEditing() = oNewDocument +' If IsFatOffice() Then + ' If opened within a FatOffice Environment close doc. + ' Note: Due to a bug in Web office it is not possible to close the doc there + oDocument.Dispose() + ' End If + Else + PrepareForEditing() = NULL + End If + Else + PrepareForEditing() = oDocument + End If + End If +End Function + + + +'-------------------------------------------------------------------------------------- +'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 t as Integer +Dim MaxIndex as Integer + LoadLibrary("Tools") + If InitResources("'Template'", "tpl") then + oDocument = StarDesktop.ActiveFrame.Controller.Model + 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) + DialogModel.cmdCancel.Label = GetResText(STYLES+2) + DialogModel.cmdOk.Label = GetResText(STYLES+3) + Stylenames() = ReadDirectories(StylesDir, False, False, True,) + MaxIndex = Val(StyleNames(0,0))-1 + Dim cStyles(MaxIndex) + For t = 0 to MaxIndex + Files(t) = StyleNames(t+1,0) + cStyles(t) = StyleNames(t+1,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 user work directory + On Error Goto ErrorOcurred + aTempURL = GetPathSettings("Work", False) + aTempURL = aTempURL & "/" & aTempFileName + + While FileExists(aTempURL) + aTempURL=Left(aTempURL,(Len(aTempURL)-4)) & "_1.vor" + Wend + oDocument.storeToURL(aTempURL, NoArgs()) + Exit Sub + +ErrorOcurred: + MsgBox(GetResText( STYLES+1 ), 16, GetResText( STYLES )) + 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 + +' Todo:Diese Prozedur an das Dialog-Schließen Ereignis ranhängen +Sub KillTempFile() + If oUcbObject.Exists(aTempUrl) Then + oUcbObject.Kill(aTempUrl) + End If +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/template/TemplateDialog.xdl b/wizards/source/template/TemplateDialog.xdl new file mode 100644 index 000000000..b7d95a81a --- /dev/null +++ b/wizards/source/template/TemplateDialog.xdl @@ -0,0 +1,36 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" dlg:id="TemplateDialog" dlg:left="170" dlg:top="93" dlg:width="160" dlg:height="62" dlg:page="1"> + <dlg:styles> + <dlg:style dlg:style-id="0"/> + </dlg:styles> + <dlg:bulletinboard> + <dlg:titledbox dlg:style-id="0" dlg:id="FrmAgenda" dlg:left="5" dlg:top="5" dlg:width="85" dlg:height="47" dlg:page="1"> + <dlg:title dlg:value="FrmAgenda"/> + </dlg:titledbox> + <dlg:radiogroup> + <dlg:radio dlg:style-id="0" dlg:id="OptAgenda1" dlg:left="11" dlg:top="16" dlg:width="74" dlg:height="14" dlg:page="1" dlg:tag="TOP2;PT1" dlg:value="OptAgenda1"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="Template.ModuleAgenda.GetOptionValues"/> + </dlg:radio> + <dlg:radio dlg:style-id="0" dlg:id="OptAgenda2" dlg:left="11" dlg:top="33" dlg:width="73" dlg:height="14" dlg:page="1" dlg:tag="TOP1;PT2" dlg:value="OptAgenda2"> + <dlg:event dlg:listener-type="com.sun.star.awt.XItemListener" dlg:event-method="itemStateChanged" dlg:script-type="StarBasic" dlg:script-code="Template.ModuleAgenda.GetOptionValues"/> + </dlg:radio> + </dlg:radiogroup> + <dlg:button dlg:style-id="0" dlg:id="CmdCorrGoOn" dlg:left="100" dlg:top="16" dlg:width="50" dlg:height="13" dlg:page="2" dlg:value="CmdCorrGoOn"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="Template.Correspondence.OK"/> + </dlg:button> + <dlg:radiogroup> + <dlg:radio dlg:style-id="0" dlg:id="OptSingle" dlg:left="11" dlg:top="16" dlg:width="74" dlg:height="14" dlg:page="2" dlg:value="OptSingle"/> + <dlg:radio dlg:style-id="0" dlg:id="Optmerge" dlg:left="11" dlg:top="33" dlg:width="73" dlg:height="14" dlg:page="2" dlg:value="Optmerge"/> + </dlg:radiogroup> + <dlg:titledbox dlg:style-id="0" dlg:id="FrmCorr" dlg:left="5" dlg:top="5" dlg:width="85" dlg:height="47" dlg:page="2"> + <dlg:title dlg:value="FrmCorr"/> + </dlg:titledbox> + <dlg:button dlg:style-id="0" dlg:id="CmdAgdGoon" dlg:left="100" dlg:top="16" dlg:width="50" dlg:height="13" dlg:page="1" dlg:value="CmdAgdGoOn"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="Template.ModuleAgenda.ModifyTemplate"/> + </dlg:button> + <dlg:button dlg:style-id="0" dlg:id="CmdCancel" dlg:left="100" dlg:top="33" dlg:width="50" dlg:height="13" dlg:value="CmdCancel"> + <dlg:event dlg:listener-type="com.sun.star.awt.XActionListener" dlg:event-method="actionPerformed" dlg:script-type="StarBasic" dlg:script-code="Template.ModuleAgenda.DisposeDocument"/> + </dlg:button> + </dlg:bulletinboard> +</dlg:window>
\ No newline at end of file diff --git a/wizards/source/tools/Listbox.xba b/wizards/source/tools/Listbox.xba new file mode 100644 index 000000000..af6991888 --- /dev/null +++ b/wizards/source/tools/Listbox.xba @@ -0,0 +1,264 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Listbox" script:language="StarBasic">Option Explicit +Dim OriginalList() +Dim oDialogModel as Object + + +Sub InitializeListboxProcedures(oModel as Object, SourceListbox as Object) + Set oDialogModel = oModel + OriginalList()= SourceListbox.StringItemList() +End Sub + + +Sub CopyListboxItems(SourceListbox as Object, TargetListbox As Object) +Dim NullArray() + TargetListbox.StringItemList() = OriginalList() + SourceListbox.StringItemList() = NullArray() +End Sub + + +Sub FormMoveSelected(aEvent as Object) + Call MoveSelectedListBox(oDialogModel.lstFields, oDialogModel.lstSelFields) + Call FormSetMoveRights() +End Sub + + +Sub FormMoveAll() + Call CopyListboxItems(oDialogModel.lstFields, oDialogModel.lstSelFields) + Call FormSetMoveRights() +' CmdNext.SetFocus +End Sub + + +Sub FormRemoveSelected() + Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, False) + Call FormSetMoveRights() +End Sub + + +Sub FormRemoveAll() + Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, True) + Call FormSetMoveRights() +End Sub + + + +Sub MoveSelectedListBox(SourceListbox as Object, TargetListbox as Object) +Dim MaxCurTarget as Integer +Dim MaxSourceSelected as Integer +Dim n as Integer +Dim m as Integer +Dim CurIndex +Dim iOldTargetSelect as Integer +Dim iOldSourceSelect as Integer + MaxCurTarget = Ubound(TargetListbox.StringItemList()) + MaxSourceSelected = Ubound(SourceListbox.SelectedItems()) + Dim TargetList(MaxCurTarget+MaxSourceSelected+1) + If MaxSourceSelected > -1 Then + iOldSourceSelect = SourceListbox.SelectedItems(0) + If Ubound(TargetListbox.SelectedItems()) > -1 Then + iOldTargetSelect = TargetListbox.SelectedItems(0) + Else + iOldTargetSelect = -1 + End If + For n = 0 To MaxCurTarget + TargetList(n) = TargetListbox.StringItemList(n) + Next n + For m = 0 To MaxSourceSelected + CurIndex = SourceListbox.SelectedItems(m) + TargetList(n) = SourceListbox.StringItemList(CurIndex) + n = n + 1 + Next m + TargetListBox.StringItemList() = TargetList() + SourceListbox.StringItemList() = RemoveSelected (SourceListbox) + SetNewSelection(SourceListbox, iOldSourceSelect) + SetNewSelection(TargetListbox, iOldTargetSelect) + End If +End Sub + + + +Sub MoveOrderedSelectedListbox(lstSource as Object, lstTarget as Object, bMoveAll as Boolean) +Dim NullArray() +Dim MaxSelected as Integer +Dim MaxSourceIndex as Integer +Dim MaxOriginalIndex as Integer +Dim MaxNewIndex as Integer +Dim n as Integer +Dim m as Integer +Dim CurIndex as Integer +Dim SearchString as String +Dim SourceList() as String +Dim iOldTargetSelect as Integer +Dim iOldSourceSelect as Integer + If bMoveAll Then + lstSource.StringItemList() = OriginalList() + lstTarget.StringItemList() = NullArray() + Else + MaxOriginalIndex = Ubound(OriginalList()) + MaxSelected = Ubound(lstTarget.SelectedItems()) + iOldTargetSelect = lstTarget.SelectedItems(0) + If Ubound(lstSource.SelectedItems()) > -1 Then + iOldSourceSelect = lstSource.SelectedItems(0) + End If + Dim SelList(MaxSelected) + For n = 0 To MaxSelected + CurIndex = lstTarget.SelectedItems(n) + SelList(n) = lstTarget.StringItemList(CurIndex) + Next n + SourceList() = lstSource.StringItemList() + MaxSourceIndex = Ubound(lstSource.StringItemList()) + MaxNewIndex = MaxSelected + MaxSourceIndex + 1 + Dim NewSourceList(MaxNewIndex) + m = 0 + For n = 0 To MaxOriginalIndex + SearchString = OriginalList(n) + If IndexinArray(SearchString, SelList()) <> -1 Then + NewSourceList(m) = SearchString + m = m + 1 + ElseIf IndexinArray(SearchString, SourceList()) <> -1 Then + NewSourceList(m) = SearchString + m = m + 1 + End If + Next n + lstSource.StringItemList() = NewSourceList() + lstTarget.StringItemList() = RemoveSelected(lstTarget) + End If +' Todo: Hier weitermachen: + SetNewSelection(lstSource, iOldSourceSelect) + SetNewSelection(lstTarget, iOldTargetSelect) + +End Sub + + +Function RemoveSelected(oListbox as Object) +Dim MaxIndex as Integer +Dim MaxSelected as Integer +Dim n as Integer +Dim m as Integer +Dim CurIndex as Integer +Dim CurItem as String +Dim ResultArray() + MaxIndex = Ubound(oListbox.StringItemList()) + MaxSelected = Ubound(oListbox.SelectedItems()) + Dim LocItemList(MaxIndex) + LocItemList() = oListbox.StringItemList() + If MaxSelected > -1 Then + For n = 0 To MaxSelected + CurIndex = oListbox.SelectedItems(n) + LocItemList(CurIndex) = "" + Next n + If MaxIndex > 0 Then + ReDim ResultArray(MaxIndex - MaxSelected - 1) + m = 0 + For n = 0 To MaxIndex + CurItem = LocItemList(n) + If CurItem <> "" Then + ResultArray(m) = CurItem + m = m + 1 + End If + Next n + End If + RemoveSelected = ResultArray() + Else + RemoveSelected = oListbox.StringItemList() + End If +End Function + + +Sub SetNewSelection(oListBox as Object, iLastSelection as Integer) +Dim MaxIndex as Integer +Dim SelIndex as Integer +Dim SelList(0) as Integer + MaxIndex = Ubound(oListBox.StringItemList()) + If MaxIndex > -1 AND iLastSelection > -1 Then + If iLastSelection > MaxIndex Then + Selindex = MaxIndex + Else + SelIndex = iLastSelection + End If + Sellist(0) = SelIndex + oListBox.SelectedItems() = SelList() + End If +End Sub + + +Sub ToggleListboxControls(oDialogModel as Object, bDoEnable as Boolean) + oDialogModel.lblFields.Enabled = bDoEnable + oDialogModel.lblSelFields.Enabled = bDoEnable + oDialogModel.lstTables.Enabled = bDoEnable + oDialogModel.lstFields.Enabled = bDoEnable + oDialogModel.lstSelFields.Enabled = bDoEnable + oDialogModel.cmdRemoveAll.Enabled = bDoEnable + oDialogModel.cmdRemoveSelected.Enabled = bDoEnable + oDialogModel.cmdMoveAll.Enabled = bDoEnable + oDialogModel.cmdMoveSelected.Enabled = bDoEnable + If bDoEnable Then + FormSetMoveRights() + End If +End Sub + + +' Enable or disable the buttons used for moving the available +' fields between the two list boxes. +Sub FormSetMoveRights() +Dim bIsFieldSelected as Boolean +Dim bSelectSelected as Boolean +Dim FieldCount as Integer +Dim SelectCount as Integer + bIsFieldSelected = Ubound(oDialogModel.lstFields.SelectedItems()) <> -1 + FieldCount = Ubound(oDialogModel.lstFields.StringItemList()) + 1 + bSelectSelected = Ubound(oDialogModel.lstSelFields.SelectedItems()) > -1 + SelectCount = Ubound(oDialogModel.lstSelFields.StringItemList()) + 1 + oDialogModel.cmdRemoveAll.Enabled = SelectCount>=1 + oDialogModel.cmdRemoveSelected.Enabled = bSelectSelected + oDialogModel.cmdMoveAll.Enabled = FieldCount >=1 + oDialogModel.cmdMoveSelected.Enabled = bIsFieldSelected + oDialogModel.cmdGoOn.Enabled = SelectCount>=1 +End Sub + + +Function AddSingleItemToListbox(ByVal oListbox as Object, ListItem as String, Optional iSelIndex) as Object +Dim MaxIndex as Integer +Dim i as Integer + + MaxIndex = Ubound(oListbox.StringItemList()) +Dim LocList(MaxIndex + 1) +' Todo: This goes faster with the Redim LocList(MaxIndex + 1) Preserve function + For i = 0 To MaxIndex + LocList(i) = oListbox.StringItemList(i) + Next i + LocList(MaxIndex + 1) = ListItem + oListbox.StringItemList() = LocList() + If Not IsMissing(iSelIndex) Then + SelectListboxItem(oListbox, iSelIndex) + End If + AddSingleItemToListbox() = oListbox +End Function + + +Sub EmptyListbox(oListbox as Object) +Dim NullList() as String + oListbox.StringItemList() = NullList() +End Sub + + +Sub SelectListboxItem(oListbox as Object, iSelIndex as Integer) +Dim LocSelList(0) as Integer + LocSelList(0) = iSelIndex + oListbox.SelectedItems() = LocSelList() +End Sub + + +Function GetSelectedListboxItems(oListbox as Object) +Dim SelList() as String +Dim i as Integer +Dim CurIndex as Integer + For i = 0 To Ubound(oListbox.SelectedItems()) + CurIndex = oListbox.SelectedItems(i) + SelList(i) = oListbox.StringItemList(CurIndex) + Next i + GetSelectedListboxItems() = SelList() +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/tools/Misc.xba b/wizards/source/tools/Misc.xba new file mode 100644 index 000000000..037d45c5a --- /dev/null +++ b/wizards/source/tools/Misc.xba @@ -0,0 +1,799 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Misc" script:language="StarBasic">REM ***** BASIC ***** + +Const SBSHARE = 0 +Const SBUSER = 1 +Dim Taskindex as Integer +Dim oResSrv as Object + +' Connects to a registered Database +Function ConnecttoDatabase(DBName as String, UserID as String, Password as String ) +Dim oDBContext as Object +Dim oDBSource as Object + oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") + If oDBContext.HasbyName(DBName) Then + oDBSource = oDBContext.GetByName(DBName) + ConnectToDatabase = oDBSource.GetConnection(UserID, Password) + Else + Msgbox("DataSource " & DBName & " is not registered" , 16, GetProductname) + ConnectToDatabase() = NULL + End If +End Function + + +Function GetStarOfficeLocale() as New com.sun.star.lang.Locale +Dim aLocLocale As New com.sun.star.lang.Locale +Dim sLocale as String +Dim sLocaleList() +Dim oMasterKey + oMasterKey = GetRegistryKeyContent("org.openoffice.UserProfile/International/") + sLocale = oMasterKey.getByName("Locale") + sLocaleList() = ArrayoutofString(sLocale, "-") + aLocLocale.Language = sLocaleList(0) + aLocLocale.Country = sLocaleList(1) + GetStarOfficeLocale() = aLocLocale +End Function + + +Function GetRegistryKeyContent(sKeyName as string) +Dim oConfigProvider as Object +Dim aNodePath(0) as new com.sun.star.beans.PropertyValue + oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") + aNodePath(0).Name = "nodepath" + aNodePath(0).Value = sKeyName + GetRegistryKeyContent = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) +End Function + + +Function GetProductname() as String +Dim oProdNameAccess as Object +Dim sVersion as String +Dim sProdName as String + oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") + sProdName = oProdNameAccess.getByName("Name") + sVersion = oProdNameAccess.getByName("Version") + GetProductName = sProdName & "." & sVersion +End Function + + +' Opens a Document, checks beforehand, wether it has to be loaded +' or wether it is already on the desktop +Function OpenDocument(DocPath as String, Args()) +Dim oComponents as Object +Dim oComponent as Object + ' Search if one of the active Components ist the one that you search for + oComponents = StarDesktop.Components.CreateEnumeration + While oComponents.HasmoreElements + oComponent = oComponents.NextElement + If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then + If UCase(oComponent.URL) = UCase(DocPath) then + OpenDocument() = oComponent + Exit Function + End If + End If + Wend + OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0,Args()) +End Function + + +Function TaskonDesktop(DocPath as String) as Boolean +Dim oComponents as Object +Dim oComponent as Object + ' Search if one of the active Components ist the one that you search for + oComponents = StarDesktop.Components.CreateEnumeration + While oComponents.HasmoreElements + oComponent = oComponents.NextElement + If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then + If UCase(oComponent.URL) = UCase(DocPath) then + TaskonDesktop = True + Exit Function + End If + End If + Wend + TaskonDesktop = False +End Function + + +' Retrieves a FileName out of a StarOffice-Document +Function RetrieveFileName(LocDoc as Object) +Dim LocURL as String +Dim LocURLArray() as String +Dim MaxArrIndex as integer + + LocURL = LocDoc.Url + LocURLArray() = ArrayoutofString(LocURL,"/",MaxArrIndex) + RetrieveFileName = LocURLArray(MaxArrIndex) +End Function + + +' clears up a Listbox and refills it with the delivered Array 'ValList()' +Sub FillUpCombo(LocListbox as Object, ValList() as String) +Dim i as integer +Dim a as Integer + LocListbox.Clear + ' Trage die ??bersetzungsrelevanten Verzeichnisnamen in die Listbox ein + a = 0 + For i = 0 to Ubound(ValList()) + If ValList(i) <> "" Then + LocListbox.List(a) = ValList(i) + a = a + 1 + End If + Next +End Sub + + +Sub WritedbgInfo(LocObject as Object) +Dim locUrl as String +Dim oLocDocument as Object +Dim oLocText as Object +Dim oLocCursor as Object +Dim NoArgs() +Dim sObjectStrings(2) as String +Dim sProperties() as String +Dim n as Integer +Dim m as Integer + sObjectStrings(0) = LocObject.dbg_Properties + sObjectStrings(1) = LocObject.dbg_Methods + sObjectStrings(2) = LocObject.dbg_SupportedInterfaces + LocUrl = "private:factory/swriter" + oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) + oLocText = oLocDocument.text + oLocCursor = oLocText.createTextCursor() + oLocCursor.gotoStart(False) + If Vartype(LocObject) = 9 then ' an Object Variable + For n = 0 To 2 + sProperties() = ArrayoutofString(sObjectStrings(n),";", MaxIndex) + For m = 0 To MaxIndex + oLocText.insertString(oLocCursor,sProperties(m),False) + oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) + Next m + Next n + Elseif Vartype(LocObject) = 8 Then ' a String Variable + oLocText.insertString(oLocCursor,LocObject,False) + ElseIf Vartype(LocObject) = 1 Then + Msgbox("Variable is Null!", 16, GetProductName()) + End If +End Sub + + +Sub WriteDbgString(LocString as string) +Dim oLocDesktop as object +Dim LocUrl as String +Dim oLocDocument as Object +Dim oLocCursor as Object +Dim oLocText as Object + + LocUrl = "private:factory/swriter" + oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_blank",0,NoArgs) + oLocText = oLocDocument.text + oLocCursor = oLocText.createTextCursor() + oLocCursor.gotoStart(False) + oLocText.insertString(oLocCursor,LocString,False) +End Sub + + +Sub printdbgInfo(LocObject) + If Vartype(LocObject) = 9 then + Msgbox LocObject.dbg_properties + Msgbox LocObject.dbg_methods + Msgbox LocObject.dbg_supportedinterfaces + Elseif Vartype(LocObject) = 8 Then ' a String Variable + Msgbox LocObject + ElseIf Vartype(LocObject) = 0 Then + Msgbox("Variable is Null!", 16, GetProductName()) + Else + Msgbox("Type of Variable: " & Typename(LocObject), 48, GetProductName()) + End If +End Sub + + +Sub ShowArray(LocArray()) +Dim i as integer +Dim msgstring + msgstring = "" + For i = Lbound(LocArray()) to Ubound(LocArray()) + msgstring = msgstring + LocArray(i) + chr(13) + Next + Msgbox msgstring +End Sub + + +' Gets a special configured PathSetting +Function GetPathSettings(sPathType as String, Optional bshowall as Boolean, Optional ListIndex as integer) as String +Dim oSettings, oPathSettings as Object +Dim sPath as String +Dim PathList() as String +Dim MaxIndex as Integer + + oSettings = createUnoService("com.sun.star.frame.Settings") + oPathSettings = oSettings.getByName("PathSettings") + If Not IsMissing(bShowall) Then + If bShowAll Then + ShowPropertyValues(oPathSettings) + Exit Function + End If + End If + sPath = oPathSettings.GetPropertyValue(sPathType) + If Not IsMissing(ListIndex) Then + ' Share and User-Directory + If Instr(1,sPath,";") <> 0 Then + PathList = ArrayoutofString(sPath,";", MaxIndex) + If ListIndex <= MaxIndex Then + sPath = PathList(ListIndex) + Else + Msgbox("Cannot analyze the String " & sPath , 16, GetProductName()) + End If + End If + End If + If Instr(1, sPath, ";") = 0 Then + GetPathSettings = ConvertToUrl(sPath) + Else + GetPathSettings = sPath + End If +End Function + + + +' Gets the fully qualified path to a subdirectory of the +' Template Directory, e. g. with the parameter "wizard/bitmap" +' The parameter must be passed over in Url-scription +' The return-Value is in Urlscription +Function GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String) +Dim oUcb as Object +Dim sOfficeString as String +Dim sOfficeList() as String +Dim sOfficeDir as String +Dim sBigDir as String +Dim i as Integer +Dim MaxIndex as Integer + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + sOfficeString = GetPathSettings(sOfficePath) + If Right(sSubDir,1) <> "/" Then + sSubDir = sSubDir & "/" + End If + sOfficeList() = ArrayoutofString(sOfficeString,";", MaxIndex) + For i = 0 To MaxIndex + sOfficeDir = ConvertToUrl(sOfficeList(i)) + If Right(sOfficeDir,1) <> "/" Then + sOfficeDir = sOfficeDir & "/" + End If + sBigDir = sOfficeDir & sSubDir + If oUcb.Exists(sBigDir) Then + GetOfficeSubPath() = sBigDir + Exit Function + End If + Next i + GetOfficeSubPath = "" +End Function + + +Sub ShowPropertyValues(oLocObject as Object) +Dim PropName as String +Dim sValues as String + On Local Error Goto NOPROPERTYSETINFO: + sValues = "" + For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties) + Propname = oLocObject.PropertySetInfo.Properties(i).Name + sValues = sValues & PropName & " = " & oLocObject.GetPropertyValue(PropName) & chr(13) + Next i + Msgbox(sValues , 64, GetProductName()) + Exit Sub + +NOPROPERTYSETINFO: + Msgbox("Sorry, No PropertySetInfo attached to the object", 16, GetProductName()) + Resume LEAVEPROC + LEAVEPROC: +End Sub + + +Sub ShowNameValuePair(Pair()) +Dim i as Integer +Dim ShowString as String + ShowString = "" + On Local Error Resume Next + For i = 0 To Ubound(Pair()) + ShowString = ShowString & Pair(i).Name & " = " + ShowString = ShowString & Pair(i).Value & chr(13) + Next i + Msgbox ShowString +End Sub + + +' Retrieves all the Elements of aSequence of an object, with the +' possibility to define a filter(sfilter <> "") +Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String) +Dim i as Integer +Dim NameString as String + NameString = "" + For i = 0 To Ubound(oLocElements()) + If Not IsMissIng(sFilterName) Then + If Instr(1, oLocElements(i), sFilterName) Then + NameString = NameString & oLocElements(i) & chr(13) + End If + Else + NameString = NameString & oLocElements(i) & chr(13) + End If + Next i + Msgbox(NameString, 64, GetProductName()) +End Sub + + +' Retrieves all the supported servicenames of an object, with the +' possibility to define a filter(sfilter <> "") +Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String) + On Local Error Goto NOSERVICENAMES + If IsMissing(sFilterName) Then + ShowElementNames(oLocobject.SupportedServiceNames()) + Else + ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName) + End If + Exit Sub + + NOSERVICENAMES: + Msgbox("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName()) + Resume LEAVEPROC + LEAVEPROC: +End Sub + + +' Retrieves all the available Servicenames of an object, with the +' possibility to define a filter(sfilter <> "") +Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String) + On Local Error Goto NOSERVICENAMES + If IsMissing(sFilterName) Then + ShowElementNames(oLocobject.AvailableServiceNames) + Else + ShowElementNames(oLocobject.AvailableServiceNames, sFilterName) + End If + Exit Sub + + NOSERVICENAMES: + Msgbox("Sorry, No 'AvailableServiceNames' - Property attached to the object", 16, GetProductName()) + Resume LEAVEPROC + LEAVEPROC: +End Sub + + +Sub ShowCommands(oLocObject as Object) + On Local Error Goto NOCOMMANDS + ShowElementNames(oLocObject.QueryCommands) + Exit Sub + NOCOMMANDS: + Msgbox("Sorry, No 'QueryCommands' - Property attached to the object", 16, GetProductName()) + Resume LEAVEPROC + LEAVEPROC: +End Sub + + +Function InitResources(Description, ShortDescription as String) as boolean + On Error Goto ErrorOcurred + oResSrv = createUnoService( "com.sun.star.resource.VclStringResourceLoader" ) + If (IsNull(oResSrv)) then + InitResources = FALSE + MsgBox( Description & ": No resource loader found", 16, GetProductName()) + Else + InitResources = TRUE + oResSrv.FileName = ShortDescription + End If + Exit Function +ErrorOcurred: + Dim nSolarVer + InitResources = FALSE + nSolarVer = GetSolarVersion() + MsgBox("Resource file missing (" & ShortDescription & trim(str(nSolarVer)) + "*.res)", 16, GetProductName()) + Resume CLERROR + CLERROR: +End Function + + +Function GetResText( nID as integer ) As string + On Error Goto ErrorOcurred + If Not IsNull(oResSrv) Then + ' eigentlich sollte hier stehen + GetResText = oResSrv.getString( nID ) + Else + GetResText = "" + End If + Exit Function +ErrorOcurred: + GetResText = "" + MsgBox("Resource with ID =" + str( nID ) + " not found!", 16, GetProductName()) + Resume CLERROR + CLERROR: +End Function + + +Function CutPathView(sDocUrl as String, PathLen as Integer) +Dim sViewPath as String + sViewPath = ConvertfromURL(sDocURL) + iViewPathLen = Len(sViewPath) + If iViewPathLen > 60 Then + sViewPath = "..." & Right(sViewPath,58) + End If + CutPathView = sViewPath +End Function + + +' Deletes the content of all cells that are softformatted according +' to the 'InputStyleName' +Sub DeleteInputCells(oSheet as Object, InputStyleName as String) +Dim oRanges as Object +Dim oRange as Object + oRanges = oSheet.CellFormatRanges.createEnumeration + While oRanges.hasMoreElements + oRange = oRanges.NextElement + If Instr(1,oRange.CellStyle, InputStyleName) <> 0 Then + Call ReplaceRangeValues(oRange, "") + End If + Wend +End Sub + + +' Inserts a certain String to all cells of a Range that ist passed over +' either as an object or as the RangeName +Sub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String) +Dim oCellRange as Object + If Vartype(Range) = 8 Then + ' Get the Range out of the Rangename + oCellRange = oSheet.GetCellRangeByName(Range) + Else + ' The range is passed over as an object + Set oCellRange = Range + End If + If IsMissing(StyleName) Then + ReplaceRangeValues(oCellRange, ReplaceValue) + Else + If Instr(1,oCellRange.CellStyle,StyleName) Then + ReplaceRangeValues(oCellRange, ReplaceValue) + End If + End If +End Sub + + +Sub ReplaceRangeValues(oRange as Object, ReplaceValue) +Dim oRangeAddress as Object +Dim ColCount as Integer +Dim RowCount as Integer +Dim i as Integer + oRangeAddress = oRange.RangeAddress + ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn + RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow + Dim FillArray(RowCount) as Variant + Dim sLine(ColCount) as Variant + For i = 0 To ColCount + sLine(i) = ReplaceValue + Next i + For i = 0 To RowCount + FillArray(i) = sLine() + Next i + oRange.DataArray = FillArray() +End Sub + + +' Returns the Value of the first cell of a Range +Function GetValueofCellbyName(oSheet as Object, sCellName as String) +Dim oCell as Object + oCell = GetCellByName(oSheet, sCellName) + GetValueofCellbyName = oCell.Value +End Function + + +Function DuplicateRow(oSheet as Object, RangeName as String) +Dim oRange as Object +Dim oCell as Object +Dim oCellAddress as New com.sun.star.table.CellAddress +Dim oRangeAddress as New com.sun.star.table.CellRangeAddress + oRange = oSheet.GetCellRangeByName(RangeName) + oRangeAddress = oRange.RangeAddress + oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow) + oCellAddress = oCell.CellAddress + oSheet.Rows.InsertByIndex(oCellAddress.Row,1) + oRangeAddress = oRange.RangeAddress + oSheet.CopyRange(oCellAddress, oRangeAddress) + DuplicateRow = oRangeAddress.StartRow-1 +End Function + + +' Returns the String of the first cell of a Range +Function GetStringofCellbyName(oSheet as Object, sCellName as String) +Dim oCell as Object + oCell = GetCellByName(oSheet, sCellName) + GetStringofCellbyName = oCell.String +End Function + + +' Returns a named Cell +Function GetCellByName(oSheet as Object, sCellName as String) as Object +Dim oCellRange as Object +Dim oCellAddress as Object + oCellRange = oSheet.GetCellRangeByName(sCellName) + oCellAddress = oCellRange.RangeAddress + GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) +End Function + + +' Changes the numeric Value of a cell by transmitting the String of the numeric Value +Sub ChangeCellValue(oCell as Object, ValueString as String) +Dim CellValue + oCell.Formula = "=Value(" & """" & ValueString & """" & ")" + CellValue = oCell.Value + oCell.Formula = "" + oCell.Value = CellValue +End Sub + + +Function GetDocumentType(oDocument) + If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then + GetDocumentType() = "scalc" + ElseIf oDocument.SupportsService("com.sun.star.text.TextDocument") Then + GetDocumentType() = "swriter" + ElseIf oDocument.SupportsService("com.sun.star.drawing.DrawingDocument") Then + GetDocumentType() = "sdraw" + End If +End Function + + + +Function GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer +Dim ThisFormatKey as Long +Dim oObjectFormat as Object + On Local Error Goto NOFORMAT + ThisFormatKey = oFormatObject.NumberFormat + oObjectFormat = oDocFormats.GetByKey(ThisFormatKey) + GetNumberFormatType = oObjectFormat.Type + NOFORMAT: + If Err <> 0 Then + Msgbox("Numberformat of Object is not available!", 16, GetProductName()) + GetNumberFormatType = 0 + GOTO NOERROR + End If + NOERROR: + On Local Error Goto 0 +End Function + + +Sub ProtectSheets(Optional oSheets as Object) +Dim i as Integer +Dim oDocSheets as Object + If IsMissing(oSheets) Then + oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets + Else + Set oDocSheets = oSheets + End If + + For i = 0 To oDocSheets.Count-1 + oDocSheets(i).Protect("") + Next i +End Sub + + +Sub UnprotectSheets(Optional oSheets as Object) +Dim i as Integer +Dim oDocSheets as Object + If IsMissing(oSheets) Then + oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets + Else + Set oDocSheets = oSheets + End If + + For i = 0 To oDocSheets.Count-1 + oDocSheets(i).Unprotect("") + Next i +End Sub + + +Function GetRowIndex(oSheet as Object, RowName as String) +Dim oRange as Object + oRange = oSheet.GetCellRangeByName(RowName) + GetRowIndex = oRange.RangeAddress.StartRow +End Function + + +Function GetColumnIndex(oSheet as Object, ColName as String) +Dim oRange as Object + oRange = oSheet.GetCellRangeByName(ColName) + GetColumnIndex = oRange.RangeAddress.StartColumn +End Function + + +Function CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object +Dim oSheet as Object +Dim Count as Integer +Dim BasicSheetName as String + + BasicSheetName = NewName + ' Copy the last table. Assumption: The last table is the template + On Local Error Goto RENAMESHEET + oSheets.CopybyName(OldName, NewName, DestPos) + +RENAMESHEET: + oSheet = oSheets(DestPos) + If Err <> 0 Then + ' Test if renaming failed + Count = 2 + Do While oSheet.Name <> NewName + NewName = BasicSheetName & "_" & Count + oSheet.Name = NewName + Count = Count + 1 + Loop + Resume CL_ERROR +CL_ERROR: + End If + CopySheetbyName = oSheet +End Function + + +' Dis-or enables a Window and adjusts the mousepointer accordingly +Sub ToggleWindow(bDoEnable as Boolean) +Dim oWindow as Object +Dim oWindowPointer as Object + oWindow = StarDesktop.CurrentFrame.ComponentWindow + oWindow.Enable = bDoEnable + oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer") + If bDoEnable Then + oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW) + Else + oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT) + End If + oWindow.SetPointer(oWindowPointer) +End Sub + + + +Function CheckNewSheetname(oSheets as Object, Sheetname as String) +Dim SpecialSignsList(32) as String +Dim i as Integer + SpecialSignsList(0) = "-" + SpecialSignsList(1) = "." + SpecialSignsList(2) = "!" + SpecialSignsList(3) = "?" + SpecialSignsList(4) = "/" + SpecialSignsList(5) = "\" + SpecialSignsList(6) = "," + SpecialSignsList(7) = ";" + SpecialSignsList(8) = "'" + SpecialSignsList(9) = "(" + SpecialSignsList(10) = ")" + SpecialSignsList(11) = "{" + SpecialSignsList(12) = "}" + SpecialSignsList(13) = "[" + SpecialSignsList(14) = "]" + SpecialSignsList(15) = ":" + SpecialSignsList(16) = """" + SpecialSignsList(17) = "$" + SpecialSignsList(18) = "&" + SpecialSignsList(19) = "%" + SpecialSignsList(20) = "=" + SpecialSignsList(21) = "*" + SpecialSignsList(22) = "?§" + SpecialSignsList(23) = "@" + SpecialSignsList(24) = "<" + SpecialSignsList(25) = ">" + SpecialSignsList(26) = "#" + SpecialSignsList(27) = "+" + SpecialSignsList(28) = "~" + SpecialSignsList(29) = "|" + SpecialSignsList(30) = "??" + SpecialSignsList(31) = "^" + SpecialSignsList(32) = "?°" + For i = 0 To Ubound(SpecialSignsList()) + SheetName = ReplaceString(Sheetname, "_", SpecialSignsList(i) + Next i + CheckNewSheetname = SheetName +End Function + + +Function GetSheetIndex(oSheets, sName) as Integer +Dim i as Integer + For i = 0 To oSheets.Count-1 + If oSheets(i).Name = sName Then + GetSheetIndex = i + exit Function + End If + Next i + GetSheetIndex = -1 +End Function + + +Function GetLastUsedRow(oSheet as Object) as Integer +Dim oCell As Object +Dim oCursor As Object +Dim aAddress As Variant + oCell = oSheet.GetCellbyPosition(0, 0) + oCursor = oSheet.createCursorByRange(oCell) + oCursor.GotoEndOfUsedArea(True) + aAddress = oCursor.RangeAddress + GetLastUsedRow = aAddress.EndRow +End Function + + +' Note To set a one lined frame you have to set the inner width to 0 +' In the API all Units that refer to pt-Heights are "1/100mm" +' The convert factor from 1pt to 1/100 mm is approximately 35 +Function ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer) +Dim aBorder as New com.sun.star.table.BorderLine + aBorder = oStyleBorder + aBorder.InnerLineWidth = iInnerLineWidth + aBorder.OuterLineWidth = iOuterLineWidth + ModifyBorderLineWidth = aBorder +End Function + + +Sub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String) +Dim PropValue(1) as new com.sun.star.beans.PropertyValue + PropValue(0).Name = "EventType" + PropValue(0).Value = "StarBasic" + PropValue(1).Name = "Script" + PropValue(1).Value = "macro:///" & SubPath + oDocument.Events.ReplaceByName(EventName, PropValue()) +End Sub + + + +Function ModifyPropertyValue(oContent() as Object, TargetProperties() as New com.sun.star.beans.PropertyValue ) +Dim MaxIndex as Integer +Dim i as Integer +Dim a as Integer +Dim bDoReplace as Boolean + MaxIndex = Ubound(oContent()) + bDoReplace = False + Dim oNewBuffer(MaxIndex) as New com.sun.star.beans.PropertyValue + For i = 0 To MaxIndex + oNewBuffer(i).Name = oContent(i).Name + a = GetPropertyValueIndex(oContent(i).Name, TargetProperties()) + If a <> -1 Then + If Vartype(TargetProperties(a).Value) <> 9 Then + If TargetProperties(a).Value <> oContent(i).Value Then + oNewBuffer(i).Value = TargetProperties(a).Value + bDoReplace = True + Else + oNewBuffer(i).Value = oContent(i).Value + End If + Else + If Not equalUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then + oNewBuffer(i).Value = TargetProperties(a).Value + bDoReplace = True + Else + oNewBuffer(i).Value = oContent(i).Value + End If + End If + Else + oNewBuffer(i).Value = oContent(i).Value + End If + Next i + If bDoReplace Then + oContent() = oNewBuffer() + End If + ModifyPropertyValue() = bDoReplace +End Function + + +Function GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue ) +Dim i as Integer + For i = 0 To Ubound(TargetProperties()) + If Searchname = TargetProperties(i).Name Then + GetPropertyValueIndex = i + Exit Function + End If + Next i + GetPropertyValueIndex() = -1 +End Function + + +Sub DispatchSlot(SlotID as Integer) +Dim oArg() as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object +' oArg(0).Name = "LibraryName" +' oArg(0).Value = sLibname + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:" & CStr(SlotID) + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/tools/ModuleControls.xba b/wizards/source/tools/ModuleControls.xba new file mode 100644 index 000000000..ad0ad04df --- /dev/null +++ b/wizards/source/tools/ModuleControls.xba @@ -0,0 +1,153 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ModuleControls" script:language="StarBasic">Option Explicit + + +' Accepts the name of a control and returns the respective control model as object +' The Container can either be a whole document or a specific sheet of a Calc-Document +' 'CName' is the name of the Control +Function getControlModel(oContainer as Object, CName as String) +Dim aForm, oForms as Object +Dim i as Integer + oForms = oContainer.Drawpage.GetForms + For i = 0 To oForms.Count-1 + aForm = oForms.GetbyIndex(i) + If aForm.HasByName(CName) Then + GetControlModel = aForm.GetbyName(CName) + Exit Function + End If + Next i + Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName()) +End Function + + + +' Gets the Shape of a Control( e. g. to reset the size or Position of the control +' Parameters: +' The 'oContainer' is the Document or a specific sheet of a Calc - Document +' 'CName' is the Name of the Control +Function GetControlShape(oContainer as Object,CName as String) +Dim i as integer +Dim aShape as Object + For i = 0 to oContainer.DrawPage.Count-1 + aShape = oContainer.DrawPage(i) + If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then + If ashape.Control.Name = CName then + GetControlShape = aShape + exit Function + End If + End If + Next +End Function + + +' Returns the View of a Control +' Parameters: +' The 'oContainer' is the Document or a specific sheet of a Calc - Document +' The 'oController' is always directly attached to the Document +' 'CName' is the Name of the Control +Function getControlView(oContainer , oController as Object, CName as String) as Object +Dim aForm, oForms, oControlModel as Object +Dim i as Integer + oForms = oContainer.DrawPage.Forms + For i = 0 To oForms.Count-1 + aForm = oforms.GetbyIndex(i) + If aForm.HasByName(CName) Then + oControlModel = aForm.GetbyName(CName) + GetControlView = oController.GetControl(oControlModel) + Exit Function + End If + Next i + Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName()) +End Function + + + +' Parameters: +' The 'oContainer' is the Document or a specific sheet of a Calc - Document +' 'CName' is the Name of the Control +Function DisposeControl(oContainer as Object, CName as String) as Boolean +Dim aControl as Object + + aControl = GetControlModel(oContainer,CName) + If not IsNull(aControl) Then + aControl.Dispose() + DisposeControl = True + Else + DisposeControl = False + End If +End Function + + +' Returns a sequence of a group of controls like option buttons or checkboxes +' The 'oContainer' is the Document or a specific sheet of a Calc - Document +' 'sGroupName' is the Name of the Controlgroup +Function GetControlGroupModel(oContainer as Object, sGroupName as String ) +Dim aForm, oForms As Object +Dim aControlModel() As Object +Dim i as integer + + oForms = oContainer.DrawPage.Forms + For i = 0 To oForms.Count-1 + aForm = oForms(i) + If aForm.HasbyName(sGroupName) Then + aForm.GetGroupbyName(sGroupName,aControlModel) + GetControlGroupModel = aControlModel + Exit Function + End If + Next i + Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName()) +End Function + + +' Returns the Referencevalue of a group of e.g. option buttons or check boxes +' 'oControlGroup' is a sequence of the Control objects +Function GetRefValue(oControlGroup() as Object) +Dim i as Integer + For i = 0 To Ubound(oControlGroup()) +' oControlGroup(i).DefaultState = oControlGroup(i).State + If oControlGroup(i).State Then + GetRefValue = oControlGroup(i).RefValue + exit Function + End If + Next + Msgbox("No Control selected!",16, GetProductName()) +End Function + + +Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String) +Dim oOptGroup() as Object +Dim iRef as Integer + oOptGroup() = GetControlGroupModel(oContainer, GroupName) + iRef = GetRefValue(oOptGroup()) + GetRefValueofControlGroup = iRef +End Function + + +Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean +Dim oRulesOptions() as Object + oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName) + GetOptionGroupValue = oRulesOptions(0).State +End Function + + + +Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean +Dim bOptValue as Boolean +Dim oCell as Object + bOptValue = GetOptionGroupValue(oSheet, OptGroupName) + oCell = oSheet.GetCellByPosition(iCol, iRow) + oCell.SetValue(ABS(CInt(bOptValue))) + WriteOptValueToCell() = bOptValue +End Function + + +Function LoadDialog(Libname as String, DialogName as String) +Dim oLib as Object +Dim oDialog as Object + dialogs.loadLibrary(Libname) + oLib = dialogs.GetByName(Libname) + oDialog = CreateUnoDialog(oLib, DialogName) + LoadDialog() = oDialog +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/tools/Strings.xba b/wizards/source/tools/Strings.xba new file mode 100644 index 000000000..dc4695778 --- /dev/null +++ b/wizards/source/tools/Strings.xba @@ -0,0 +1,362 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Strings" script:language="StarBasic">Option Explicit +Public sProductname as String + +' Deletes out of a String 'BigString' all possible PartStrings, that are summed up +' in the Array 'ElimArray' +Function ElimChar(ByVal BigString as String, ElimArray() as String) +Dim i% ,n% + For i = 0 to Ubound(ElimArray) + BigString = DeleteStr(BigString,ElimArray(i) + Next + ElimChar = BigString +End Function + + + +' Deletes out of a String 'BigString' a possible Partstring 'CompString' +Function DeleteStr(ByVal BigString,CompString as String) as String +Dim i%, CompLen%, BigLen% + CompLen = Len(CompString) + i = 1 + While i <> 0 + i = Instr(i, BigString,CompString) + If i <> 0 then + BigLen = Len(BigString) + BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen) + End If + Wend + DeleteStr = BigString +End Function + + + +' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString' +Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String +Dim StartPos%, EndPos% +Dim BigLen%,PreLen%,PostLen% + + StartPos = Instr(SearchPos,BigString,PreString) + If StartPos <> 0 Then + PreLen = Len(PreString) + EndPos = Instr(StartPos + PreLen,BigString,PostString) + If EndPos <> 0 Then + BigLen = Len(BigString) + PostLen = Len(PostString) + FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen)) + ' Da diese Funktion daf?r programmiert wurde, in einer Schleife abgearbeitet zu werden + ' muss die initiale Suchposition hinter die Position des gefundenen Teilstrings gesetzt werden. + SearchPos = EndPos + PostLen + Else + Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName()) + FindPartString = "" + End If + Else + FindPartString = "" + End If +End Function + + + +' Deletes the String 'SmallString' out of the String 'BigString' +' in case SmallString's Position in BigString is right at the end +Function RTrimStr(ByVal BigString, SmallString as String) as String +Dim SmallLen% +Dim BigLen% + + SmallLen = Len(SmallString) + BigLen = Len(BigString) + If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then + RTrimStr = Mid(BigString,1,BigLen - SmallLen) + Else + RTrimStr = BigString + End If +End Function + + + +' Deletes the Char 'CompChar' out of the String 'BigString' +' in case CompChar's Position in BigString is right at the beginning +Function LTRimChar(ByVal BigString as String,CompChar as String) as String +Dim BigLen as integer + BigLen = Len(BigString) + If BigLen > 1 Then + If Left(BigString,1) = CompChar then + BigString = Mid(BigString,2,BigLen-1) + End If + ElseIf BigLen = 1 Then + BigString = "" + End If + LTrimChar = BigString +End Function + + + +' Retrieves an Array out of a String. +' The fields of the Array are separated by the parameter 'Separator', that is contained +' in the Array +' The Array MaxLocindex delivers the highest Index of this Array +Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as integer) +Dim i%, OldPos%, Pos%, SepLen%, BigLen% +Dim LocList(200) as string + + OldPos = 1 + i = -1 + SepLen = Len(Separator) + BigLen = Len(BigString) + Do + Pos = Instr(OldPos,BigString,Separator) + i = i + 1 + If Pos = 0 Then + LocList(i) = Mid(BigString,OldPos,BigLen - OldPos + 1 ) + Else + LocList(i) = Mid(BigString,OldPos,Pos-OldPos ) + OldPos = Pos + SepLen + End If + Loop until Pos = 0 + If Vartype(Maxindex) <> 0 Then + MaxIndex = i + End If + ArrayoutofString = LocList() +End Function + + + +' Deletes all fieldvalues in one-dimensional Array +Sub ClearArray(BigArray) +Dim i as integer + For i = Lbound(BigArray()) to Ubound(BigArray()) + BigArray(i) = "" + Next +End Sub + + +' Deletes all fieldvalues in a multidimensional Array +Sub ClearMultiDimArray(BigArray,DimCount as integer) +Dim n%, m% + For n = Lbound(BigArray(),1) to Ubound(BigArray(),1) + For m = 0 to Dimcount - 1 + BigArray(n,m) = "" + Next m + Next n +End Sub + + +' Checks if a Field (LocField) is already defined in an Array +' Returns 'True' or 'False' +Function FieldinArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean +Dim i as integer + For i = Lbound(LocArray()) to MaxIndex + If Ucase(LocArray(i)) = Ucase(LocField) Then + FieldInArray = True + Exit Function + End if + Next + FieldInArray = False +End Function + + + +' Checks if a Field (LocField) is already defined in an Array +' Returns 'True' or 'False' +Function FieldinList(LocField, BigList()) As Boolean +Dim i as integer + For i = Lbound(BigList()) to Ubound(BigList()) + If LocField = BigList(i) Then + FieldInList = True + Exit Function + End if + Next + FieldInList = False +End Function + + +' Retrieves the Index of the delivered String 'SearchString' in +' the Array LocList()' +Function IndexinArray(SearchString as String, LocList()) as Integer +Dim i as integer + For i = Lbound(LocList(),1) to Ubound(LocList(),1) + If Ucase(LocList(i,0)) = Ucase(SearchString) Then + IndexinArray = i + Exit Function + End if + Next + IndexinArray = -1 +End Function + + +Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer) +Dim oListbox as Object +Dim i as integer +Dim a as Integer + a = 0 + oListbox = oDialog.GetControl(ListboxName) + oListbox.RemoveItems(0, oListbox.GetItemCount) + For i = 0 to Ubound(ValList(), 1) + If ValList(i) <> "" Then + oListbox.AddItem(ValList(i, iDim-1), a) + a = a + 1 + End If + Next +End Sub + + +' Replaces the string "OldReplace" through the String "NewReplace" in the String +' 'BigString' +Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String +Dim i%, OldReplLen%, BigLen% + + If NewReplace <> OldReplace Then + OldReplLen = Len(OldReplace) + i = 1 + Do + Biglen = Len(BigString) + i = Instr(i,BigString,OldReplace) + If i <> 0 then + BigString = Mid(BigString,1,i-1) & NewReplace & Mid(BigString,i + OldReplLen,BigLen - i + 1 - OldReplLen + i = i + Len(NewReplace) + End If + Loop until i = 0 + End If + ReplaceString = BigString +End Function + + +' Converts an "ordinary" path to a "URL-Path" +Function ConverttoURL(ByVal BigString as String) as String +Dim Separator as String + If sProductname = "" Then + sProductname = GetProductname() + End If + If BigString <> "" Then + If Instr(1,sProductname,"Sun Webtop") = 0 Then + Separator = GetPathSeparator() + ' Is the delivered Path already a URL + If Instr(1,UCase(BigString),"FILE:///") = 0 Then + BigString = ReplaceString(BigString,"/",Separator) + BigString = ReplaceString(BigString,"|",":") + BigString = "file:///" & BigString + End If + End If + ConvertToURL = BigString + Else + ConvertToUrl = "" + End If +End Function + + +' Converts an "URL-Path" to an ordinary "Path" +Function ConvertfromURL(ByVal BigString as String) as String +Dim Separator as String + Separator = GetPathSeparator() + If Left(Ucase(BigString),8)= "FILE:///" Then + BigString = Mid(BigString, 9, Len(BigString)-8) + BigString = ReplaceString(BigString,Separator,"/") + BigString = ReplaceString(BigString,":","|") + ConvertFromUrl = BigString + End If +End Function + + + +' Retrieves the second value for a next to 'SearchString' in +' a two-dimensional string-Array +Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String +Dim i as Integer + For i = 0 To Ubound(TwoDimList,1) + If Ucase(SearchString) = Ucase(TwoDimList(i,0)) Then + FindSecondValue = TwoDimList(i,1) + Exit For + End If + Next +End Function + + +' raises a base to a certain power +Function Power(Basis as Double, Exponent as Double) as Double + Power = Exp(Exponent*Log(Basis)) +End Function + + +' rounds a Real to a given Number of Decimals +Function Round(BaseValue as Double, Decimals as Integer) as Double +Dim Multiplicator as Long +Dim DblValue#, RoundValue# + Multiplicator = Power(10,Decimals) + RoundValue = Int(BaseValue * Multiplicator) + Round = RoundValue/Multiplicator +End Function + + +'Retrieves the mere filename out of a whole path +Function FileNameoutofPath(ByVal Path as String, Separator as String) as String +Dim i as Integer +Dim SepList() as String + SepList() = ArrayoutofString(Path,"/",i) + FileNameoutofPath = SepList(i) +End Function + + +Function GetFileNameExtension(ByVal FileName as String) +Dim MaxIndex as Integer +Dim SepList() as String + SepList() = ArrayoutofString(FileName,".", MaxIndex) + GetFileNameExtension = SepList(MaxIndex) +End Function + + +Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String) +Dim MaxIndex as Integer +Dim SepList() as String + If not IsMissing(Separator) Then + FileName = FileNameoutofPath(FileName, Separator) + End If + SepList() = ArrayoutofString(FileName,".", MaxIndex) + GetFileNameWithoutExtension = RTrimStr(FileName, "." & SepList(MaxIndex) +End Function + + +Function DirectorynameoutofPath(sPath as String, Separator as String) as String +Dim LocFileName as String + LocFileName = FileNameoutofPath(sPath, Separator) + DirectoryNameoutofPath = DeleteStr(sPath, Separator & LocFileName) +End Function + + +Function CountCharsinString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer +Dim LocCount%, LocPos% + LocCount = 0 + Do + LocPos = Instr(StartPos,BigString,LocChar) + If LocPos <> 0 Then + LocCount = LocCount + 1 + StartPos = LocPos+1 + End If + Loop until LocPos = 0 + CountCharsInString = LocCount +End Function + + +Function BubbleSortList(ByVal SortList()) +Dim s as Integer +Dim t as Integer +Dim i as Integer +Dim DisplayDummy as String + i = Val(SortList(0,0)) + For s = 1 to i - 1 + For t = 0 to i-s + If SortList(t,0) > SortList(t+1, 0) Then + DisplayDummy = SortList(t,0) + SortList(t,0) = SortList(t+1,0) + SortList(t+1,0) = DisplayDummy + + DisplayDummy = SortList(t,1) + SortList(t,1) = SortList(t+1,1) + SortList(t+1,1) = DisplayDummy + End If + Next t + Next s + BubbleSortList = SortList() +End Function +</script:module>
\ No newline at end of file diff --git a/wizards/source/webwizard/HtmlAutoPilotBasic.xba b/wizards/source/webwizard/HtmlAutoPilotBasic.xba new file mode 100644 index 000000000..5009db1ab --- /dev/null +++ b/wizards/source/webwizard/HtmlAutoPilotBasic.xba @@ -0,0 +1,532 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="HtmlAutoPilotBasic" script:language="StarBasic">' Variables must be declared +Option Explicit + +' Maximum number of content templates, style templates and bullets +Const MaxLayouts = 50 +Const MaxStyles = 100 +Const MaxBullets = 10 + +Public NumberOfLayouts%, NumberOfStyles% + +' Filled with title, previous, next, home, top, bullet, background, file name +Public Style(8, MaxStyles) as String + +' Filled with title, file name +Public Layout$(2, MaxLayouts%) + +Public TextureDir$, BulletDir$, GraphicsDir$, GalleryDir$, PhotosDir$ +Public CurrentBullet$, CurrentPrev$, CurrentNext$, CurrentHome$, CurrentTop$ +Public FileStr as String + +Public WebWiz_gWizardName$, WebWiz_gErrContentNotFound$, WebWiz_gErrStyleNotFound$ +Public WebWiz_gErrMainTemplateError$, WebWiz_gErrWhileReloading$ +Public WebWiz_gErrWhileLoadStyles$, WebWiz_gErrMsg$, WebWiz_gErrMainDocumentError$ + +Public ProgressBar as Object +Public ProgressValue As Long +Public oBaseDocument as Object +Public oViewCursor as Object +Public oViewSettings as Object +Public NoArgs as New com.sun.star.beans.PropertyValue + +Public oCursor as Object +Public oBookmarks as Object +Public oBookMark as Object + +Public oUcb as Object +Public MainDialog as Object +Public DialogModel as Object + + +Sub Main +'On Local Error Goto GlobalErrorHandler + LoadLibrary("tools") + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + oBaseDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter/web", "_blank", 0, NoArgs()) + oViewSettings = oBaseDocument.CurrentController.ViewSettings + + oViewCursor = oBaseDocument.GetCurrentController.ViewCursor + ProgressBar = oBaseDocument.GetCurrentController.GetFrame.CreateStatusIndicator + ProgressBar.Start("", 100) + SetProgressValue(2) + oBaseDocument.LockControllers + oViewSettings.ShowTableBoundaries = False + oViewSettings.ShowTextBoundaries = False + MainDialog = LoadDialog("WebWizard","WebWzrd") + DialogModel = MainDialog.Model + LoadLanguage + SetProgressValue(10) + GetPaths() + NumberofLayouts = FillupWebListbox(oUcb, "/cnt", MainDialog, "lbTemplate", Layout$()) + SetProgressValue(30) + GetCurIndex(DialogModel.lbTemplate, Layout(),NumberofLayouts,2) + oCursor = oBasedocument.Text.CreateTextCursor + oCursor.InsertDocumentfromURL(FileStr, NoArgs()) + SetProgressValue(40) + DialogModel.optTiled.State = 1 + NumberofStyles = FillupWebListbox(oUcb, "/stl", MainDialog, "lbStyles", Style()) + SetProgressValue(50) + LoadWebPageStyles(oBaseDocument) + SetProgressValue(98) + SetProgressValue(0) + oBaseDocument.UnlockControllers + MainDialog.Execute + +GLOBALERRORHANDLER: + If Err <> 0 Then + MsgBox (WebWiz_gErrMsg$, 16, WebWiz_gWizardName$) + CancelHTMLWizard() + End If +End Sub + + +Function SetProgressValue(iValue as Integer) + If iValue = 0 Then + ProgressBar.End + End If + ProgressValue = iValue + ProgressBar.Value = iValue +End Function + + +Sub ReloadCurrentDocument() +Dim CurInd as Integer +'On Local Error Goto ErrorOcurred +' Todo:Check if the pointer is really disabled, when set to Hourglass + ToggleWindow(False) + oBaseDocument.LockControllers + ' Get selected list entry and corresponding file name + CurInd = GetCurIndex(DialogModel.lbTemplate, Layout$(), NumberofLayouts%, 2) + oCursor = oBaseDocument.Text.CreateTextCursor + oCursor.GotoStart(False) + oCursor.GotoEnd(True) + oCursor.InsertDocumentfromURL(FileStr, NoArgs()) + SetBulletAndGraphics + CheckControls(oBaseDocument.DrawPage) +ErrorOcurred: + If Err <> 0 Then + MsgBox(WebWiz_gErrWhileReloading$, 16, WebWiz_gWizardName$) + End If + oBaseDocument.UnlockControllers + oViewCursor.GotoStart(False) + ToggleWindow(True) +End Sub + + + +Sub LoadWebPageStyles() +Dim CurIndex as Integer + ToggleWindow(False) + oBaseDocument.LockControllers + CurIndex = GetCurIndex(DialogModel.lbStyles, Style(), NumberofStyles%,8) + LoadNewStyles(oBaseDocument, DialogModel, CurIndex, FileStr, Style(), TextureDir) + CurrentBullet$ = BulletDir + Style(6, CurIndex) + CurrentPrev$ = GraphicsDir + Style(2, CurIndex) + CurrentNext$ = GraphicsDir + Style(3, CurIndex) + CurrentHome$ = GraphicsDir + Style(4, CurIndex) + CurrentTop$ = GraphicsDir + Style(5, CurIndex) + With oBaseDocument.DocumentInfo + .GetUserFieldValue(0) = ExtractGraphicNames(CurIndex,2) + .GetUserFieldValue(1) = ExtractGraphicNames(CurIndex, 4) + .GetUserFieldValue(2) = Style(6, CurIndex) ' Bullet + .GetUserFieldValue(3) = Style(7, CurIndex) ' Background + End With + SetBulletAndGraphics() + CheckControls(oBaseDocument.DrawPage) + oViewCursor.GotoStart(False) + oBaseDocument.UnlockControllers + ToggleWindow(True) +End Sub + + +Function ExtractGraphicNames(CurIndex as Integer, i as Integer) as String +Dim FieldValue as String + FieldValue = GetFileNameWithoutExtension(Style(i,CurIndex)) + FieldValue = FieldValue & " " & GetFileNameWithoutExtension(Style(i+1,CurIndex)) + ExtractGraphicNames = FieldValue +End Function + + +Function GetCurIndex(oListbox as Object, sList() as String, MaxIndex as Integer, FileIndex as Integer) +Dim i, n as Integer +Dim SelValue as String + ' Get selected list entry + n = oListbox.SelectedItems(0) + SelValue = oListbox.StringItemList(n) + ' Find field index for chosen list entry + For i = 0 To MaxIndex + If sList(1, i) = SelValue Then + FileStr = sList(FileIndex, i) + Exit For + End If + Next + GetCurIndex = i +End Function + + +Sub SetBulletAndGraphics + SetGraphic("Prev", CurrentPrev) + SetGraphic("Next", CurrentNext) + SetGraphic("Home", CurrentHome) + SetGraphic("Top", CurrentTop) + SetBulletGraphics(CurrentBullet) + SetGraphicsToOriginalSize() +End Sub + + +Sub SetGraphicsToOriginalSize() +Dim oGraphics as Object +Dim oGraphic as Object +Dim i as Integer +Dim aActSize as New com.sun.star.awt.Size + oGraphics = oBaseDocument.GraphicObjects + For i = 0 To oGraphics.Count-1 + oGraphic = oGraphics.GetByIndex(i) + aActSize = oGraphic.ActualSize + If aActSize.Height > 0 And aActSize.Width > 0 Then + oGraphic.SetSize(aActSize) + End If + Next i +End Sub + + +Sub EndDialog() + If DialogModel.chkSaveasTemplate.State = 1 Then + ' Generating template? Set events later! + AttachBasicMacroToEvent(oBaseDocument,"OnNew", "WebWizard.HtmlAutoPilotBasic.SetEvent()") + ' Call the Store template dialog + DispatchSlot(5538) + Else + SetEvent + End If + MainDialog.EndExecute() + MainDialog.Dispose() +End Sub + + +Sub CancelHTMLWizard() + MainDialog.EndExecute() + MainDialog.Dispose() + oBaseDocument.Dispose() +End Sub + + +Sub SetEvent() +Dim oDocument as Object +' This sub links the events OnSaveDone and OnSaveAsDone to the procedure +' CopyGraphics. It is invoked when a document is created, either directly +' from the AutoPilot or from a template. It is not possible to set these +' links for the template created by the AutoPilot because then it is not +' possible to modify the template. + LoadLibrary("tools") + oDocument = StarDesktop.ActiveFrame.Controller.Model + AttachBasicMacroToEvent(oDocument,"OnSaveDone", "WebWizard.HtmlAutoPilotBasic.CopyGraphics()") + AttachBasicMacroToEvent(oDocument,"OnSaveAsDone", "WebWizard.HtmlAutoPilotBasic.CopyGraphics()") +End Sub + + + +Sub CopyGraphics +' This sub copies all the graphics used in the document to the same directory the +' document has been copied into and changes the graphics links in the document. +Dim oGraphicObjects, oGraphic as Object +Dim i as Integer +Dim GraphicFilePath as String +Dim SavePath$ +Dim GraphicFileName as String + LoadLibrary("tools") + GetPaths() + oBaseDocument = StarDesktop.ActiveFrame.Controller.Model + Msgbox oBaseDocument.Url + SavePath = oBaseDocument.Url + oGraphicObjects = oBaseDocument.GraphicObjects + + For i = 0 to oGraphicObjects.Count-1 + oGraphic = oGraphicObjects.GetbyIndex(i) + GraphicFilePath = oGraphic.GraphicURL + GraphicFileName = FileNameoutofPath(GraphicFilePath) + FileCopy GraphicFilePath, Savepath & GraphicFileName + oGraphic.GraphicURL = Savepath & GraphicFileName + Next i + + GraphicFileName = FileNameoutofPath(CurrentBullet) + FileCopy BulletDir & GraphicFileName, SavePath & GraphicFileName + + SetBulletGraphics(GraphicFileName) + +' ' Copy background graphic +' If ActiveWindow.Page.GrfFilename<>"" Then +' ' Set new background graphic +' ActiveWindow.Page.GrfFilename = SavePath$+GraphicFileName$ +' ActiveWindow.Page.GrfPosition = 11 +' End If + + With oBaseDocument.DocumentInfo + .GetUserFieldValue(0) = "" + .GetUserFieldValue(1) = "" + .GetUserFieldValue(2) = "" + .GetUserFieldValue(3) = "" + End With + +' ' Reset events + AttachBasicMacroToEvent(oBaseDocument,"OnSaveDone", "") + AttachBasicMacroToEvent(oBaseDocument,"OnSaveAsDone", "") + AttachBasicMacroToEvent(oBaseDocument,"OnCreate", "") + oBaseDocument.Store +End Sub + + +Function FillupWebListbox(oUcb as Object, sFileFilter as String, oDialog as Object, ListboxName as String, List() as String) +Dim oDocInfo as Object +Dim oListboxControl as Object +Dim Description as String +Dim sField as String +Dim sFieldList() as String +Dim bItemFound as Boolean +Dim MaxIndex as Integer +Dim DirContent() as String +Dim FileName as String +Dim TemplatePath as String +Dim FilterLen as Integer +Dim i as Integer +Dim m as Integer +Dim n as Integer +Dim s as Integer +Dim a as Integer +Dim SelList(0) as Integer +Dim LocMaxIndex as Integer + oListboxControl = oDialog.GetControl(ListboxName) + + oDocInfo = createUnoService("com.sun.star.document.StandaloneDocumentInfo") + FilterLen = Len(sFileFilter) + bItemFound = False + TemplatePath = GetOfficeSubPath("Template", "wizard/web/") + DirContent() = oUcb.GetFolderContents(TemplatePath,True) + LocMaxIndex = Ubound(DirContent()) + a = 0 + For i = 0 To LocMaxIndex + FileName = DirContent(i) + If Instr(1,Filename, sFileFilter) Then + bItemFound = True + Description = RetrieveDocTitle(oDocInfo, FileName) + oListboxControl.AddItem(Description,a) + a = a + 1 + List(1,i) = Description + If sFileFilter = "/cnt" Then + List(2,i) = Filename + Else + m = 2 + For n = 0 To 3 + sField = oDocInfo.GetUserFieldValue(n) + sFieldList() = ArrayoutofString(sField, " ", MaxIndex) + For s = 0 To MaxIndex + If m < 6 Then + List(m,i) = sFieldList(s) & ".gif" + Else + List(m,i) = sFieldList(s) + End If + m = m + 1 + Next s + Next n + List(8,i) = FileName + End If + End If + Next i + + ' No content template? Error message, close new empty document, stop execution + If Not bItemfound Then + MsgBox(WebWiz_gErrContentNotFound$ , 16, WebWiz_gWizardName$) + oBaseDocument.Dispose() + Stop + End If + SelList(0) = 0 + oListboxControl.Model.SelectedItems() = SelList() + FillupWebListbox = i +End Function + + +Sub SetGraphic(sWhich, sGraphicText as String) +Dim oLocCursor as Object +Dim oGraphic as Object +Dim bGetGraphic as Boolean + oBookmarks = oBaseDocument.BookMarks + If oBookmarks.HasbyName(sWhich)Then + oBookMark = oBookmarks.GetbyName(sWhich) + oLocCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) + oGraphic = oBaseDocument.CreateInstance("com.sun.star.text.GraphicObject") + oLocCursor.GoRight(3,True) + oGraphic.AnchorType = 1 + oGraphic.GraphicURL = ConverttoURL(sGraphicText) + oLocCursor.Text.InsertTextContent(oLocCursor, oGraphic, True) + oGraphic.Name = sWhich + ElseIf oBaseDocument.GraphicObjects.HasbyName(sWhich) Then + oGraphic = oBaseDocument.GraphicObjects.GetByName(sWhich) + oGraphic.GraphicUrl = sGraphicText + End If +End Sub + + + +Sub ChangeBulletURL(sBulletUrl as String, oBookMarkCursor as Object) +Dim n, m as Integer +Dim oLevel() +Dim oRules +Dim bDoReplace as Boolean +Dim oSize as New com.sun.star.awt.Size +Dim oNumberingBuffer(0) as New com.sun.star.beans.PropertyValue +Dim oNewBuffer(1) as New com.sun.star.beans.PropertyValue + oRules = oBookMarkCursor.NumberingRules + If Vartype(oRules()) = 9 Then + oNumberingBuffer(0).Name = "NumberingType" + oNumberingBuffer(0).Value = com.sun.star.style.NumberingType.BITMAP + For n = 0 To oRules.Count - 1 + oLevel() = oRules.GetByIndex(n) + bDoReplace = ModifyPropertyValue(oLevel(), oNumberingBuffer()) + If bDoReplace Then + oRules.ReplaceByIndex(n, oNumberingBuffer()) + End If + Next n + oBookmarkCursor.NumberingRules = oRules + oNewBuffer(0).Name = "GraphicURL" + oNewBuffer(0).Value = sBulletUrl + oNewBuffer(1).Name = "GraphicSize" + oSize.Height = 300 + oSize.Width = 300 + oNewBuffer(1).Value = oSize + For n = 0 To oRules.Count - 1 + oLevel() = oRules.GetByIndex(0) + bDoReplace = ModifyPropertyValue(oLevel(), oNewBuffer()) + If bDoReplace Then + oRules.ReplaceByIndex(n, oNewBuffer()) + End If + Next n + oBookmarkCursor.NumberingRules = oRules + End If +End Sub + + +Sub SetBulletGraphics(sBulletUrl as String) +Dim i as Integer +Dim oBookMarkCursor as Object + oBookmarks = oBaseDocument.BookMarks + For i = 0 To oBookmarks.Count - 1 + oBookMark = oBookmarks.GetbyIndex(i) + oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) + If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then + ChangeBulletURL(sBulletUrl, oBookMarkCursor) + End If + Next i +End Sub + + +Sub CheckControls(oDrawPage as Object) +Dim aForm as Object +Dim m,n as integer +Dim lColor as Long +Dim oControl as Object + lColor = oBaseDocument.StyleFamilies.GetbyName("ParagraphStyles").GetByName("Standard").CharColor + 'SearchFor all possible Controls + For n = 0 to oDrawPage.Forms.Count - 1 + aForm = oDrawPage.Forms(n) + For m = 0 to aForm.Count-1 + oControl = aForm.GetbyIndex(m) + oControl.TextColor = lColor + Next + Next +End Sub + +REM ***** BASIC ***** + +Sub LoadNewStyles(oDocument as Object, oDialogModel as Object, CurIndex as Integer, SourceFile as String, Styles() as String, TextureDir as String) +Dim BackGroundURL as String +Dim oBackGraph as Object +Dim i, BackColor as Long +Dim oFamilies as Object, oFamily as Object, oStyle as Object +Dim StylesOptions(0) as New com.sun.star.beans.PropertyValue + + If SourceFile <> "" Then + StylesOptions(0).Name = "OverwriteStyles" + StylesOptions(0).Value = true + oDocument.StyleFamilies.LoadStylesFromURL(SourceFile, StylesOptions()) + End If + + ' Read array fields for background, bullet & graphics + BackgroundURL = Styles(7, CurIndex) + If Left(BackgroundURL, 1) <> "#" Then + BackgroundURL = TextureDir + BackgroundURL + ToggleOptionButtons(oDialogModel, 1) + Else + BackColor = clng("&H" & Right(BackgroundURL, Len(BackgroundURL)-1)) + ToggleOptionButtons(oDialogModel, 0) + End If + oFamilies = oDocument.StyleFamilies + oFamily = oFamilies.GetbyName("PageStyles") +' oStyle = oDocument.StyleFamilies.GetByName("PageStyles").GetByName("Standard") + For i = 0 To oFamily.Count - 1 + If oFamily.GetByIndex(i).IsInUse Then + oStyle = oFamily.GetbyIndex(i) + If oStyle.PropertySetInfo.HasPropertybyName("BackGraphicURL") Then + If Left(BackgroundURL, 1) = "#" Then + oStyle.BackGraphicURL = "" + oStyle.BackColor = BackColor + oStyle.BackTransparent = False + Else + oStyle.BackGraphicUrl = BackGroundURL + SetTileBackgroundorNot(oDialogModel, oStyle) + End If + End If + End If + Next i +ErrorOcurred: + If Err <> 0 Then + MsgBox(WebWiz_gErrWhileLoadStyles$, 16, WebWiz_gWizardName$) + CancelHTMLWizard() + End If +End Sub + + + +Sub ToggleOptionButtons(DialogModel as Object, bDoEnable as Integer) + DialogModel.optTiled.Enabled = bDoEnable + DialogModel.optArea.Enabled = bDoEnable + DialogModel.frmBackground.Enabled = bDoEnable +End Sub + + +Sub SetBackGraphicStyle(oEvent as Object) +Dim oFamilies as Object +Dim oFamily as Object +Dim i as Integer +Dim oStyle as Object +Dim oOptModel as Object +Dim iBackgroundValue as Integer +Dim oLocDocument as Object + ooptModel = oEvent.Source.Model + iBackgroundValue = Val(ooptModel.Tag) + oLocDocument = StarDesktop.ActiveFrame.Controller.Model + oLocDocument.LockControllers + oFamilies = oLocDocument.StyleFamilies + oFamily = oFamilies.GetbyName("PageStyles") + For i = 0 To oFamily.Count - 1 + If oFamily.GetByIndex(i).IsInUse Then + oStyle = oFamily.GetbyIndex(i) + If oStyle.PropertySetInfo.HasPropertybyName("BackGraphicURL") Then + oStyle.BackGraphicLocation = iBackgroundValue + End If + End If + Next i + oLocDocument.UnlockControllers +End Sub + + +Sub SetTileBackgroundorNot(DialogModel as Object, oStyle as Object) + If DialogModel.optTiled.State = 1 Then + oStyle.BackGraphicLocation = com.sun.star.style.GraphicLocation.TILED + Else + oStyle.BackGraphicLocation = com.sun.star.style.GraphicLocation.AREA + End If +End Sub + +</script:module>
\ No newline at end of file diff --git a/wizards/source/webwizard/Language.xba b/wizards/source/webwizard/Language.xba new file mode 100644 index 000000000..b215a6f4e --- /dev/null +++ b/wizards/source/webwizard/Language.xba @@ -0,0 +1,56 @@ +<?xml version="1.0" encoding="UTF-8"?> + +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Language" script:language="StarBasic">Option Explicit + + +Sub LoadLanguage() + If InitResources("WebWizard","wwz") Then + DialogModel.Title = GetResText(1001) + DialogModel.cbCancel.Label = GetResText(1002) + DialogModel.cbGoOn.Label = GetResText(1003) +' WebWiz_0_FrameControl = GetResText(1012) + DialogModel.lblTemplate.Label = GetResText(1004) + DialogModel.lblStyle.Label = GetResText(1005) + DialogModel.frmBackground.Label = GetResText(1006) + + DialogModel.optTiled.Label = GetRestext(1007) + DialogModel.optArea.Label = GetResText(1008) +' DialogModel.OptEditDocument.Label = GetResText(1009) + + DialogModel.chkSaveasTemplate.Label = GetResText(1010) + WebWiz_gErrContentNotFound = GetResText(1101) + WebWiz_gErrStyleNotFound = GetResText(1102) + WebWiz_gErrMainTemplateError = GetResText(1103) + WebWiz_gErrWhileReloading = GetResText(1104) + WebWiz_gErrWhileLoadStyles = GetResText(1105) + WebWiz_gErrMainDocumentError = GetResText(1106) + WebWiz_gErrMsg = GetResText(1107) + End If +End Sub + + +Sub LoadLibrary(sLibname as String) +Dim oArg(0) as new com.sun.star.beans.PropertyValue +Dim oUrl as new com.sun.star.util.URL +Dim oTrans as Object +Dim oDisp as Object + + oArg(0).Name = "LibraryName" + oArg(0).Value = sLibname + + oTrans = createUNOService("com.sun.star.util.URLTransformer") + oUrl.Complete = "slot:6517" + oTrans.parsestrict(oUrl) + + oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0) + oDisp.dispatch(oUrl, oArg()) +End Sub + + +Sub GetPaths + TextureDir = GetOfficeSubPath("Gallery", "www-back/") + GraphicsDir = GetOfficeSubPath("Gallery", "www-graf/") + BulletDir = GetOfficeSubPath("Gallery", "bullets/") + PhotosDir = GetPathSettings("Gallery", False, 1) +End Sub +</script:module>
\ No newline at end of file |