home *** CD-ROM | disk | FTP | other *** search
/ Kompuutteri Kaikille K-CD 2002 #3 / K-CD_2002-03.iso / OpenOffice / f_0180 / Misc.xba < prev    next >
Extensible Markup Language  |  2001-10-01  |  24KB  |  731 lines

  1. <?xml version="1.0" encoding="UTF-8"?>
  2. <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
  3. <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Misc" script:language="StarBasic">REM  *****  BASIC  *****
  4.  
  5. Const SBSHARE = 0
  6. Const SBUSER = 1
  7. Dim Taskindex as Integer
  8. Dim oResSrv as Object
  9.  
  10. Sub Main()
  11. Dim PropList(3,1)' as String
  12.     PropList(0,0) = "URL"
  13.     PropList(0,1) = "sdbc:odbc:Erica_Test_Unicode"
  14.     PropList(1,0) = "User"
  15.     PropList(1,1) = "extra"
  16.     PropList(2,0) = "Password"
  17.     PropList(2,1) = "extra"
  18.     PropList(3,0) = "IsPasswordRequired"
  19.     PropList(3,1) = True
  20. '    RegisterNewDataSource("Doc_Erica_Test_Unicode", PropList())
  21. End Sub
  22.  
  23.  
  24. Function RegisterNewDataSource(DSName as  String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
  25. Dim oDataSource as Object
  26. Dim oDBContext as Object
  27. Dim oPropInfo as Object
  28. Dim i as Integer
  29.     oDBContext = createUnoService("com.sun.star.sdb.DatabaseContext")
  30.     oDataSource = createUnoService("com.sun.star.sdb.DataSource")
  31.     For i = 0 To Ubound(PropertyList(), 1)
  32.         sPropName = PropertyList(i,0)
  33.         sPropValue = PropertyList(i,1)
  34.         oDataSource.SetPropertyValue(sPropName,sPropValue) 'GetByName(sPropName) = sPropValue 'oPropInfo.GetPropertyByName(sPropName)) = sPropValue '  PropertyList(i,0))) = PropertyList(i,1)
  35.     Next i
  36.     If Not IsMissing(DriverProperties()) Then
  37.         oDataSource.Info() = DriverProperties()
  38.     End If
  39.     oDBContext.RegisterObject(DSName, oDataSource)
  40.     RegisterNewDataSource () = oDataSource
  41. End Function
  42.  
  43.  
  44. ' Connects to a registered Database
  45. Function ConnecttoDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue)
  46. Dim oDBContext as Object
  47. Dim oDBSource as Object
  48. '    On Local Error Goto NOCONNECTION
  49.     oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
  50.     If oDBContext.HasbyName(DSName) Then
  51.         oDBSource = oDBContext.GetByName(DSName)
  52.         ConnectToDatabase = oDBSource.GetConnection(UserID, Password)
  53.     Else
  54.         If Not IsMissing(Namelist()) Then
  55.             If Not IsMissing(DriverProperties()) Then
  56.                 RegisterNewDataSource(DSName, PropertyList(), DriverProperties())
  57.             Else
  58.                 RegisterNewDataSource(DSName, PropertyList())
  59.             End If
  60.             oDBSource = oDBContext.GetByName(DSName)
  61.             ConnectToDatabase = oDBSource.GetConnection(UserID, Password)        
  62.         Else
  63.             Msgbox("DataSource " & DSName & " is not registered" , 16, GetProductname())
  64.             ConnectToDatabase() = NULL
  65.         End If
  66.     End If
  67. NOCONNECTION:
  68.     If Err <> 0 Then
  69.         Msgbox(Error$, 16, GetProductName())
  70.         Resume LEAVESUB
  71.         LEAVESUB:
  72.     End If    
  73. End Function
  74.  
  75.  
  76. Function GetStarOfficeLocale() as New com.sun.star.lang.Locale
  77. Dim aLocLocale As New com.sun.star.lang.Locale
  78. Dim sLocale as String
  79. Dim sLocaleList(1)
  80. Dim oMasterKey
  81.     oMasterKey = GetRegistryKeyContent("org.openoffice.Setup/L10N/")
  82.     sLocale = oMasterKey.getByName("ooLocale")
  83.     sLocaleList() = ArrayoutofString(sLocale, "-")
  84.     aLocLocale.Language = sLocaleList(0)
  85.     If Ubound(sLocaleList()) > 0 Then
  86.         aLocLocale.Country = sLocaleList(1)
  87.     End If
  88.     GetStarOfficeLocale() = aLocLocale
  89. End Function
  90.  
  91.  
  92. Function GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean)
  93. Dim oConfigProvider as Object
  94. Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
  95.     oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")
  96.     aNodePath(0).Name = "nodepath"
  97.     aNodePath(0).Value = sKeyName
  98.     If IsMissing(bForUpdate) Then
  99.         GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath())
  100.     Else
  101.         If bForUpdate Then
  102.             GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath())
  103.         Else
  104.             GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath())
  105.         End If
  106.     End If
  107. End Function
  108.  
  109.  
  110. Function GetProductname() as String
  111. Dim oProdNameAccess as Object
  112. Dim sVersion as String
  113. Dim sProdName as String
  114.     oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
  115.     sProdName = oProdNameAccess.getByName("ooName")
  116.     sVersion = oProdNameAccess.getByName("ooSetupVersion")
  117.     GetProductName = sProdName & "." & sVersion
  118. End Function
  119.  
  120.  
  121. ' Opens a Document, checks beforehand, wether it has to be loaded
  122. ' or wether it is already on the desktop
  123. Function OpenDocument(DocPath as String, Args())
  124. Dim oComponents as Object
  125. Dim oComponent as Object
  126.     ' Search if one of the active Components ist the one that you search for
  127.     oComponents = StarDesktop.Components.CreateEnumeration
  128.     While oComponents.HasmoreElements
  129.         oComponent = oComponents.NextElement
  130.             If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then
  131.             If UCase(oComponent.URL) = UCase(DocPath) then
  132.                 OpenDocument() = oComponent
  133.                 Exit Function
  134.             End If
  135.         End If
  136.     Wend
  137.     OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_blank",0,Args())
  138. End Function
  139.  
  140.  
  141. Function TaskonDesktop(DocPath as String) as Boolean
  142. Dim oComponents as Object
  143. Dim oComponent as Object
  144.     ' Search if one of the active Components ist the one that you search for
  145.     oComponents = StarDesktop.Components.CreateEnumeration
  146.     While oComponents.HasmoreElements
  147.         oComponent = oComponents.NextElement
  148.             If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then
  149.             If UCase(oComponent.URL) = UCase(DocPath) then
  150.                 TaskonDesktop = True
  151.                 Exit Function
  152.             End If
  153.         End If
  154.     Wend
  155.     TaskonDesktop = False
  156. End Function
  157.  
  158.  
  159. ' Retrieves a FileName out of a StarOffice-Document
  160. Function RetrieveFileName(LocDoc as Object)
  161. Dim LocURL as String
  162. Dim LocURLArray() as String
  163. Dim MaxArrIndex as integer
  164.  
  165.     LocURL = LocDoc.Url
  166.     LocURLArray() = ArrayoutofString(LocURL,"/",MaxArrIndex)
  167.     RetrieveFileName = LocURLArray(MaxArrIndex)
  168. End Function
  169.  
  170.  
  171. ' Gets a special configured PathSetting
  172. Function GetPathSettings(sPathType as String,  Optional bshowall as Boolean, Optional ListIndex as integer) as String
  173. Dim oSettings, oPathSettings as Object
  174. Dim sPath as String
  175. Dim PathList() as String
  176. Dim MaxIndex as Integer
  177.  
  178.     oSettings = createUnoService("com.sun.star.frame.Settings")
  179.     oPathSettings = oSettings.getByName("PathSettings")
  180.       If Not IsMissing(bShowall) Then
  181.         If bShowAll Then
  182.             ShowPropertyValues(oPathSettings)
  183.             Exit Function
  184.         End If
  185.     End If
  186.      sPath = oPathSettings.GetPropertyValue(sPathType)
  187.     If Not IsMissing(ListIndex) Then
  188.         ' Share and User-Directory
  189.         If Instr(1,sPath,";") <> 0 Then
  190.             PathList = ArrayoutofString(sPath,";", MaxIndex)
  191.             If ListIndex <= MaxIndex Then
  192.                 sPath = PathList(ListIndex)
  193.             Else
  194.                 Msgbox("Cannot analyze the String " & sPath , 16, GetProductName())
  195.             End If
  196.         End If
  197.     End If
  198.     If Instr(1, sPath, ";") = 0 Then
  199.         GetPathSettings = ConvertToUrl(sPath)
  200.     Else
  201.         GetPathSettings = sPath
  202.     End If
  203. End Function
  204.  
  205.  
  206.  
  207. ' Gets the fully qualified path to a subdirectory of the
  208. ' Template Directory, e. g. with the parameter "wizard/bitmap"
  209. ' The parameter must be passed over in Url-scription
  210. ' The return-Value is in Urlscription
  211. Function GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String)
  212. Dim oUcb as Object
  213. Dim sOfficeString as String
  214. Dim sOfficeList() as String
  215. Dim sOfficeDir as String
  216. Dim sBigDir as String
  217. Dim i as Integer
  218. Dim MaxIndex as Integer
  219.     oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  220.     sOfficeString = GetPathSettings(sOfficePath)
  221.     If Right(sSubDir,1) <> "/" Then
  222.         sSubDir = sSubDir & "/"
  223.     End If
  224.     sOfficeList() = ArrayoutofString(sOfficeString,";", MaxIndex)
  225.     For i = 0 To MaxIndex
  226.         sOfficeDir = ConvertToUrl(sOfficeList(i))
  227.         If Right(sOfficeDir,1) <> "/" Then
  228.             sOfficeDir = sOfficeDir & "/"
  229.         End If
  230.         sBigDir = sOfficeDir & sSubDir
  231.         If oUcb.Exists(sBigDir) Then
  232.             GetOfficeSubPath() = sBigDir
  233.             Exit Function
  234.         End If
  235.     Next i
  236.     GetOfficeSubPath = ""
  237. End Function
  238.  
  239.  
  240.  
  241. Function InitResources(Description, ShortDescription as String) as boolean
  242.     On Error Goto ErrorOcurred
  243.     oResSrv = createUnoService( "com.sun.star.resource.VclStringResourceLoader" )
  244.     If (IsNull(oResSrv)) then
  245.         InitResources = FALSE
  246.         MsgBox( Description & ": No resource loader found", 16, GetProductName())
  247.     Else
  248.         InitResources = TRUE
  249.         oResSrv.FileName = ShortDescription
  250.     End If
  251.     Exit Function
  252. ErrorOcurred:
  253.     Dim nSolarVer
  254.     InitResources = FALSE
  255.     nSolarVer = GetSolarVersion()
  256.     MsgBox("Resource file missing (" & ShortDescription  & trim(str(nSolarVer)) + "*.res)", 16, GetProductName())
  257.     Resume CLERROR
  258.     CLERROR:
  259. End Function
  260.  
  261.  
  262. Function GetResText( nID as integer ) As string
  263.     On Error Goto ErrorOcurred
  264.     If Not IsNull(oResSrv) Then
  265.         ' eigentlich sollte hier stehen
  266.         GetResText = oResSrv.getString( nID )
  267.     Else
  268.         GetResText = ""
  269.     End If
  270.     Exit Function
  271. ErrorOcurred:
  272.     GetResText = ""
  273.     MsgBox("Resource with ID =" + str( nID ) + " not found!", 16, GetProductName())
  274.     Resume CLERROR
  275.     CLERROR:
  276. End Function
  277.  
  278.  
  279. Function CutPathView(sDocUrl as String, Optional PathLen as Integer)
  280. Dim sViewPath as String
  281. Dim FileName as String
  282. Dim iFileLen as Integer
  283.     sViewPath = ConvertfromURL(sDocURL)
  284.     iViewPathLen = Len(sViewPath)
  285.     If iViewPathLen > 60 Then
  286.         FileName = FileNameoutofPath(sViewPath, "/")
  287.         iFileLen = Len(FileName)
  288.         If iFileLen < 44 Then
  289.             sViewPath = Left(sViewPath,57-iFileLen-10) & "..." & Right(sViewPath,iFileLen + 10)
  290.         Else
  291.             sViewPath = Left(sViewPath,27) & " ... " & Right(sViewPath,28)
  292.         End If
  293.     End If
  294.     CutPathView = sViewPath
  295. End Function
  296.  
  297.  
  298. ' Deletes the content of all cells that are softformatted according
  299. ' to the 'InputStyleName'
  300. Sub DeleteInputCells(oSheet as Object, InputStyleName as String)
  301. Dim oRanges as Object
  302. Dim oRange as Object
  303.     oRanges = oSheet.CellFormatRanges.createEnumeration
  304.     While oRanges.hasMoreElements
  305.         oRange = oRanges.NextElement
  306.         If Instr(1,oRange.CellStyle, InputStyleName) <> 0 Then
  307.             Call ReplaceRangeValues(oRange, "")
  308.         End If
  309.     Wend
  310. End Sub
  311.  
  312.  
  313. ' Inserts a certain String to all cells of a Range that ist passed over
  314. ' either as an object or as the RangeName
  315. Sub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String)
  316. Dim oCellRange as Object
  317.     If Vartype(Range) = 8 Then
  318.         ' Get the Range out of the Rangename
  319.         oCellRange = oSheet.GetCellRangeByName(Range)
  320.     Else
  321.         ' The range is passed over as an object
  322.         Set oCellRange = Range
  323.     End If
  324.     If IsMissing(StyleName) Then
  325.         ReplaceRangeValues(oCellRange, ReplaceValue)
  326.     Else
  327.         If Instr(1,oCellRange.CellStyle,StyleName) Then
  328.             ReplaceRangeValues(oCellRange, ReplaceValue)
  329.         End If
  330.     End If
  331. End Sub
  332.  
  333.  
  334. Sub ReplaceRangeValues(oRange as Object, ReplaceValue)
  335. Dim oRangeAddress as Object
  336. Dim ColCount as Integer
  337. Dim RowCount as Integer
  338. Dim i as Integer
  339.     oRangeAddress = oRange.RangeAddress
  340.     ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn
  341.     RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow
  342.     Dim FillArray(RowCount) as Variant
  343.     Dim sLine(ColCount) as Variant
  344.     For i = 0 To ColCount
  345.         sLine(i) = ReplaceValue
  346.     Next i
  347.     For i = 0 To RowCount
  348.         FillArray(i) = sLine()
  349.     Next i
  350.     oRange.DataArray = FillArray()
  351. End Sub
  352.  
  353.  
  354. ' Returns the Value of the first cell of a Range
  355. Function GetValueofCellbyName(oSheet as Object, sCellName as String)
  356. Dim oCell as Object
  357.     oCell = GetCellByName(oSheet, sCellName)
  358.     GetValueofCellbyName = oCell.Value
  359. End Function
  360.  
  361.  
  362. Function DuplicateRow(oSheet as Object, RangeName as String)
  363. Dim oRange as Object
  364. Dim oCell as Object
  365. Dim oCellAddress as New com.sun.star.table.CellAddress
  366. Dim oRangeAddress as New com.sun.star.table.CellRangeAddress 
  367.     oRange = oSheet.GetCellRangeByName(RangeName)
  368.     oRangeAddress = oRange.RangeAddress
  369.     oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow)
  370.     oCellAddress = oCell.CellAddress
  371.     oSheet.Rows.InsertByIndex(oCellAddress.Row,1)
  372.     oRangeAddress = oRange.RangeAddress
  373.     oSheet.CopyRange(oCellAddress, oRangeAddress)
  374.     DuplicateRow = oRangeAddress.StartRow-1
  375. End Function
  376.  
  377.  
  378. ' Returns the String of the first cell of a Range
  379. Function GetStringofCellbyName(oSheet as Object, sCellName as String)
  380. Dim oCell as Object
  381.     oCell = GetCellByName(oSheet, sCellName)
  382.     GetStringofCellbyName = oCell.String
  383. End Function
  384.  
  385.  
  386. ' Returns a named Cell
  387. Function GetCellByName(oSheet as Object, sCellName as String) as Object
  388. Dim oCellRange as Object
  389. Dim oCellAddress as Object
  390.     oCellRange = oSheet.GetCellRangeByName(sCellName)
  391.     oCellAddress = oCellRange.RangeAddress
  392.     GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow)
  393. End Function
  394.  
  395.  
  396. ' Changes the numeric Value of a cell by transmitting the String of the numeric Value
  397. Sub ChangeCellValue(oCell as Object, ValueString as String)
  398. Dim CellValue
  399.     oCell.Formula = "=Value(" & """" & ValueString & """" & ")"
  400.     CellValue = oCell.Value
  401.     oCell.Formula = ""
  402.     oCell.Value = CellValue
  403. End Sub
  404.  
  405. Sub Main
  406. '    oDocument = StarDesktop.ActiveFrame.Controller.Model
  407.     oComponents = StarDesktop.Components.CreateEnumeration
  408.     Do 
  409.         oComponent = oComponents.NextElement
  410.         ShowSupportedServicenames(oComponent)    
  411.     Loop Until Not oComponents.HasMoreElements
  412.     For i = 0 To Ubound(StarDesktop.Components())
  413.         PrintdbgInfo StarDesktop.Components(i)
  414.     Next i
  415. End Sub
  416.  
  417.  
  418. Function GetDocumentType(oDocument)
  419.     On Local Error GoTo NODOCUMENTTYPE
  420.     If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
  421.         GetDocumentType() = "scalc"
  422.     ElseIf oDocument.SupportsService("com.sun.star.text.TextDocument") Then
  423.         GetDocumentType() = "swriter"
  424.     ElseIf oDocument.SupportsService("com.sun.star.drawing.DrawingDocument") Then
  425.         GetDocumentType() = "sdraw"
  426.     ElseIf oDocument.SupportsService("com.sun.star.formula.FormulaProperties") Then
  427.         GetDocumentType() = "smath"
  428.     End If
  429.     NODOCUMENTTYPE:
  430.     If Err <> 0 Then
  431.         GetDocumentType = ""
  432.         Resume GOON
  433.         GOON:
  434.     End If
  435. End Function
  436.  
  437.  
  438. Function GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer
  439. Dim ThisFormatKey as Long
  440. Dim oObjectFormat as Object
  441.     On Local Error Goto NOFORMAT
  442.     ThisFormatKey = oFormatObject.NumberFormat
  443.     oObjectFormat = oDocFormats.GetByKey(ThisFormatKey)
  444.     GetNumberFormatType = oObjectFormat.Type
  445.     NOFORMAT:
  446.     If Err <> 0 Then
  447.         Msgbox("Numberformat of Object is not available!", 16, GetProductName())
  448.         GetNumberFormatType = 0
  449.         GOTO NOERROR
  450.     End If
  451.     NOERROR:
  452.     On Local Error Goto 0
  453. End Function
  454.  
  455.  
  456. Sub ProtectSheets(Optional oSheets as Object)
  457. Dim i as Integer
  458. Dim oDocSheets as Object
  459.     If IsMissing(oSheets) Then
  460.         oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
  461.     Else
  462.         Set oDocSheets = oSheets
  463.     End If
  464.  
  465.     For i = 0 To oDocSheets.Count-1
  466.         oDocSheets(i).Protect("")
  467.     Next i
  468. End Sub
  469.  
  470.  
  471. Sub UnprotectSheets(Optional oSheets as Object)
  472. Dim i as Integer
  473. Dim oDocSheets as Object
  474.     If IsMissing(oSheets) Then
  475.         oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets
  476.     Else
  477.         Set oDocSheets = oSheets
  478.     End If
  479.  
  480.     For i = 0 To oDocSheets.Count-1
  481.         oDocSheets(i).Unprotect("")
  482.     Next i
  483. End Sub
  484.  
  485.  
  486. Function GetRowIndex(oSheet as Object, RowName as String)
  487. Dim oRange as Object
  488.     oRange = oSheet.GetCellRangeByName(RowName)
  489.     GetRowIndex = oRange.RangeAddress.StartRow
  490. End Function
  491.  
  492.  
  493. Function GetColumnIndex(oSheet as Object, ColName as String)
  494. Dim oRange as Object
  495.     oRange = oSheet.GetCellRangeByName(ColName)
  496.     GetColumnIndex = oRange.RangeAddress.StartColumn
  497. End Function
  498.  
  499.  
  500. Function CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object
  501. Dim oSheet as Object
  502. Dim Count as Integer
  503. Dim BasicSheetName as String
  504.  
  505.     BasicSheetName = NewName
  506.     ' Copy the last table. Assumption: The last table is the template
  507.     On Local Error Goto RENAMESHEET
  508.     oSheets.CopybyName(OldName, NewName, DestPos)
  509.  
  510. RENAMESHEET:
  511.     oSheet = oSheets(DestPos)
  512.     If Err <> 0 Then
  513.         ' Test if renaming failed
  514.         Count = 2
  515.         Do While oSheet.Name <> NewName
  516.             NewName = BasicSheetName & "_" & Count
  517.             oSheet.Name = NewName
  518.             Count = Count + 1
  519.         Loop
  520.         Resume CL_ERROR
  521. CL_ERROR:
  522.     End If
  523.     CopySheetbyName = oSheet
  524. End Function
  525.  
  526.  
  527. ' Dis-or enables a Window and adjusts the mousepointer accordingly
  528. Sub ToggleWindow(bDoEnable as Boolean)
  529. Dim oWindow as Object
  530. Dim oWindowPointer as Object
  531.     oWindow = StarDesktop.CurrentFrame.ComponentWindow
  532.     oWindow.Enable = bDoEnable
  533.     oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer")
  534.     If bDoEnable Then
  535.         oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
  536.     Else
  537.         oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
  538.     End If
  539.     oWindow.SetPointer(oWindowPointer)
  540. End Sub
  541.  
  542.  
  543.  
  544. Function CheckNewSheetname(oSheets as Object, Sheetname as String)
  545. Dim SpecialSignsList(32) as String
  546. Dim i as Integer
  547.     SpecialSignsList(0) = "-"
  548.     SpecialSignsList(1) = "."
  549.     SpecialSignsList(2) = "!"
  550.     SpecialSignsList(3) = "?"
  551.     SpecialSignsList(4) = "/"
  552.     SpecialSignsList(5) = "\"
  553.     SpecialSignsList(6) = ","
  554.     SpecialSignsList(7) = ";"
  555.     SpecialSignsList(8) = "'"
  556.     SpecialSignsList(9) = "("
  557.     SpecialSignsList(10) = ")"
  558.     SpecialSignsList(11) = "{"
  559.     SpecialSignsList(12) = "}"
  560.     SpecialSignsList(13) = "["
  561.     SpecialSignsList(14) = "]"
  562.     SpecialSignsList(15) = ":"
  563.     SpecialSignsList(16) = """"
  564.     SpecialSignsList(17) = "$"
  565.     SpecialSignsList(18) = "&"
  566.     SpecialSignsList(19) = "%"
  567.     SpecialSignsList(20) = "="
  568.     SpecialSignsList(21) = "*"
  569.     SpecialSignsList(22) = "?├é┬º"
  570.     SpecialSignsList(23) = "@"
  571.     SpecialSignsList(24) = "<"
  572.     SpecialSignsList(25) = ">"
  573.     SpecialSignsList(26) = "#"
  574.     SpecialSignsList(27) = "+"
  575.     SpecialSignsList(28) = "~"
  576.     SpecialSignsList(29) = "|"
  577.     SpecialSignsList(30) = "??"
  578.     SpecialSignsList(31) = "^"
  579.     SpecialSignsList(32) = "?├é┬░"
  580.     For i = 0 To Ubound(SpecialSignsList())
  581.         SheetName = ReplaceString(Sheetname, "_", SpecialSignsList(i)
  582.     Next i
  583.     CheckNewSheetname = SheetName
  584. End Function
  585.  
  586.  
  587. Function GetSheetIndex(oSheets, sName) as Integer
  588. Dim i as Integer    
  589.     For i = 0 To oSheets.Count-1
  590.         If oSheets(i).Name = sName Then
  591.             GetSheetIndex = i
  592.             exit Function
  593.         End If
  594.     Next i
  595.     GetSheetIndex = -1
  596. End Function
  597.  
  598.  
  599. Function GetLastUsedRow(oSheet as Object) as Integer
  600. Dim oCell As Object
  601. Dim oCursor As Object
  602. Dim aAddress As Variant
  603.     oCell = oSheet.GetCellbyPosition(0, 0)
  604.     oCursor = oSheet.createCursorByRange(oCell)
  605.     oCursor.GotoEndOfUsedArea(True)
  606.     aAddress = oCursor.RangeAddress
  607.     GetLastUsedRow = aAddress.EndRow
  608. End Function        
  609.  
  610.  
  611. ' Note To set a one lined frame you have to set the inner width to 0
  612. ' In the API all Units that refer to pt-Heights are "1/100mm"
  613. ' The convert factor from 1pt to 1/100 mm is approximately 35
  614. Function ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer)
  615. Dim aBorder as New com.sun.star.table.BorderLine
  616.     aBorder = oStyleBorder
  617.     aBorder.InnerLineWidth = iInnerLineWidth
  618.     aBorder.OuterLineWidth = iOuterLineWidth
  619.     ModifyBorderLineWidth = aBorder
  620. End Function
  621.  
  622.  
  623. Sub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String)
  624. Dim PropValue(1) as new com.sun.star.beans.PropertyValue
  625.     PropValue(0).Name = "EventType"
  626.     PropValue(0).Value = "StarBasic"
  627.     PropValue(1).Name = "Script"
  628.     PropValue(1).Value = "macro:///" & SubPath
  629.     oDocument.Events.ReplaceByName(EventName, PropValue())
  630. End Sub
  631.  
  632.  
  633.  
  634. Function ModifyPropertyValue(oContent() as Object, TargetProperties() as New com.sun.star.beans.PropertyValue )
  635. Dim MaxIndex as Integer
  636. Dim i as Integer
  637. Dim a as Integer
  638. Dim bDoReplace as Boolean
  639.     MaxIndex = Ubound(oContent())
  640.     bDoReplace = False
  641.     Dim oNewBuffer(MaxIndex) as New com.sun.star.beans.PropertyValue
  642.     For i = 0 To MaxIndex
  643.         oNewBuffer(i).Name = oContent(i).Name
  644.         a = GetPropertyValueIndex(oContent(i).Name, TargetProperties())
  645.         If a <> -1 Then
  646.             If Vartype(TargetProperties(a).Value) <> 9 Then
  647.                 If TargetProperties(a).Value <> oContent(i).Value Then
  648.                     oNewBuffer(i).Value = TargetProperties(a).Value
  649.                     bDoReplace = True
  650.                 Else
  651.                     oNewBuffer(i).Value = oContent(i).Value            
  652.                 End If
  653.             Else
  654.                 If Not equalUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then
  655.                     oNewBuffer(i).Value = TargetProperties(a).Value
  656.                     bDoReplace = True
  657.                 Else
  658.                     oNewBuffer(i).Value = oContent(i).Value        
  659.                 End If
  660.             End If
  661.         Else
  662.             oNewBuffer(i).Value = oContent(i).Value
  663.         End If
  664.     Next i
  665.     If bDoReplace Then
  666.         oContent() = oNewBuffer()
  667.     End If
  668.     ModifyPropertyValue() = bDoReplace
  669. End Function
  670.  
  671.  
  672. Function GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue )
  673. Dim i as Integer
  674.     For i = 0 To Ubound(TargetProperties())
  675.         If Searchname = TargetProperties(i).Name Then
  676.             GetPropertyValueIndex = i
  677.             Exit Function
  678.         End If
  679.     Next i    
  680.     GetPropertyValueIndex() = -1
  681. End Function
  682.  
  683.  
  684. Sub DispatchSlot(SlotID as Integer)
  685. Dim oArg() as new com.sun.star.beans.PropertyValue
  686. Dim oUrl as new com.sun.star.util.URL
  687. Dim oTrans as Object
  688. Dim oDisp as Object
  689.     oTrans = createUNOService("com.sun.star.util.URLTransformer")
  690.     oUrl.Complete = "slot:" & CStr(SlotID)
  691.     oTrans.parsestrict(oUrl)
  692.  
  693.     oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)    
  694.     oDisp.dispatch(oUrl, oArg())
  695. End Sub
  696.  
  697.  
  698. 'returns the type of the office application
  699. 'FatOffice = 0, WebTop = 1
  700. 'This routine has to be changed if the Product Name is being changed!
  701. Function IsFatOffice() As Boolean
  702.   If sProductname = "" Then
  703.     sProductname = GetProductname()
  704.   End If
  705.   IsFatOffice = TRUE
  706.   'The following line has to include the current productname
  707.   If Instr(1,sProductname,"WebTop",1) <> 0 Then
  708.     IsFatOffice = FALSE
  709.   End If
  710. End Function
  711.  
  712.  
  713. Function GetLocale(sLanguage as String, sCountry as String)
  714. Dim oLocale as New com.sun.star.lang.Locale
  715.     oLocale.Language = sLanguage
  716.     oLocale.Country = sCountry
  717.     GetLocale = oLocale
  718. End Function                    
  719.  
  720.  
  721. Sub ToggleDesignMode(oDocument as Object)
  722. Dim aSwitchMode as new com.sun.star.util.URL
  723.     aSwitchMode.Complete = ".uno:SwitchControlDesignMode"
  724.     aTransformer = createUnoService("com.sun.star.util.URLTransformer")
  725.     aTransformer.parseStrict(aSwitchMode)
  726.     oFrame = oDocument.currentController.Frame
  727.     oDispatch = oFrame.queryDispatch(aSwitchMode, oFrame.Name, 63)
  728.     Dim aEmptyArgs() as com.sun.star.bean.PropertyValue
  729.     oDispatch.dispatch(aSwitchMode, aEmptyArgs())
  730.     Erase aSwitchMode
  731. End Sub</script:module>