file-online-preview/office-plugin/windows-office/share/basic/Euro/ConvertRun.xba

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--***********************************************************
 * 
 * Licensed to the Apache Software Foundation (ASF) under one
 * or more contributor license agreements.  See the NOTICE file
 * distributed with this work for additional information
 * regarding copyright ownership.  The ASF licenses this file
 * to you under the Apache License, Version 2.0 (the
 * "License"); you may not use this file except in compliance
 * with the License.  You may obtain a copy of the License at
 * 
 *   http://www.apache.org/licenses/LICENSE-2.0
 * 
 * Unless required by applicable law or agreed to in writing,
 * software distributed under the License is distributed on an
 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
 * KIND, either express or implied.  See the License for the
 * specific language governing permissions and limitations
 * under the License.
 * 
 ***********************************************************-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ConvertRun" script:language="StarBasic">Option Explicit

Public oPreSelRange as Object

Sub Main()
	BasicLibraries.LoadLibrary(&quot;Tools&quot;)
	If InitResources(&quot;Euro Converter&quot;, &quot;eur&quot;) Then
		bDoUnProtect = False
		bPreSelected = True
		oDocument = ThisComponent
		RetrieveDocumentObjects()											&apos; Statusline, SheetsCollection etc.
		InitializeConverter(oDocument.CharLocale, 1)
		GetPreSelectedRange()
		If GoOn Then
			DialogModel.lstCurrencies.TabIndex = 2
			DialogConvert.GetControl(&quot;chkComplete&quot;).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()) &gt; -1 Then
		EnableStep1DialogControls(False, False, False)
		oSelRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)

		&apos; Is the sheet the basis, then the sheetobject has to be created
		If DialogModel.optDocRanges.State = 1 Then
			&apos; 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(&quot;NumberFormat&quot;) = 1 Then
						If oRange.CellStyle = CurStyleName Then
							oSelRanges.InsertbyName(&quot;&quot;,oRange)
						End If
					End If
				Wend
			Next i
		Else
			&apos; 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 &gt; MaxIndex Then
					Redim Preserve SelRangeList(MaxIndex + SBRANGEUBOUND)
				End If
				SelRangeList(a) = RangeName
				If oListSheet.Name = sCurSheetName Then
					oRange = RetrieveRangeoutofRangeName(RangeName)
					oSelRanges.InsertbyName(&quot;&quot;,oRange)
				End If
			Next n
		End If
		If a &gt; -1 Then
			ReDim Preserve SelRangeList(a)
		Else
			ReDim SelRangeList()
		End If
		oDocument.CurrentController.Select(oSelRanges)
		EnableStep1DialogControls(True, True, True)
	End If
End Sub


&apos; 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)

	&apos; 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
	&apos; The CheckBox has the Value &apos;1&apos; when the Controls in the Frame are disabled
	If bButtonsEnabled Then
		bCurrIsSelected = Ubound(DialogModel.lstCurrencies.SelectedItems()) &lt;&gt; -1
		&apos; Enable GoOnButton only when Currency is selected
		DialogModel.cmdGoOn.Enabled =  bCurrIsSelected
		DialogModel.chkComplete.Enabled = bCurrIsSelected
		If bDoEnableFrame AND DialogModel.cmdGoOn.Enabled Then
			&apos; If FrameControls are enabled, check if Listbox is Empty
			bObjectIsSelected = Ubound(DialogModel.lstSelection.SelectedItems()) &lt;&gt; -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(&quot;lstSelection&quot;).SelectedItems()
		If DialogModel.optCellTemplates.State = 1 Then
			&apos; Option &apos;Soft&apos; 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


&apos; 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, &quot;;&quot;, MaxIndex)
			For i = 0 To MaxIndex
				oSelRanges.RemovebyName(EmptySelRangeList(i))
			Next i
		End If
		oDocument.CurrentController.Select(oSelRanges)
	Else
		oSelRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
	End If
End Sub


Function AddSelectedRangeToSelRangesEnum() as Object
Dim oLocRange as Object
	osheet = oDocument.CurrentController.GetActiveSheet
	oSelRanges = oDocument.createInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
	&apos; Check if a Currency-Range has been selected
	oLocRange = oDocument.CurrentController.Selection
	bPreSelected = oLocRange.SupportsService(&quot;com.sun.star.sheet.SheetCellRange&quot;)
	If bPreSelected Then
		oSelRanges.InsertbyName(&quot;&quot;,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)&apos;, 0)
	SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
	TotCellCount = CountRangeCells(oLocRange)
End Sub


Sub CheckRangeSelection(Optional oEvent)
	EmptySelection()
	AddRangeToListbox(oPreSelRange)
	oPreSelRange = AddSelectedRangeToSelRangesEnum()	
End Sub


&apos; Checks if a Field (LocField) is already defined in an Array
&apos; Returns &apos;True&apos; or &apos;False&apos;
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
</script:module>