Quelle  Common.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   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 .
-->
<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 = 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
</script:module>