PC World 2003 March/PCWorld_2003-03_cd.bin/Software/Vyzkuste/openoffice/f_0283/Common.xba

Extensible Markup Language | 2002-02-19 | 8KB | 260 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="Common" script:language="StarBasic"> REM  *****  BASIC  *****
Public DialogModel as Object
Public DialogConvert as Object
Public DialogPassword as Object
Public PasswordModel as Object

Sub    RetrieveDocumentObjects()
    CurMimeType = 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
        oStatusline.SetValue(10)
        ConvertTextFields()
        oStatusline.SetValue(80)
        ConvertWriterTables()
    End If
    oStatusline.End
    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

    ' Numberformat mit dem neuen Symbol als Basis f├╝r generateFormat
    nSimpleKey = Numberformat(oFormats, aSimpleStr, oLocale)
    ' Typ und Währungssymbol des Numberformats heraussuchen
    ' neues Währungsformat mit passenden Einstellungen setzen
    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


' Funktion findet den Formattyp einer Vorlage, Zelle oder eines Bereiches heraus und schreibt das Ergebnis
' in die globale Variable nFormatType; Ist ein Währungssymbol gesetzt, wird dieses in den globalen String
' sFormatCurrency geschrieben.
Function CheckFormatType( FormatObject as object)
Dim i as Integer
Dim LocCurrIndex as Integer
Dim nFormatFormatString as String
Dim FormatLangID as Integer
Dim sFormatCurrExt as String
Dim oFormatofObject() as Object

    ' Retrieve the Format of the Object
    On Local Error GoTo NOKEY
    oFormatofObject = oFormats.getByKey(FormatObject.NumberFormat)
    On Local Error GoTo 0
    ' Typ und Währungssymbol des Numberformats heraussuchen
      If NOT INT(oFormatofObject.Type) AND com.sun.star.util.NumberFormat.CURRENCY Then
        CheckFormatType = False
        Exit Function
    End If
    If FieldinArray(CurrSymbolList(),2,oFormatofObject.CurrencySymbol) Then
        ' If the Currencysymbol of the object ist the one needed, then check the Currency extension
        sFormatCurrExt = oFormatofObject.CurrencyExtension

        If FieldInList(CurExtension(),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)
    oStatusline.SetValue(StatusValue)
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
    oStatusline.Start(sStsPROGRESS,100)             '"Konvertierungsfortschritt:"
    StatusValue = 0
End Sub</script:module>