GameStar 2004 May/Gamestar_62_2004-05_dvd.iso/Programy/openoffice/f_0321/ConvertRun.xba

Extensible Markup Language | 2003-03-27 | 10KB | 317 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

Sub Main()
    BasicLibraries.LoadLibrary("Tools")
    If InitResources("Euro Converter", "eur") 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
</script:module>