From ed5640d8b587fbcfed7dd7967f3de04b37a76f26 Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 11:06:44 +0200 Subject: Adding upstream version 4:7.4.7. Signed-off-by: Daniel Baumann --- wizards/source/euro/AutoPilotRun.xba | 415 ++++++++++++++++++++++ wizards/source/euro/Common.xba | 289 +++++++++++++++ wizards/source/euro/ConvertRun.xba | 334 ++++++++++++++++++ wizards/source/euro/DlgConvert.xdl | 94 +++++ wizards/source/euro/DlgPassword.xdl | 32 ++ wizards/source/euro/Hard.xba | 246 +++++++++++++ wizards/source/euro/Init.xba | 667 +++++++++++++++++++++++++++++++++++ wizards/source/euro/Protect.xba | 192 ++++++++++ wizards/source/euro/Soft.xba | 256 ++++++++++++++ wizards/source/euro/Writer.xba | 89 +++++ wizards/source/euro/dialog.xlb | 6 + wizards/source/euro/script.xlb | 12 + 12 files changed, 2632 insertions(+) create mode 100644 wizards/source/euro/AutoPilotRun.xba create mode 100644 wizards/source/euro/Common.xba create mode 100644 wizards/source/euro/ConvertRun.xba create mode 100644 wizards/source/euro/DlgConvert.xdl create mode 100644 wizards/source/euro/DlgPassword.xdl create mode 100644 wizards/source/euro/Hard.xba create mode 100644 wizards/source/euro/Init.xba create mode 100644 wizards/source/euro/Protect.xba create mode 100644 wizards/source/euro/Soft.xba create mode 100644 wizards/source/euro/Writer.xba create mode 100644 wizards/source/euro/dialog.xlb create mode 100644 wizards/source/euro/script.xlb (limited to 'wizards/source/euro') diff --git a/wizards/source/euro/AutoPilotRun.xba b/wizards/source/euro/AutoPilotRun.xba new file mode 100644 index 000000000..77ca182df --- /dev/null +++ b/wizards/source/euro/AutoPilotRun.xba @@ -0,0 +1,415 @@ + + + +Option Explicit + +Public SourceDir as String +Public TargetDir as String +Public TargetStemDir as String +Public SourceFile as String +Public TargetFile as String +Public Source as String +Public SubstFile as String +Public SubstDir as String +Public NoArgs() +Public TypeList(6) as String +Public GoOn as Boolean +Public DoUnprotect as Integer +Public Password as String +Public DocIndex as Integer +Public oPathSettings as Object +Public oUcb as Object +Public TotDocCount as Integer +Public sTotDocCount as String +Public OpenProperties(1) as New com.sun.star.beans.PropertyValue + + +Sub StartAutoPilot() +Dim i As Integer +Dim oFactoryKey as Object + BasicLibraries.LoadLibrary("Tools") + BasicLibraries.LoadLibrary("ImportWizard") + If InitResources("Euro Converter") Then + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + oLocale = GetStarOfficeLocale() + InitializeConverter(oLocale, 2) + ToggleGoOnButton() + oFactoryKey = GetRegistryKeyContent("org.openoffice.Setup/Office/Factories") + DialogModel.chkTextDocuments.Enabled = oFactoryKey.hasbyName("com.sun.star.text.TextDocument") + DialogModel.cmdGoOn.DefaultButton = True + DialogModel.lstCurrencies.TabIndex = 12 + DialogConvert.GetControl("optWholeDir").SetFocus() + DialogConvert.Execute() + DialogConvert.Dispose() + End If +End Sub + + +Sub ConvertDocuments() +Dim FilesList() +Dim bDisposable as Boolean + + If Source <> "" And TargetDir <> "" Then + If DialogModel.optSingleFile.State = 1 Then + SourceFile = Source + TotDocCount = 1 + Else + SourceDir = Source + TargetStemDir = TargetDir + TypeList(0) = "calc8" + TypeList(1) = "calc_StarOffice_XML_Calc" + If DialogModel.chkTextDocuments.State = 1 Then + ReDim Preserve TypeList(5) as String + + TypeList(2) = "writer8" + TypeList(3) = "writerglobal8" + TypeList(4) = "writer_StarOffice_XML_Writer" + TypeList(5) = "writer_globaldocument_StarOffice_XML_Writer_GlobalDocument" + End If + FilesList() = ReadDirectories(SourceDir, bRecursive, True, False, TypeList()) + TotDocCount = Ubound(FilesList(),1) + 1 + End If + InitializeProgressPage(DialogModel) +' ChangeToNextProgressStep() + sTotDocCount = CStr(TotDocCount) + OpenProperties(0).Name = "Hidden" + OpenProperties(0).Value = True + OpenProperties(1).Name = "AsTemplate" + OpenProperties(1).Value = False + For DocIndex = 0 To TotDocCount - 1 + If InitializeDocument(FilesList(), bDisposable) Then + If StoreDocument() Then + ConvertDocument() + oDocument.Store + End If + If bDisposable Then + oDocument.Dispose() + End If + End If + Next DocIndex + DialogModel.cmdBack.Enabled = True + DialogModel.cmdGoOn.Enabled = True + DialogModel.cmdGoOn.Label = sReady + DialogModel.cmdCancel.Label = sEnd + End If +End Sub + + +Function InitializeDocument(FilesList(), bDisposable as Boolean) as Boolean +' The Autopilot is started from step No. 2 +Dim sViewPath as String +Dim bIsReadOnly as Boolean +Dim sExtension as String + On Local Error Goto NEXTFILE + If Not bCancelTask Then + 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 CreateFolder(TargetDir) Then + sExtension = GetFileNameExtension(SourceFile, "/") + oDocument = OpenDocument(SourceFile, OpenProperties(), bDisposable) + If (oDocument.IsReadOnly) AND (UCase(SourceFile) = UCase(TargetFile)) Then + bIsReadOnly = True + Msgbox(sMsgDOCISREADONLY, 16, GetProductName()) + Else + bIsReadOnly = False + RetrieveDocumentObjects() + sViewPath = CutPathView(SourceFile, 60) + DialogModel.lblCurDocument.Label = Str(DocIndex+1) & "/" & sTotDocCount & " (" & sViewPath & ")" + End If + InitializeDocument() = Not bIsReadOnly + Else + InitializeDocument() = False + End If + Else + InitializeDocument() = False + End If +NEXTFILE: + If Err <> 0 Then + InitializeDocument() = False + Resume LETSGO +LETSGO: + End If +End Function + + +Sub ChangeToNextProgressStep() + DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.NORMAL + DialogConvert.GetControl("lblCurProgress").Visible = True +End Sub + + +Function StoreDocument() as Boolean +Dim sCurFileExists as String +Dim iOverWrite as Integer + If (TargetFile <> "") And (Not bCancelTask) Then + On Local Error Goto NOSAVING + If oUcb.Exists(TargetFile) Then + sCurFileExists = ReplaceString(sMsgFileExists, ConvertFromUrl(TargetFile), "<1>") + sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>") + iOverWrite = Msgbox (sCurFileExists, 32 + 3, sMsgDLGTITLE) + Select Case iOverWrite + Case 1 ' OK + Case 2 ' Abort + bCancelTask = True + StoreDocument() = False + Exit Function + Case 7 ' No + StoreDocument() = False + Exit Function + End Select + End If + If TargetFile <> SourceFile Then + oDocument.StoreAsUrl(TargetFile,NoArgs) + Else + oDocument.Store + End If + 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 + If Not IsNull(SubstFile) Then + SubstFile = DialogModel.txtSource.Text + DialogModel.txtSource.Text = SubstDir + End If + Else + DialogModel.LblSource.Label = sSOURCEFILE + If Not IsNull(SubstDir) Then + SubstDir = DialogModel.txtSource.Text + DialogModel.txtSource.Text = SubstFile + End If + End If + ToggleGoOnButton() +End Sub + + +Function InitializeThirdStep() as Boolean +Dim TextBoxText as String + Source = AssignFileName(DialogModel.txtSource.Text, DialogModel.lblSource.Label, True) + If CheckTextBoxPath(DialogModel.txtTarget, True, True, sMsgDLGTITLE, True) Then + TargetDir = AssignFileName(DialogModel.txtTarget.Text, DialogModel.lblTarget.Label, False) + Else + TargetDir = "" + End If + If Source <> "" And TargetDir <> "" Then + bRecursive = DialogModel.chkRecursive.State = 1 + bDoUnprotect = DialogModel.chkProtect.State = 1 + DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.BOLD + DialogModel.lblRetrieval.Label = sPrgsRETRIEVAL + DialogModel.lblCurProgress.Label = sPrgsCONVERTING + If DialogModel.optWholeDir.State = 1 Then + TextBoxText = sSOURCEDIR & " " & ConvertFromUrl(Source) & chr(13) + If DialogModel.chkRecursive.State = 1 Then + TextBoxText = TextBoxText & DeleteStr(sInclusiveSubDir,"~") & chr(13) + End If + Else + TextBoxText = sSOURCEFILE & " " & ConvertFromUrl(Source) & chr(13) + End If + TextBoxText = TextBoxText & sTARGETDIR & " " & ConvertFromUrl(TargetDir) & chr(13) + If DialogModel.chkProtect.State = 1 Then + TextBoxText = TextboxText & sPrgsUNPROTECT + End If + DialogModel.txtConfig.Text = TextBoxText + ToggleProgressStep() + DialogModel.cmdGoOn.Enabled = False + InitializeThirdStep() = True + Else + InitializeThirdStep() = False + End If +End Function + + +Sub ToggleProgressStep(Optional aEvent as Object) +Dim bMakeVisible as Boolean +Dim LocStep as Integer + ' If the Sub is call by the 'cmdBack' Button then set the 'bMakeVisible' variable accordingly + bMakeVisible = IsMissing(aEvent) + If bMakeVisible Then + DialogModel.Step = 3 + Else + DialogModel.Step = 2 + End If + DialogConvert.GetControl("lblCurrencies").Visible = Not bMakeVisible + DialogConvert.GetControl("lstCurrencies").Visible = Not bMakeVisible + DialogConvert.GetControl("cmdBack").Visible = bMakeVisible + DialogConvert.GetControl("cmdGoOn").Visible = bMakeVisible + DialogModel.imgPreview.ImageUrl = BitmapDir & "euro_" & DialogModel.Step & ".png" +End Sub + + +Sub EnableStep2DialogControls(OnValue as Boolean) + With DialogModel + .hlnExtent.Enabled = OnValue + .optWholeDir.Enabled = OnValue + .optSingleFile.Enabled = OnValue + .chkProtect.Enabled = OnValue + .cmdCallSourceDialog.Enabled = OnValue + .cmdCallTargetDialog.Enabled = OnValue + .lblSource.Enabled = OnValue + .lblTarget.Enabled = OnValue + .txtSource.Enabled = OnValue + .txtTarget.Enabled = OnValue + .imgPreview.Enabled = OnValue + .lstCurrencies.Enabled = OnValue + .lblCurrencies.Enabled = OnValue + If OnValue Then + ToggleGoOnButton() + .chkRecursive.Enabled = .optWholeDir.State = 1 + Else + .cmdGoOn.Enabled = False + .chkRecursive.Enabled = False + End If + End With +End Sub + + +Sub InitializeProgressPage() + DialogConvert.GetControl("lblRetrieval").Visible = False + DialogConvert.GetControl("lblCurProgress").Visible = False + DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.NORMAL + DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.BOLD + DialogConvert.GetControl("lblRetrieval").Visible = True + DialogConvert.GetControl("lblCurProgress").Visible = True +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(sPath) + If DialogModel.chkTextDocuments.State = 1 Then + If (Instr(1, sLocMimeType, "text") = 0) And (Instr(1, sLocMimeType, "calc") = 0) Then + Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE) + bIsValid = False + End If + Else + If (Instr(1, sLocMimeType, "spreadsheet") = 0) And (Instr(1, sLocMimeType, "calc")) = 0 Then + Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE) + bIsValid = False + End If + 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 & " '" & ConvertFromUrl(sPath) & "' " & sMsgNOTTHERE,48, sMsgDLGTITLE) + End If + If bIsValid Then + AssignFileName() = sPath + Else + AssignFilename() = "" + End If +End Function + + +Sub ToggleGoOnButton() +Dim bDoEnable as Boolean +Dim sLocMimeType as String +Dim sPath as String + bDoEnable = Ubound(DialogModel.lstCurrencies.SelectedItems()) > -1 + If bDoEnable Then + ' Check if Source is set correctly + sPath = ConvertToUrl(Trim(DialogModel.txtSource.Text)) + bDoEnable = oUcb.Exists(sPath) + End If + DialogModel.cmdGoOn.Enabled = bDoEnable +End Sub + + +Sub CallFolderPicker() + GetFolderName(DialogModel.txtTarget) + ToggleGoOnButton() +End Sub + + +Sub CallFilePicker() + If DialogModel.optSingleFile.State = 1 Then + Dim oMasterKey as Object + Dim oTypes() as Object + Dim oUIKey() as Object + + oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types") + oTypes() = oMasterKey.Types + oUIKey = GetRegistryKeyContent("org.openoffice.Office.UI/FilterClassification/LocalFilters") + If DialogModel.chkTextDocuments.State = 1 Then + Dim FilterNames(7,1) as String + FilterNames(4,0) = oTypes.GetByName("writer_StarOffice_XML_Writer").UIName + FilterNames(4,1) = "*.sxw" + FilterNames(5,0) = oTypes.GetByName("writer_StarOffice_XML_Writer_Template").UIName + FilterNames(5,1) = "*.stw" + FilterNames(6,0) = oTypes.GetByName("writer8").UIName + FilterNames(6,1) = "*.odt" + FilterNames(7,0) = oTypes.GetByName("writer8_template").UIName + FilterNames(7,1) = "*.ott" + Else + ReDim FilterNames(3,1) as String + End If + FilterNames(0,0) = oTypes.GetByName("calc8").UIName + Filternames(0,1) = "*.ods" + FilterNames(1,0) = oTypes.GetByName("calc8_template").UIName + Filternames(1,1) = "*.ots" + FilterNames(2,0) = oTypes.GetByName("calc_StarOffice_XML_Calc").UIName + Filternames(2,1) = "*.sxc" + FilterNames(3,0) = oTypes.GetByName("calc_StarOffice_XML_Calc_Template").UIName + Filternames(3,1) = "*.stc" + GetFileName(DialogModel.txtSource, Filternames()) + Else + GetFolderName(DialogModel.txtSource) + End If + ToggleGoOnButton() +End Sub + + +Sub PreviousStep() + DialogModel.Step = 2 + DialogModel.cmdGoOn.Label = sGOON + DialogModel.cmdCancel.Label = sCANCEL +End Sub + diff --git a/wizards/source/euro/Common.xba b/wizards/source/euro/Common.xba new file mode 100644 index 000000000..550042ee9 --- /dev/null +++ b/wizards/source/euro/Common.xba @@ -0,0 +1,289 @@ + + + + REM ***** BASIC ***** +Public DialogModel as Object +Public DialogConvert as Object +Public DialogPassword as Object +Public PasswordModel as Object + +Sub RetrieveDocumentObjects() + CurMimeType = Tools.GetDocumentType(oDocument) + If Instr(1, CurMimeType, "calc") <> 0 Then + oSheets = oDocument.Sheets + oSheet = oDocument.Sheets.GetbyIndex(0) + oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + End If + ' Retrieve the indices for the cellformatations + oFormats = oDocument.NumberFormats +End Sub + + +Sub CancelTask() +' If Not DocDisposed Then +' ReprotectSheets() +' End If + If DialogModel.Step = 3 And (Not bCancelTask) Then + If Msgbox(sMsgCancelConversion, 36, sMsgCancelTitle) = 6 Then + bCancelTask = True + DialogConvert.EndExecute + Else + bCancelTask = False + End If + Else + DialogConvert.EndExecute() + End If +End Sub + + +Function ConvertDocument() + GoOn = True +' DocDisposed = True + InitializeProgressbar() + If Instr(1, CurMimeType, "calc") <> 0 Then + bDocHasProtectedSheets = CheckSheetProtection(oSheets) + If bDocHasProtectedSheets Then + bDocHasProtectedSheets = UnprotectSheetsWithPassword(oSheets, bDoUnProtect) + End If + If Not bDocHasProtectedSheets Then + If Not bRangeListDefined Then + TotCellCount = 0 + CreateRangeEnumeration(True) + Else + IncreaseStatusvalue(SBRelGet/3) + End If + RangeIndex = Ubound(RangeList()) + If RangeIndex > -1 Then + ConvertThehardWay(RangeList(), True, False) + MakeStyleEnumeration(True) + oDocument.calculateAll() + End If + ReprotectSheets() + bRangeListDefined = False + End If + Else + DialogModel.ProgressBar.ProgressValue = 10 ' oStatusline.SetValue(10) + ConvertTextFields() + DialogModel.ProgressBar.ProgressValue = 80 ' oStatusline.SetValue(80) + ConvertWriterTables() + End If + EndStatusLine() + On Local Error Goto 0 +End Function + + +Sub SwitchNumberFormat(oObject as Object, oFormats as object) +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 +Dim sOldCurrSymbol as String + On Local Error Resume Next + iNumberFormat = oObject.NumberFormat + On Local Error GoTo NOKEY + aFormat() = oFormats.getByKey(iNumberFormat) + On Local Error GoTo 0 + sOldCurrSymbol = aFormat.CurrencySymbol + If sOldCurrSymbol = CurrValue(CurrIndex,5) Then + aSimpleStr = "0 [$EUR]" + Else + aSimpleStr = "0 [$" & sEuroSign & aFormat.CurrencyExtension & "]" + End If + + nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale) + ' set new Currency format with according settings + nFormatDecimals = 2 + nFormatLeading = aFormat.LeadingZeros + bFormatNegRed = aFormat.NegativeRed + bFormatThousands = aFormat.ThousandsSeparator + aNewStr = oFormats.generateFormat( nSimpleKey, aFormat.Locale, bFormatThousands, bFormatNegRed, nFormatDecimals, nFormatLeading) + oObject.NumberFormat = Numberformat(oFormats, aNewStr, aFormat.Locale) + NOKEY: + If Err <> 0 Then + Resume CLERROR + End If + CLERROR: +End Sub + + +Function Numberformat( oFormats as Object, aFormatStr as String, oLocale as Object) +Dim nRetkey +Dim l as String +Dim c as String + nRetKey = oFormats.queryKey( aFormatStr, oLocale, True ) + If nRetKey = -1 Then + l = oLocale.Language + c = oLocale.Country + nRetKey = oFormats.addNew( aFormatStr, oLocale ) + If nRetKey = -1 Then nRetKey = 0 + End If + Numberformat = nRetKey +End Function + + +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 + 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 is the one needed, then check the Currency extension + sFormatCurrExt = oFormatofObject.CurrencyExtension + + If FieldInList(CurExtension(),2,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 + Select Case DialogModel.Step + Case 1 + If DialogModel.chkComplete.State = 1 Then + ConvertWholeDocument() + Else + ConvertRangesorStylesofDocument() + End If + Case 2 + bCancelTask = False + If InitializeThirdStep() Then + ConvertDocuments() + bCancelTask = True + End If + Case 3 + DialogConvert.EndExecute() + End Select +End Sub + + +Sub IncreaseStatusValue(AddStatusValue as Integer) + StatusValue = Int(StatusValue + AddStatusValue) + If DialogModel.Step = 3 Then + DialogModel.ProgressBar.ProgressValue = StatusValue + Else + oStatusline.SetValue(StatusValue) + End If +End Sub + + +Sub SelectCurrency() +Dim AddtoList as Boolean +Dim NullList() +Dim OldCurrIndex as Integer + bRangeListDefined = False + OldCurrIndex = CurrIndex + CurrIndex = DialogModel.lstCurrencies.SelectedItems(0) + If OldCurrIndex <> CurrIndex Then + InitializeCurrencyValues(CurrIndex) + CurExtension(0) = LangIDValue(CurrIndex,0,2) + CurExtension(1) = LangIDValue(CurrIndex,1,2) + CurExtension(2) = LangIDValue(CurrIndex,2,2) + If DialogModel.Step = 1 Then + EnableStep1DialogControls(False,False, False) + If DialogModel.optCellTemplates.State = 1 Then + EnableStep1DialogControls(False, False, False) + CreateStyleEnumeration() + ElseIf ((DialogModel.optSheetRanges.State = 1) OR (DialogModel.optDocRanges.State = 1)) AND (DialogModel.Step = 1) Then + CreateRangeEnumeration(False) + If Ubound(RangeList()) = -1 Then + DialogModel.lstSelection.StringItemList() = NullList() + End If + ElseIf DialogModel.optSelRange.State= 1 Then + 'Preselected Range + End If + EnableStep1DialogControls(True, True, True) + ElseIf DialogModel.Step = 2 Then + EnableStep2DialogControls(True) + End If + 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 + + +Sub InitializeProgressbar() + CurCellCount = 0 + If Not IsNull(oStatusLine) Then + oStatusline.Start(sStsPROGRESS, 100) + Else + DialogModel.ProgressBar.ProgressValue = 0 + End If + StatusValue = 0 +End Sub + + +Sub EndStatusLine() + If Not IsNull(oStatusLine) Then + oStatusline.End + Else + DialogModel.ProgressBar.ProgressValue = 100 + End If +End Sub + diff --git a/wizards/source/euro/ConvertRun.xba b/wizards/source/euro/ConvertRun.xba new file mode 100644 index 000000000..e91d12e7a --- /dev/null +++ b/wizards/source/euro/ConvertRun.xba @@ -0,0 +1,334 @@ + + + +Option Explicit + +Public oPreSelRange as Object + +Sub Main() + BasicLibraries.LoadLibrary("Tools") + If InitResources("Euro Converter") Then + bDoUnProtect = False + bPreSelected = True + oDocument = ThisComponent + RetrieveDocumentObjects() ' Statusline, SheetsCollection etc. + InitializeConverter(oDocument.CharLocale, 1) + GetPreSelectedRange() + If GoOn Then + DialogModel.lstCurrencies.TabIndex = 2 + DialogConvert.GetControl("chkComplete").SetFocus() + DialogConvert.Execute + End If + DialogConvert.Dispose + End If +End Sub + + +Sub SelectListItem() +Dim Listbox as Object +Dim oListSheet as Object +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 i as Integer +Dim n as Integer +Dim m as Integer +Dim MaxIndex as Integer + Listbox = DialogModel.lstSelection + If Ubound(Listbox.SelectedItems()) > -1 Then + 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(Listbox.StringItemList(ListIndex)) + oDocument.CurrentController.SetActiveSheet(oCurSheet) + Else + oCurSheet = oDocument.CurrentController.ActiveSheet + End If + sCurSheetName = oCurSheet.Name + If DialogModel.optCellTemplates.State = 1 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 + ' Hard Formatation is selected + a = -1 + For n = 0 To Ubound(Listbox.SelectedItems()) + m = Listbox.SelectedItems(n) + RangeName = Listbox.StringItemList(m) + oListSheet = RetrieveSheetoutofRangeName(RangeName) + a = a + 1 + MaxIndex = Ubound(SelRangeList()) + If a > MaxIndex Then + Redim Preserve SelRangeList(MaxIndex + SBRANGEUBOUND) + End If + SelRangeList(a) = RangeName + If oListSheet.Name = sCurSheetName Then + oRange = RetrieveRangeoutofRangeName(RangeName) + oSelRanges.InsertbyName("",oRange) + End If + Next n + End If + If a > -1 Then + ReDim Preserve SelRangeList(a) + Else + ReDim SelRangeList() + End If + oDocument.CurrentController.Select(oSelRanges) + EnableStep1DialogControls(True, True, True) + End If +End Sub + + +' Procedure 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 bCurrIsSelected as Boolean +Dim bObjectIsSelected as Boolean +Dim bConvertWholeDoc as Boolean +Dim bDoEnableFrame as Boolean + bConvertWholeDoc = DialogModel.chkComplete.State = 1 + bDoEnableFrame = bFrameEnabled And (NOT bConvertWholeDoc) + + ' Controls around the Selection Listbox + With DialogModel + .lblCurrencies.Enabled = bCurrEnabled + .lstCurrencies.Enabled = bCurrEnabled + .lstSelection.Enabled = bDoEnableFrame + .lblSelection.Enabled = bDoEnableFrame + .hlnSelection.Enabled = bDoEnableFrame + .optCellTemplates.Enabled = bDoEnableFrame + .optSheetRanges.Enabled = bDoEnableFrame + .optDocRanges.Enabled = bDoEnableFrame + .optSelRange.Enabled = bDoEnableFrame + End With + ' The CheckBox has the Value '1' when the Controls in the Frame are disabled + If bButtonsEnabled Then + bCurrIsSelected = Ubound(DialogModel.lstCurrencies.SelectedItems()) <> -1 + ' Enable GoOnButton only when Currency is selected + DialogModel.cmdGoOn.Enabled = bCurrIsSelected + DialogModel.chkComplete.Enabled = bCurrIsSelected + If bDoEnableFrame AND DialogModel.cmdGoOn.Enabled Then + ' If FrameControls are enabled, check if Listbox is Empty + bObjectIsSelected = Ubound(DialogModel.lstSelection.SelectedItems()) <> -1 + DialogModel.cmdGoOn.Enabled = bObjectIsSelected + End If + Else + DialogModel.cmdGoOn.Enabled = False + DialogModel.chkComplete.Enabled = False + End If +End Sub + + +Sub ConvertRangesOrStylesOfDocument() +Dim i as Integer +Dim ItemName as String +Dim SelList() as String +Dim oSheetRanges as Object + + bDocHasProtectedSheets = CheckSheetProtection(oSheets) + If bDocHasProtectedSheets Then + bDocHasProtectedSheets = UnprotectSheetsWithPassWord(oSheets, bDoUnProtect) + DialogModel.cmdGoOn.Enabled = False + End If + If Not bDocHasProtectedSheets Then + EnableStep1DialogControls(False, False, False) + InitializeProgressBar() + If DialogModel.optSelRange.State = 1 Then + SelectListItem() + End If + SelList() = DialogConvert.GetControl("lstSelection").SelectedItems() + If DialogModel.optCellTemplates.State = 1 Then + ' Option 'Soft' Formatation is selected + AssignRangestoStyle(DialogModel.lstSelection.StringItemList(), SelList()) + ConverttheSoftWay(SelList(), True) + ElseIf DialogModel.optSelRange.State = 1 Then + oSheetRanges = oPreSelRange.CellFormatRanges.createEnumeration + While oSheetRanges.hasMoreElements + oRange = oSheetRanges.NextElement + If CheckFormatType(oRange) Then + ConvertCellCurrencies(oRange) + SwitchNumberFormat(oRange, oFormats, sEuroSign) + End If + Wend + Else + ConverttheHardWay(SelList(), False, True) + End If + oStatusline.End + EnableStep1DialogControls(True, False, True) + DialogModel.cmdGoOn.Enabled = True + oDocument.CurrentController.Select(oSelRanges) + End If +End Sub + + +Sub ConvertWholeDocument() +Dim s as Integer + DialogModel.cmdGoOn.Enabled = False + DialogModel.chkComplete.Enabled = False + GoOn = ConvertDocument() + EmptyListbox(DialogModel.lstSelection()) + EnableStep1DialogControls(True, True, True) +End Sub + + +' Everything previously selected will be deselected +Sub EmptySelection() +Dim RangeName as String +Dim i as Integer +Dim MaxIndex as Integer +Dim EmptySelRangeList() as String + + If Not IsNull(oSelRanges) Then + If oSelRanges.HasElements Then + EmptySelRangeList() = ArrayOutofString(oSelRanges.RangeAddressesasString, ";", MaxIndex) + For i = 0 To MaxIndex + oSelRanges.RemovebyName(EmptySelRangeList(i)) + Next i + End If + oDocument.CurrentController.Select(oSelRanges) + Else + oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + End If +End Sub + + +Function AddSelectedRangeToSelRangesEnum() as Object +Dim oLocRange as Object + osheet = oDocument.CurrentController.GetActiveSheet + oSelRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + ' Check if a Currency-Range has been selected + oLocRange = oDocument.CurrentController.Selection + bPreSelected = oLocRange.SupportsService("com.sun.star.sheet.SheetCellRange") + If bPreSelected Then + oSelRanges.InsertbyName("",oLocRange) + AddSelectedRangeToSelRangesEnum() = oLocRange + End If +End Function + + +Sub GetPreSelectedRange() +Dim i as Integer +Dim OldCurrSymbolList(2) as String +Dim OldCurrIndex as Integer +Dim OldCurExtension(2) as String + oPreSelRange = AddSelectedRangeToSelRangesEnum() + + DialogModel.chkComplete.State = Abs(Not(bPreSelected)) + If bPreSelected Then + DialogModel.optSelRange.State = 1 + AddRangeToListbox(oPreSelRange) + Else + DialogModel.optCellTemplates.State = 1 + CreateStyleEnumeration() + End If + EnableStep1DialogControls(True, bPreSelected, True) + DialogModel.optSelRange.Enabled = bPreSelected +End Sub + + +Sub AddRangeToListbox(oLocRange as Object) + EmptyListBox(DialogModel.lstSelection) + PreName = RetrieveRangeNamefromAddress(oLocRange) + AddSingleItemToListbox(DialogModel.lstSelection, Prename)', 0) + SelectListboxItem(DialogModel.lstCurrencies, CurrIndex) + TotCellCount = CountRangeCells(oLocRange) +End Sub + + +Sub CheckRangeSelection(Optional oEvent) + EmptySelection() + AddRangeToListbox(oPreSelRange) + oPreSelRange = AddSelectedRangeToSelRangesEnum() +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() + With DialogModel + .optCellTemplates.State = 0 + .optSheetRanges.State = 0 + .optDocRanges.State = 0 + .optSelRange.State = 0 + End With +End Sub + + + +Sub SetStatusLineText(sStsREPROTECT as String) + If Not IsNull(oStatusLine) Then + oStatusline.SetText(sStsREPROTECT) + End If +End Sub + diff --git a/wizards/source/euro/DlgConvert.xdl b/wizards/source/euro/DlgConvert.xdl new file mode 100644 index 000000000..ff3f523a7 --- /dev/null +++ b/wizards/source/euro/DlgConvert.xdl @@ -0,0 +1,94 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/wizards/source/euro/DlgPassword.xdl b/wizards/source/euro/DlgPassword.xdl new file mode 100644 index 000000000..20beac046 --- /dev/null +++ b/wizards/source/euro/DlgPassword.xdl @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + \ 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..467225dec --- /dev/null +++ b/wizards/source/euro/Hard.xba @@ -0,0 +1,246 @@ + + + +REM ***** BASIC ***** +Option Explicit + + +Sub CreateRangeList() +Dim MaxIndex as Integer + MaxIndex = -1 + EnableStep1DialogControls(False, False, False) + EmptySelection() + DialogModel.lblSelection.Label = sCURRRANGES + EmptyListbox(DialogModel.lstSelection) + oDocument.CurrentController.Select(oSelRanges) + If (DialogModel.optSheetRanges.State = 1) AND (DialogModel.chkComplete.State <> 1) Then + ' Conversion on a sheet? + SetStatusLineText(sStsRELRANGES) + osheet = oDocument.CurrentController.GetActiveSheet + oRanges = osheet.CellFormatRanges.createEnumeration() + MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, False) + If MaxIndex > -1 Then + ReDim Preserve RangeList(MaxIndex) + End If + Else + CreateRangeEnumeration(False) + bRangeListDefined = True + End If + EnableStep1DialogControls(True, True, True) + SetStatusLineText("") +End Sub + + +Sub CreateRangeEnumeration(bAutopilot as Boolean) +Dim i as Integer +Dim MaxIndex as integer +Dim sStatustext as String + MaxIndex = -1 + If Not bRangeListDefined Then + ' Cellranges are not yet defined + 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") + SetStatusLineText(sStatusText) + End If + oRanges = osheet.CellFormatRanges.createEnumeration + MaxIndex = AddSheetRanges(oRanges, MaxIndex, oSheet, bAutopilot) + Next i + Else + If Not bAutoPilot Then + SetStatusLineText(sStsRELRANGES) + ' cellranges already defined + For i = 0 To Ubound(RangeList()) + If RangeList(i) <> "" Then + AddSingleItemToListBox(DialogModel.lstSelection, RangeList(i)) + End If + Next + End If + End If + If MaxIndex > -1 Then + ReDim Preserve RangeList(MaxIndex) + Else + ReDim RangeList() + 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 +Dim MaxIndex as Integer + iCurStep = DialogModel.Step + While oRanges.hasMoreElements + oRange = oRanges.NextElement + AddToList = CheckFormatType(oRange) + If AddToList Then + RangeName = RetrieveRangeNamefromAddress(oRange) + 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 + ' Redimension the RangeList Array if necessary + MaxIndex = Ubound(RangeList()) + r = r + 1 + If r > MaxIndex Then + MaxIndex = MaxIndex + SBRANGEUBOUND + ReDim Preserve RangeList(MaxIndex) + End If + RangeList(r) = RangeName + End If + Wend + AddSheetRanges = r +End Function + + +' adds a section to the collection +Sub SelectRange() +Dim i as Integer +Dim RangeName as String +Dim SelItem as String +Dim CurRange as String +Dim SheetRangeName as String +Dim DescriptionList() as String +Dim MaxRangeIndex as Integer +Dim StatusValue as Integer + StatusValue = 0 + MaxRangeIndex = Ubound(SelRangeList()) + CurSheetName = oSheet.Name + For i = 0 To MaxRangeIndex + SelItem = SelRangeList(i) + ' Is the Range already included in the collection? + oRange = RetrieveRangeoutOfRangename(SelItem) + TotCellCount = TotCellCount + CountRangeCells(oRange) + DescriptionList() = ArrayOutofString(SelItem,".",1) + SheetRangeName = DeleteStr(DescriptionList(0),"'") + If SheetRangeName = CurSheetName Then + oSelRanges.InsertbyName("",oRange) + End If + IncreaseStatusValue(SBRELGET/MaxRangeIndex) + Next i +End Sub + + +Sub ConvertThehardWay(ListboxList(), SwitchFormat as Boolean, bRemove as Boolean) +Dim i as Integer +Dim AddCells as Long +Dim OldStatusValue as Single +Dim RangeName as String +Dim LastIndex as Integer +Dim oSelListbox as Object + + oSelListbox = DialogConvert.GetControl("lstSelection") + Lastindex = Ubound(ListboxList()) + If TotCellCount > 0 Then + OldStatusValue = StatusValue + ' hard format + For i = 0 To LastIndex + RangeName = ListboxList(i) + oRange = RetrieveRangeoutofRangeName(RangeName) + ConvertCellCurrencies(oRange) + If bRemove Then + 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 is hard formatted + SwitchNumberFormat(oRange, oFormats, sEuroSign) + End If + Else + SwitchNumberFormat(oRange, oFormats, sEuroSign) + End If + AddCells = CountRangeCells(oRange) + CurCellCount = AddCells + IncreaseStatusValue((CurCellCount/TotCellCount)*(100-OldStatusValue)) + If bRemove Then + RemoveListBoxItemByName(oSelListbox.Model,Rangename) + End If + Next + End If +End Sub + + +Sub ConvertCellCurrencies(oRange as Object) +Dim oValues as Object +Dim oCells as Object +Dim oCell as Object + oValues = oRange.queryContentCells(com.sun.star.sheet.CellFlags.VALUE) + If (oValues.Count > 0) Then + oCells = oValues.Cells.createEnumeration + While oCells.hasMoreElements + oCell = oCells.nextElement + ModifyObjectValuewithCurrFactor(oCell) + Wend + End If +End Sub + + +Sub ModifyObjectValuewithCurrFactor(oDocObject as Object) +Dim oDocObjectValue as double + oDocObjectValue = oDocObject.Value + oDocObject.Value = Round(oDocObjectValue/CurrFactor, 2) +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 + 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 \ 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..623a0a53b --- /dev/null +++ b/wizards/source/euro/Init.xba @@ -0,0 +1,667 @@ + + + +Option Explicit +REM ***** BASIC ***** + +Public Const SBRANGEUBOUND = 20 +Public StyleRangeAssignmentList(SBRANGEUBOUND)as String +Public SelRangeList(SBRANGEUBOUND) as String +Public RangeList(SBRANGEUBOUND) as String +Public UnprotectList() as String +Public FilterNames(2,1) as String +Public bDoUnProtect as Boolean +Public bCancelTask as Boolean + +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 sTARGETDIR as String + +Public sStsPROGRESS as String +Public sStsCELLPROGRSS as String +Public sStsRELRANGES as String +Public sStsRELSHEETRANGES as String +Public sStsREPROTECT 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 sMsgDOCISREADONLY as String +Public sMsgFileExists as String +Public sMsgCancelConversion as String +Public sMsgCancelTitle 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 sCurrGREEK as String +Public sCurrSLOVENIAN as String +Public sCurrCYPRIOT as String +Public sCurrMALTESE as String +Public sCurrSLOVAK as String +Public sCurrESTONIAN as String +Public sCurrLATVIAN as String +Public sCurrLITHUANIAN as String + +Public sPrgsRETRIEVAL as String +Public sPrgsCONVERTING as String +Public sPrgsUNPROTECT as String +Public sInclusiveSubDir as String + +Public Const SBCOUNTRYCOUNT = 19 +Public CurMimeType as String +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 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 CurSheetName as String +Public oStatusLine as Object +Public Const SBRELGET = 50 +Public StatusValue as Single +Public TotCellCount as Long +Public StyleIndex as Integer +Public RangeIndex as Integer +Public CurrIndex as Integer +Public ActLangNumber(1) as Integer +Public CurExtension(2) as String +Public Currfactor as Double +Public CurrSymbolList(2) as String +Public CurrLanguage as String +Public CurrValue(18,5) +Public LangIDValue(18,2,2) as String +Public PreName as String +Public Separator as String +Public BitmapDir as String +Public TypeIndex as Integer, CSIndex as Integer, LangIndex as Integer, FSIndex as Integer +Public oLocale as New com.sun.star.lang.Locale +Public sEuroSign as String +Public oPointer as Object +Public sDocType as String +Public bPreSelected as Boolean +Public bRecursive as Boolean +Public bCancelProtection as Boolean +Public CurrRoundMode as Boolean +Public bRangeListDefined as Boolean +Public bDocHasProtectedSheets as Boolean +Public sGOON as String +Public sHELP as String +Public sCANCEL as String +Dim sEnd as String + +Sub InitializeResources() +Dim LocWorkPath as String + With DialogModel + ' Strings that are also needed by the Password Dialog + sGoOn = GetResText("STEP_ZERO_3") + sHelp = GetResText("STEP_ZERO_1") + sCANCEL = GetResText("MESSAGES_18") + sEnd = GetResText("STEP_ZERO_0") + sPROTECT = GetResText("STEP_ZERO_5") + sCONTINUE = GetResText("STEP_ZERO_7") + sSELTEMPL = GetResText("STEP_CONVERTER_6") + sSELCELL = GetResText("STEP_CONVERTER_7") + sCURRRANGES = GetResText("STEP_CONVERTER_8") + sTEMPLATES = GetResText("STEP_CONVERTER_9") + sStsPROGRESS = GetResText("STATUSLINE_0") + sStsCELLPROGRSS = GetResText("STATUSLINE_1") + sStsRELSHEETRANGES = GetResText("STATUSLINE_2") + sStsRELRANGES = GetResText("STATUSLINE_3") + sStsREPROTECT = GetResText("STATUSLINE_4") + sREADY = GetResText("MESSAGES_0") + sMsgSELDIR = GetResText("MESSAGES_1") + sMsgSELFILE = GetResText("MESSAGES_2") + sMsgTARGETDIR = GetResText("MESSAGES_3") + sMsgNOTTHERE = GetResText("MESSAGES_4") + sMsgDLGTITLE = GetResText("MESSAGES_5") + sMsgUNPROTECT = GetResText("MESSAGES_6") + sMsgPWPROTECT = GetResText("MESSAGES_7") + sMsgWRONGPW = GetResText("MESSAGES_8") + sMsgSHEETPROTECTED = GetResText("MESSAGES_9") + sMsgWARNING = GetResText("MESSAGES_10") + sMsgSHEETSNOPROTECT = GetResText("MESSAGES_11") + sMsgSHEETNOPROTECT = GetResText("MESSAGES_12") + sMsgCHOOSECURRENCY = GetResText("MESSAGES_15") + sMsgPASSWORD = GetResText("MESSAGES_16") + sMsgOK = GetResText("MESSAGES_17") + sMsgCANCEL = GetResText("MESSAGES_18") + sMsgFILEINVALID = GetResText("MESSAGES_19") + sMsgFILEINVALID = ReplaceString(sMsgFILEINVALID,"%PRODUCTNAME", GetProductname()) + SMsgNODIRECTORY = GetResText("MESSAGES_20") + sMsgDOCISREADONLY = GetResText("MESSAGES_21") + sMsgFileExists = GetResText("MESSAGES_22") + sMsgCancelConversion = GetResText("MESSAGES_23") + sMsgCancelTitle = GetResText("MESSAGES_24") + sCurrPORTUGUESE = GetResText("CURRENCIES_0") + sCurrDUTCH = GetResText("CURRENCIES_1") + sCurrFRENCH = GetResText("CURRENCIES_2") + sCurrSPANISH = GetResText("CURRENCIES_3") + sCurrITALIAN = GetResText("CURRENCIES_4") + sCurrGERMAN = GetResText("CURRENCIES_5") + sCurrBELGIAN = GetResText("CURRENCIES_6") + sCurrIRISH = GetResText("CURRENCIES_7") + sCurrLUXEMBOURG = GetResText("CURRENCIES_8") + sCurrAUSTRIAN = GetResText("CURRENCIES_9") + sCurrFINNISH = GetResText("CURRENCIES_10") + sCurrGREEK = GetResText("CURRENCIES_11") + sCurrSLOVENIAN = GetResText("CURRENCIES_12") + sCurrCYPRIOT = GetResText("CURRENCIES_13") + sCurrMALTESE = GetResText("CURRENCIES_14") + sCurrSLOVAK = GetResText("CURRENCIES_15") + sCurrESTONIAN = GetResText("CURRENCIES_16") + sCurrLATVIAN = GetResText("CURRENCIES_17") + sCurrLITHUANIAN = GetResText("CURRENCIES_18") + .cmdCancel.Label = sCANCEL + .cmdHelp.Label = sHELP + .cmdBack.Label = GetResText("STEP_ZERO_2") + .cmdGoOn.Label = sGOON + .lblHint.Label = GetResText("STEP_ZERO_4") + .lblCurrencies.Label = GetResText("STEP_ZERO_6") + .cmdBack.Enabled = False + If .Step = 1 Then + .chkComplete.Label = GetResText("STEP_CONVERTER_0") + .hlnSelection.Label = GetResText("STEP_CONVERTER_1") + .optCellTemplates.Label = GetResText("STEP_CONVERTER_2") + .optSheetRanges.Label = GetResText("STEP_CONVERTER_3") + .optDocRanges.Label = GetResText("STEP_CONVERTER_4") + .optSelRange.Label = GetResText("STEP_CONVERTER_5") + sCURRRANGES = GetResText("STEP_CONVERTER_8") + .lblSelection.Label = sCURRRANGES + Else + .lblProgress.Label = sStsPROGRESS + .hlnExtent.Label = GetResText("STEP_AUTOPILOT_0") + .optSingleFile.Label = GetResText("STEP_AUTOPILOT_1") + .optWholeDir.Label = GetResText("STEP_AUTOPILOT_2") + .chkProtect.Label = GetResText("STEP_AUTOPILOT_7") + .chkTextDocuments.Label = GetResText("STEP_AUTOPILOT_10") + + sSOURCEFILE = GetResText("STEP_AUTOPILOT_3") + sSOURCEDIR = GetResText("STEP_AUTOPILOT_4") + .lblSource.Label = sSOURCEDIR + sInclusiveSubDir = GetResText("STEP_AUTOPILOT_5") + .chkRecursive.Label = sInclusiveSubDir + sTARGETDIR = GetResText("STEP_AUTOPILOT_6") + .lblTarget.Label = STARGETDIR + + LocWorkPath = GetPathSettings("Work") + If Not oUcb.Exists(LocWorkPath) Then + ShowNoOfficePathError() + Stop + End If + + .txtSource.Text = ConvertfromUrl(LocWorkPath) + + SubstDir = .txtSource.Text + .txtTarget.Text = .txtSource.Text + .hlnProgress.Label = GetResText("STEP_LASTPAGE_0") + .lblConfig.Label = GetResText("STEP_LASTPAGE_3") + sPrgsRETRIEVAL = GetResText("STEP_LASTPAGE_1") + sPrgsCONVERTING = GetResText("STEP_LASTPAGE_2") + sPrgsUNPROTECT = GetResText("STEP_LASTPAGE_4") + End If + End With +End Sub + +Sub InitializeLanguages() + sEuroSign = chr(8364) + +' CURRENCIES_PORTUGUESE + LangIDValue(0,0,0) = "pt" + LangIDValue(0,0,1) = "" + LangIDValue(0,0,2) = "-816" + +' CURRENCIES_DUTCH + LangIDValue(1,0,0) = "nl" + LangIDValue(1,0,1) = "" + LangIDValue(1,0,2) = "-413" + +' CURRENCIES_FRENCH + LangIDValue(2,0,0) = "fr" + LangIDValue(2,0,1) = "" + LangIDValue(2,0,2) = "-40C" + +' CURRENCIES_SPANISH + LangIDValue(3,0,0) = "es" + LangIDValue(3,0,1) = "" + LangIDValue(3,0,2) = "-40A" + + 'Spanish modern + LangIDValue(3,1,0) = "es" + LangIDValue(3,1,1) = "" + LangIDValue(3,1,2) = "-C0A" + + 'Spanish katalanic + LangIDValue(3,2,0) = "es" + LangIDValue(3,2,1) = "" + LangIDValue(3,2,2) = "-403" + +' CURRENCIES_ITALIAN + LangIDValue(4,0,0) = "it" + LangIDValue(4,0,1) = "" + 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" + + LangIDValue(7,1,0) = "ga" + LangIDValue(7,1,1) = "IE" + LangIDValue(7,1,2) = "-83C" + +' 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,2) = "-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" + +' CURRENCIES_GREEK + LangIDValue(11,0,0) = "el" + LangIDValue(11,0,1) = "GR" + LangIDValue(11,0,2) = "-408" + +' CURRENCIES_SLOVENIAN + LangIDValue(12,0,0) = "sl" + LangIDValue(12,0,1) = "SI" + LangIDValue(12,0,2) = "-424" + +' CURRENCIES_CYPRIOT + LangIDValue(13,0,0) = "el" + LangIDValue(13,0,1) = "CY" + LangIDValue(13,0,2) = "-408" + +' CURRENCIES_MALTESE + LangIDValue(14,0,0) = "mt" + LangIDValue(14,0,1) = "MT" + LangIDValue(14,0,2) = "-43A" + +' CURRENCIES_SLOVAK + LangIDValue(15,0,0) = "sk" + LangIDValue(15,0,1) = "SK" + LangIDValue(15,0,2) = "-41B" + +' CURRENCIES_ESTONIAN + LangIDValue(16,0,0) = "et" + LangIDValue(16,0,1) = "ET" + LangIDValue(16,0,2) = "-425" + +' CURRENCIES_LATVIAN + LangIDValue(17,0,0) = "lv" + LangIDValue(17,0,1) = "LV" + LangIDValue(17,0,2) = "-426" + ' and Latgalian + LangIDValue(17,1,0) = "ltg" + LangIDValue(17,1,1) = "LV" + LangIDValue(17,1,2) = "-64B" + +' CURRENCIES_LITHUANIAN + LangIDValue(18,0,0) = "lt" + LangIDValue(18,0,1) = "LT" + LangIDValue(18,0,2) = "-427" + +End Sub + + + +Sub InitializeCurrencies() +Dim i as Integer + GoOn = True + + CurrValue(0,0) = sCurrPORTUGUESE + ' real conversion rate + CurrValue(0,1) = 200.482 + ' rounded conversion rate + CurrValue(0,2) = 200 + CurrValue(0,3) = "Esc." + CurrValue(0,4) = "Esc." + CurrValue(0,5) = "PTE" + + CurrValue(1,0) = sCurrDUTCH + ' real conversion rate + CurrValue(1,1) = 2.20371 + ' rounded conversion rate + CurrValue(1,2) = 2 + CurrValue(1,3) = "F" + CurrValue(1,4) = "fl" + CurrValue(1,5) = "NLG" + + CurrValue(2,0) = sCurrFRENCH + ' real conversion rate + CurrValue(2,1) = 6.55957 + ' rounded conversion rate + CurrValue(2,2) = 7 + CurrValue(2,3) = "F" + CurrValue(2,4) = "F" + CurrValue(2,5) = "FRF" + + CurrValue(3,0) = sCurrSPANISH + ' real conversion rate + CurrValue(3,1) = 166.386 + ' rounded conversion rate + CurrValue(3,2) = 170 + CurrValue(3,3) = "Pts" + CurrValue(3,4) = "Pts" + CurrValue(3,5) = "ESP" + + CurrValue(4,0) = sCurrITALIAN + ' real conversion rate + CurrValue(4,1) = 1936.27 + ' rounded conversion rate + CurrValue(4,2) = 2000 + CurrValue(4,3) = "L." + CurrValue(4,4) = "L." + CurrValue(4,5) = "ITL" + + CurrValue(5,0) = sCurrGERMAN + ' real conversion rate + CurrValue(5,1) = 1.95583 + ' rounded conversion rate + CurrValue(5,2) = 2 + CurrValue(5,3) = "DM" + CurrValue(5,4) = "DM" + CurrValue(5,5) = "DEM" + + CurrValue(6,0) = sCurrBELGIAN + ' real conversion rate + CurrValue(6,1) = 40.3399 + ' rounded conversion rate + CurrValue(6,2) = 40 + CurrValue(6,3) = "FB" + CurrValue(6,4) = "BF" + CurrValue(6,5) = "BEF" + + CurrValue(7,0) = sCurrIRISH + ' real conversion rate + CurrValue(7,1) = 0.787564 + ' rounded conversion rate + CurrValue(7,2) = 0.8 + CurrValue(7,3) = "IR£" + CurrValue(7,4) = "£" + CurrValue(7,5) = "IEP" + + CurrValue(8,0) = sCurrLUXEMBOURG + ' real conversion rate + CurrValue(8,1) = 40.3399 + ' rounded conversion rate + CurrValue(8,2) = 40 + CurrValue(8,3) = "F" + CurrValue(8,4) = "F" + CurrValue(8,5) = "LUF" + + CurrValue(9,0) = sCurrAUSTRIAN + ' real conversion rate + CurrValue(9,1) = 13.7603 + ' rounded conversion rate + CurrValue(9,2) = 15 + CurrValue(9,3) = "öS" + CurrValue(9,4) = "S" + CurrValue(9,5) = "ATS" + + CurrValue(10,0) = sCurrFINNISH + ' real conversion rate + CurrValue(10,1) = 5.94573 + ' rounded conversion rate + CurrValue(10,2) = 6 + CurrValue(10,3) = "mk" + CurrValue(10,4) = "mk" + CurrValue(10,5) = "FIM" + + CurrValue(11,0) = sCurrGREEK + ' real conversion rate + CurrValue(11,1) = 340.750 + ' rounded conversion rate + CurrValue(11,2) = 400 + CurrValue(11,3) = chr(916) & chr(961) & chr(967) + CurrValue(11,4) = chr(916) & chr(961) & chr(967) + CurrValue(11,5) = "GRD" + + CurrValue(12,0) = sCurrSLOVENIAN + ' real conversion rate + CurrValue(12,1) = 239.64 + ' rounded conversion rate + CurrValue(12,2) = 240 + CurrValue(12,3) = "SIT" + CurrValue(12,4) = "SIT" + CurrValue(12,5) = "SIT" + + CurrValue(13,0) = sCurrCYPRIOT + ' real conversion rate + CurrValue(13,1) = 0.585274 + ' rounded conversion rate + CurrValue(13,2) = 0.6 + CurrValue(13,3) = "£C" + CurrValue(13,4) = "£" + CurrValue(13,5) = "CYP" + + CurrValue(14,0) = sCurrMALTESE + ' real conversion rate + CurrValue(14,1) = 0.429300 + ' rounded conversion rate + CurrValue(14,2) = 0.4 + CurrValue(14,3) = chr(8356) + CurrValue(14,4) = "Lm" + CurrValue(14,5) = "MTL" + + CurrValue(15,0) = sCurrSLOVAK + ' real conversion rate + CurrValue(15,1) = 30.1260 + ' rounded conversion rate + CurrValue(15,2) = 30 + CurrValue(15,3) = "Sk" + CurrValue(15,4) = "Sk" + CurrValue(15,5) = "SKK" + + CurrValue(16,0) = sCurrESTONIAN + ' real conversion rate + CurrValue(16,1) = 15.6466 + ' rounded conversion rate + CurrValue(16,2) = 16 + CurrValue(16,3) = "kr" + CurrValue(16,4) = "kr" + CurrValue(16,5) = "EEK" + + CurrValue(17,0) = sCurrLATVIAN + ' real conversion rate + CurrValue(17,1) = 0.702804 + ' rounded conversion rate + CurrValue(17,2) = 0.7 + CurrValue(17,3) = "Ls" + CurrValue(17,4) = "Ls" + CurrValue(17,5) = "LVL" + + CurrValue(18,0) = sCurrLITHUANIAN + ' real conversion rate + CurrValue(18,1) = 3.45280 + ' rounded conversion rate + CurrValue(18,2) = 3.5 + CurrValue(18,3) = "Lt" + CurrValue(18,4) = "Lt" + CurrValue(18,5) = "LTL" + + i = -1 + CurrSymbolList(0) = "" + CurrSymbolList(1) = "" + InitializeCurrencyValues(CurrIndex) +End Sub + + +Sub InitializeControls() + If CurrIndex = -1 Then + 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 + bCancelProtection = False + bRangeListDefined = False + PWIndex = -1 + If iDialogPage = 1 Then + ToggleWindow(False) + sDocType = Tools.GetDocumentType(ThisComponent) + If sDocType = "sCalc" Then + bDocHasProtectedSheets = CheckSheetProtection(oSheets) + End If + oStatusline = ThisComponent.GetCurrentController.GetFrame.CreateStatusIndicator() + End If + DialogConvert = LoadDialog("Euro", "DlgConvert") + DialogModel = DialogConvert.Model + DialogPassword = LoadDialog("Euro", "DlgPassword") + PasswordModel = DialogPassword.Model + DialogModel.Step = iDialogPage + InitializeResources() + InitializeLanguages() + InitializeLocales(oLocale) + InitializeCurrencies() + InitializeControls() + BitmapDir = GetOfficeSubPath("Template", "../wizard/bitmap") + If BitmapDir = "" Then + Stop + End If + FillUpCurrencyListbox() + DialogModel.imgPreview.ImageUrl = BitmapDir & "euro_" & DialogModel.Step & ".png" + DialogConvert.Title = sMsgDLGTITLE + DialogModel.cmdGoOn.DefaultButton = True + If iDialogPage = 1 Then + ToggleWindow(True) + End If +End Sub + + +Sub InitializeCurrencyValues(CurrIndex) + If CurrIndex <> -1 Then + CurrLanguage = CurrValue(CurrIndex,0) + CurrFactor = 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 +Dim bTakeThisLocale as Boolean + sLanguage = oLocale.Language + sCountry = oLocale.Country + For n = 0 To SBCOUNTRYCOUNT - 1 + For m = 0 TO 1 + If DialogModel.Step = 2 Then + bTakeThisLocale = LangIDValue(n,m,0) = sLanguage + Else + bTakeThisLocale = LangIDValue(n,m,0) = sLanguage + End If + If bTakeThisLocale Then + CurrIndex = n + For i = 0 To 2 + CurExtension(i) = LangIDValue(CurrIndex,i,2) + Next i + InitializeLocales = True + Exit Function + End If + Next m + Next n + CurrIndex = -1 + InitializeLocales = False +End Function + diff --git a/wizards/source/euro/Protect.xba b/wizards/source/euro/Protect.xba new file mode 100644 index 000000000..4a9cac577 --- /dev/null +++ b/wizards/source/euro/Protect.xba @@ -0,0 +1,192 @@ + + + +REM ***** BASIC ***** +Option Explicit + +Public PWIndex as Integer + + +Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean) +Dim i as Integer +Dim MaxIndex as Integer +Dim iMsgResult as Integer + PWIndex = -1 + If bDocHasProtectedSheets Then + If Not bDoUnprotect Then + ' At First query if sheets shall generally be unprotected + iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE) + bDoUnProtect = iMsgResult = 6 + End If + If bDoUnProtect Then + MaxIndex = oSheets.Count-1 + For i = 0 To MaxIndex + bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i)) + If bDocHasProtectedSheets Then + ReprotectSheets() + Exit For + End If + Next i + If PWIndex = -1 Then + ReDim UnProtectList() as String + Else + ReDim Preserve UnProtectList(PWIndex) as String + End If + Else + Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) + End If + End If + UnProtectSheetsWithPassword = bDocHasProtectedSheets +End Function + + +Function UnprotectSheet(oListSheet as Object) +Dim ListSheetName as String +Dim sStatustext as String +Dim i as Integer +Dim bOneSheetIsUnprotected as Boolean + i = -1 + ListSheetName = oListSheet.Name + If oListSheet.IsProtected Then + oListSheet.Unprotect("") + If oListSheet.IsProtected Then + ' Sheet is protected by a Password + bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName) + UnProtectSheet() = bOneSheetIsUnProtected + Else + ' The Sheet could be unprotected without a password + AddSheettoUnprotectionlist(ListSheetName,"") + UnprotectSheet() = True + End If + Else + UnprotectSheet() = True + End If +End Function + + +Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean +Dim PWIsCorrect as Boolean +Dim QueryText as String + oDocument.CurrentController.SetActiveSheet(oListSheet) + QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1") + '"Please insert the password to unprotect the sheet '" & ListSheetName'" + Do + ExecutePasswordDialog(QueryText) + If bCancelProtection Then + bCancelProtection = False + Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) + UnprotectSheetWithDialog() = False + 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 + UnprotectSheetWithDialog() = True +End Function + + +Sub ExecutePasswordDialog(QueryText as String) + With PasswordModel + .Title = QueryText + .hlnPassword.Label = sMsgPASSWORD + .cmdCancel.Label = sMsgCANCEL + .cmdHelp.Label = sHELP + .cmdGoOn.Label = sMsgOK + .cmdGoOn.DefaultButton = True + End With + DialogPassword.Execute +End Sub + +Sub ReadPassword() + Password = PasswordModel.txtPassword.Text + DialogPassword.EndExecute +End Sub + + +Sub RejectPassword() + bCancelProtection = True + DialogPassword.EndExecute +End Sub + + +' Reprotects the previously protected sheets +' The password information is stored in the List 'UnProtectList()' +Sub ReprotectSheets() +Dim i as Integer +Dim oProtectSheet as Object +Dim ProtectList() as String +Dim SheetName as String +Dim SheetPassword as String + If PWIndex > -1 Then + SetStatusLineText(sStsREPROTECT) + For i = 0 To PWIndex + ProtectList() = ArrayOutOfString(UnProtectList(i),";") + SheetName = ProtectList(0) + If Ubound(ProtectList()) > 0 Then + SheetPassWord = ProtectList(1) + Else + SheetPassword = "" + End If + oProtectSheet = oSheets.GetbyName(SheetName) + If Not oProtectSheet.IsProtected Then + oProtectSheet.Protect(SheetPassWord) + End If + Next i + SetStatusLineText("") + End If + PWIndex = -1 + ReDim UnProtectList() +End Sub + + +' Add a Sheet to the list of sheets that finally have to be +' unprotected +Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String) +Dim MaxIndex as Integer + MaxIndex = Ubound(UnProtectList()) + PWIndex = PWIndex + 1 + If PWIndex > MaxIndex Then + ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND) + End If + UnprotectList(PWIndex) = ListSheetName & ";" & Password +End Sub + + +Function CheckSheetProtection(oSheets as Object) as Boolean +Dim MaxIndex as Integer +Dim i as Integer +Dim bProtectedSheets as Boolean + bProtectedSheets = False + MaxIndex = oSheets.Count-1 + For i = 0 To MaxIndex + bProtectedSheets = oSheets(i).IsProtected + If bProtectedSheets Then + CheckSheetProtection() = True + Exit Function + End If + Next i + CheckSheetProtection() = False +End Function diff --git a/wizards/source/euro/Soft.xba b/wizards/source/euro/Soft.xba new file mode 100644 index 000000000..eed7bd030 --- /dev/null +++ b/wizards/source/euro/Soft.xba @@ -0,0 +1,256 @@ + + + +Option Explicit +REM ***** BASIC ***** + + +Sub CreateStyleEnumeration() + EmptySelection() + EmptyListbox(DialogModel.lstSelection) + CurSheetName = oDocument.CurrentController.GetActiveSheet.Name + MakeStyleEnumeration(False) + DialogModel.lblSelection.Label = sTEMPLATES +End Sub + + +Sub MakeStyleEnumeration(bAddToListbox as Boolean) +Dim m as integer +Dim aStyleFormat as Object +Dim Stylename as String + StyleIndex = -1 + oStyles = oDocument.StyleFamilies.GetbyIndex(0) + For m = 0 To oStyles.count-1 + oStyle = oStyles.GetbyIndex(m) + StyleName = oStyle.Name + If CheckFormatType(oStyle) Then + If Not bAddToListBox Then + AddSingleItemToListbox(DialogModel.lstSelection, Stylename) + Else + SwitchNumberFormat(ostyle, oFormats, sEuroSign) + End If + StyleIndex = StyleIndex + 1 + If StyleIndex > Ubound(StyleRangeAssignMentList()) Then + Redim Preserve StyleRangeAssignmentList(StyleIndex) + End If + StyleRangeAssignmentList(StyleIndex) = "<STYLENAME>" & Stylename & "</STYLENAME>" & _ + "<DEFINED>FALSE</DEFINED>" & "<RANGES></RANGES>" &_ + "<CELLCOUNT>0</CELLCOUNT>" &_ + "<SELECTED>FALSE</SELECTED>" + End If + Next m + If StyleIndex > -1 Then + Redim Preserve StyleRangeAssignmentList(StyleIndex) + Else + ReDim StyleRangeAssignmentList() + End If +End Sub + + +Sub AssignRangestoStyle(StyleList(), SelList()) +Dim i as Integer +Dim n as integer +Dim LastIndex as Integer +Dim CurStyleName as String +Dim AssignString as String + LastIndex = Ubound(StyleList()) + StatusValue = 0 + SetStatusLineText(sStsRELRANGES) + For i = 0 To LastIndex + CurStyleName = StyleList(i) + n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) + AssignString = StyleRangeAssignmentlist(n) + If IndexInArray(CurStyleName, SelList()) <> -1 Then + ' Style is selected + If FindPartString(AssignString, "<DEFINED>", "</DEFINED>", 1) = "FALSE" Then + AssignString = ReplaceString(AssignString, "<SELECTED>TRUE</SELECTED>", "<SELECTED>FALSE</SELECTED>") + AssignCellFormatRanges(n, AssignString, CurStyleName) + End If + Else + ' Style is not selected + If FindPartString(AssignString, "<SELECTED>", "</SELECTED>", 1) = "FALSE" Then + DeselectStyle(CurStyleName, n) + End If + End If + IncreaseStatusvalue(SBRELGET/(LastIndex+1)) + Next i +End Sub + + +Sub AssignCellFormatRanges(n as Integer, AssignString as String, CurStyleName as String) +Dim oRanges() as Object +Dim oRange as Object +Dim oRangeAddress +Dim oSheet as Object +Dim StyleCellCount as Long +Dim i as Integer +Dim MaxIndex as Integer +Dim RangeString as String +Dim SheetName as String +Dim RangeName as String +Dim CellCountString as String + StyleCellCount = 0 + RangeString = "<RANGES>" + MaxIndex = oSheets.Count-1 + For i = 0 To MaxIndex + oSheet = oSheets(i) + SheetName = oSheet.Name + 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(oRange) + RangeString = RangeString & RangeName & "," + StyleCellCount = StyleCellCount + CountRangeCells(oRange) + End If + End If + Wend + Next i + If StyleCellCount > 0 Then + TotCellCount = TotCellCount + StyleCellCount + RangeString = RTrimStr(RangeString,",") + RangeString = RangeString & "</RANGES>" + CellCountString = "<CELLCOUNT>" & StyleCellCount & "</CELLCOUNT" + AssignString = ReplaceString(AssignString, RangeString,"<RANGES></RANGES>") + AssignString = ReplaceString(AssignString, CellCountString,"<CELLCOUNT>0</CELLCOUNT>") + End If + AssignString = ReplaceString(AssignString, "<DEFINED>TRUE</DEFINED>", "<DEFINED>FALSE</DEFINED>") + StyleRangeAssignmentList(n) = AssignString +End Sub + + +' deletes a styletemplate from the Collection that selects the ranges +Sub DeselectStyle(DeSelStyleName as String, n as Integer) +Dim i as Integer +Dim RangeName as String +Dim SelectString as String +Dim AssignString as String +Dim StyleRangeList() as String +Dim MaxIndex as Integer + SelectString ="<SELECTED>FALSE</SELECTED>" + AssignString = StyleRangeAssignmentList(n) + RangeString = FindPartString(AssignString,"<RANGES>","</RANGES>",1) + StyleRangeList() = ArrayoutofString(RangeString,",") + MaxIndex = Ubound(StyleRangeList()) + For i = 0 To MaxIndex + RangeName = StyleRangeList(i) + If oSelRanges.HasbyName(RangeName) Then + oSelRanges.RemovebyName(RangeName) + End If + Next i + AssignString = ReplaceString(AssignString, "<SELECTED>FALSE</SELECTED>", "<SELECTED>TRUE</SELECTED>") + StyleRangeAssignmentList(n) = AssignString +End Sub + + +Function RetrieveRangeNamefromAddress(oRange as Object) as String +Dim Rangename as String +Dim oAddressRanges as Object + oAddressRanges = oDocument.createInstance("com.sun.star.sheet.SheetCellRanges") + oAddressRanges.InsertbyName("",oRange) + Rangename = oAddressRanges.RangeAddressesasString +' Msgbox "Adresse: " & oRangeAddress.StartColumn & " ; " & oRangeAddress.EndColumn & " ; " & oRangeAddress.StartRow & " ; " & oRangeAddress.EndRow & chr(13) & RangeName +' oAddressRanges.RemovebyName(RangeName) + RetrieveRangeNamefromAddress = Rangename +End Function + + +' creates a sheet object from an according sectionname +Function RetrieveSheetoutofRangeName(TableText as String) +Dim DescriptionList() as String +Dim SheetName as String +Dim MaxIndex as integer + ' find out in which sheet the range is + DescriptionList() = ArrayOutofString(TableText,".",MaxIndex) + SheetName = DescriptionList(0) + SheetName = DeleteStr(SheetName,"'") + ' set the viewcursor on this sheet + RetrieveSheetoutofRangeName = oSheets.GetbyName(SheetName) +End Function + + +' creates a rangeobject from an according rangename +Function RetrieveRangeoutofRangeName(TableText as String) + oSheet = RetrieveSheetoutofRangeName(TableText) + oRange = oSheet.GetCellRangebyName(TableText) + RetrieveRangeoutofRangeName = oRange +End Function + + +Sub ConvertTheSoftWay(StyleList(), bDeSelect as Boolean) +Dim i as Integer +Dim l as Integer +Dim s as Integer +Dim n as Integer +Dim CurStyleName as String +Dim RangeName as String +Dim OldStatusValue as Integer +Dim LastIndex as Integer +Dim oSelListbox as Object +Dim StyleRangeList() as String +Dim MaxIndex as Integer + oSelListbox = DialogConvert.GetControl("lstSelection") + LastIndex = Ubound(StyleList()) + OldStatusValue = StatusValue + For i = 0 To LastIndex + CurStyleName = StyleList(i) + oStyle = oStyles.GetbyName(CurStyleName) + StyleRangeList() = GetAssignedRanges(CurStyleName, n) + MaxIndex = Ubound(StyleRangeList()) + For s = 0 To MaxIndex + RangeName = StyleRangeList(s) + oRange = RetrieveRangeoutofRangeName(RangeName) + If oRange.getPropertyState("NumberFormat") = 1 Then + ' Range is hard formatted + ConvertCellCurrencies(oRange) + CurCellCount = CountRangeCells(oRange) + End If + IncreaseStatusvalue((CurCellCount/TotCellCount)*(95-OldStatusValue)) + If bDeSelect Then + ' Note: On Problems see Bug #73157 + If oSelRanges.HasbyName(RangeName) Then + oSelRanges.RemovebyName(RangeName) + oDocument.CurrentController.Select(oSelRanges) + End If + End If + Next s + SwitchNumberFormat(ostyle, oFormats, sEuroSign) + StyleRangeAssignmentList(n) = "" + l = GetItemPos(oSelListBox.Model, CurStyleName) + oSelListbox.RemoveItems(l,1) + Next +End Sub + + +Function GetAssignedRanges(CurStyleName as String, n as Integer) +Dim StyleRangeList() as String +Dim RangeString as String +Dim AssignString as String + n = PartStringInArray(StyleRangeAssignmentList(), CurStyleName, 0) + If n <> -1 Then + AssignString = StyleRangeAssignmentList(n) + RangeString = FindPartString(AssignString,"<RANGES>", "</RANGES>",1) + If RangeString <> "" Then + StyleRangeList() = ArrayoutofString(RangeString,",") + End If + End If + GetAssignedRanges() = StyleRangeList() +End Function \ No newline at end of file diff --git a/wizards/source/euro/Writer.xba b/wizards/source/euro/Writer.xba new file mode 100644 index 000000000..bf89135bc --- /dev/null +++ b/wizards/source/euro/Writer.xba @@ -0,0 +1,89 @@ + + + +REM ***** BASIC ***** + + +Sub ConvertWriterTables() +Dim CellString as String +Dim oParagraphs as Object +Dim oPara as Object +Dim i as integer +Dim sCellNames() +Dim oCell as Object + oParagraphs = oDocument.Text.CreateEnumeration + While oParagraphs.HasMoreElements + oPara = oParagraphs.NextElement + If NOT oPara.supportsService("com.sun.star.text.Paragraph") Then + ' Note: As cells might be split or merged + ' you cannot refer to them via their indices + sCellNames = oPara.CellNames + For i = 0 To Ubound(sCellNames) + If sCellNames(i) <> "" Then + oCell = oPara.getCellByName(sCellNames(i)) + If CheckFormatType(oCell) Then + SwitchNumberFormat(oCell, oFormats, sEuroSign) + ModifyObjectValuewithCurrFactor(oCell) + End If + End If + Next + End If + Wend +End Sub + + +Sub ModifyObjectValuewithCurrFactor(oDocObject as Object) + oDocObjectValue = oDocObject.Value + oDocObject.Value = oDocObjectValue/CurrFactor +End Sub + + +Sub ConvertTextFields() +Dim oTextFields as Object +Dim oTextField as Object +Dim FieldValue +Dim oDocObjectValue as double +Dim InstanceNames(500) as String +Dim CurInstanceName as String +Dim MaxIndex as Integer + MaxIndex = 0 + oTextfields = oDocument.getTextfields.CreateEnumeration + While oTextFields.hasmoreElements + oTextField = oTextFields.NextElement + If oTextField.PropertySetInfo.HasPropertybyName("NumberFormat") Then + If CheckFormatType(oTextField) Then + If oTextField.PropertySetInfo.HasPropertybyName("Value") Then + If Not oTextField.SupportsService("com.sun.star.text.TextField.GetExpression") Then + oTextField.Content = CStr(Round(oTextField.Value/CurrFactor,2)) + End If + ElseIf oTextField.TextFieldMaster.PropertySetInfo.HasPropertyByName("Value") Then + CurInstanceName = oTextField.TextFieldMaster.InstanceName + If Not FieldInArray(InstanceNames(), MaxIndex, CurInstanceName) Then + oTextField.TextFieldMaster.Content = CStr(Round(oTextField.TextFieldMaster.Value/CurrFactor,2)) + InstanceNames(MaxIndex) = CurInstanceName + MaxIndex = MaxIndex + 1 + End If + End If + SwitchNumberFormat(oTextField, oFormats, sEuroSign) + End If + End If + Wend + oDocument.GetTextFields.refresh() +End Sub + \ No newline at end of file diff --git a/wizards/source/euro/dialog.xlb b/wizards/source/euro/dialog.xlb new file mode 100644 index 000000000..c461ce54f --- /dev/null +++ b/wizards/source/euro/dialog.xlb @@ -0,0 +1,6 @@ + + + + + + diff --git a/wizards/source/euro/script.xlb b/wizards/source/euro/script.xlb new file mode 100644 index 000000000..1bc4927c2 --- /dev/null +++ b/wizards/source/euro/script.xlb @@ -0,0 +1,12 @@ + + + + + + + + + + + + -- cgit v1.2.3