Kompuutteri Kaikille K-CD 2002 #3/K-CD_2002-03.iso/OpenOffice/f_0259/ConvertRun.xba

Extensible Markup Language | 2001-09-21 | 11KB | 320 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ConvertRun" script:language="StarBasic">Option Explicit

Public oPreSelRange as Object

' Todo Den Bug mit der Statuszeilengeschichte ├╝berpr├╝fen
' Todo Vorselektion der Listbox
' Mauspointer umschalten:

' Todo: Sinnigkeit von 'DocDisposed' noch einmal ├╝berpr├╝fen
' Todo: In der Hilfe sollte ein Hinweis erscheinen, dass immer zwei Nachkommastellen angezeigt werden
' und die resultierende Betrag ebenfalls bis auf zwei Stellen nach dem Komma gerundet wird

Sub Main()
    BasicLibraries.LoadLibrary("Tools")
    If InitResources("Euro Converter", "eur") Then
        bDoUnProtect = False
        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 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


' 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 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


' Alles was selektiert wurde wird deselektiert
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
    oSelRanges.InsertbyName("",oLocRange)
    AddSelectedRangeToSelRangesEnum() = oLocRange
End Function


Sub GetPreSelectedRange()
Dim i as Integer
Dim OldCurrSymbolList(2) as String
Dim OldCurrIndex as Integer
Dim OldCurExtension(2) as String
    oPreSelRange = AddSelectedRangeToSelRangesEnum()
    bPreSelected = True
    If bPreSelected Then
        DialogModel.optSelRange.State = 1
        AddRangeToListbox(oPreSelRange)
    Else
        DialogModel.optCellTemplates.State  = 1
        CreateStyleEnumeration()
    End If
    EnableStep1DialogControls(True, bPreSelected, True)
' Todo: auf Integer umstellen
    DialogModel.chkComplete.State = Not(Abs(bPreSelected))
    DialogModel.optSelRange.Enabled = bPreSelected
End Sub


Sub AddRangeToListbox(oLocRange as Object)
    EmptyListBox(DialogModel.lstSelection)
    ' Den Namen der Range ermitteln und in ein Array packen
    PreName = RetrieveRangeNamefromAddress(oLocRange)
    AddSingleItemToListbox(DialogModel.lstSelection, Prename)', 0)
    SelectListboxItem(DialogModel.lstCurrencies, CurrIndex)
    TotCellCount = CountRangeCells(oLocRange)
End Sub


Sub CheckRangeSelection(Optional oEvent)
' Todo: Beim Startup werden die folgenden zwei Zeilen doppelt ausgef├╝hrt
'    oPreSelRange = AddSelectedRangeToSelRangesEnum()
'    bPreSelected = CheckFormatType(oRange)
 '    If bPreSelected Then
        EmptySelection()
        AddRangeToListbox(oPreSelRange)
'    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()
    With DialogModel
        .optCellTemplates.State = 0
        .optSheetRanges.State = 0
        .optDocRanges.State = 0
        .optSelRange.State = 0
    End With
End Sub
</script:module>