1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185:
| REM ***** BASIC *****
' procedury použité ze standardní knihovny TOOLS - bez jejiho hledání ' byly problémy tam, kde nebyla knihovna k dispozici
Function getICUcomp as boolean ' ICU je od verze: ' Apache, OpenOffice 3.4.0 ' LibreOffice 4.0 Dim oProdNameAccess as Object Dim sVersion as String Dim sProdName as String dim pver() dim OooVer as double
oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") sProdName = oProdNameAccess.getByName("ooName") sVersion = oProdNameAccess.getByName("ooSetupVersion") GetProductName = sProdName & " " & sVersion ' msgbox sProdName & " " & sVersion ' OpenOffice 3.4.0 ' LibreOffice 4.0
pver() = ArrayOutOfString_(sVersion + ".0", ".") OooVer = val(pver(0)+"."+pver(1)) getICUcomp = false if instr(sProdName,"OpenOffice")>0 then if OooVer >= 3.4 then getICUcomp = true elseIf instr(sProdName,"LibreOffice")>0 then if OooVer >= 4.0 then getICUcomp = true else ' neznámý klon OOo ' zatím nechat starou konvenci end if
end function
' vrací řetezec klonu a číselné verze OOo Function GetProductname_() as String Dim oProdNameAccess as Object Dim sVersion as String Dim sProdName as String
oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") sProdName = oProdNameAccess.getByName("ooName") sVersion = oProdNameAccess.getByName("ooSetupVersion") GetProductName_ = sProdName & " " & sVersion ' msgbox sProdName & " " & sVersion ' OpenOffice 3.4.0 ' LibreOffice 4.0 End Function
Function GetStarOfficeLocale_() as New com.sun.star.lang.Locale Dim aLocLocale As New com.sun.star.lang.Locale Dim sLocale as String Dim sLocaleList(1) Dim oMasterKey oMasterKey = GetRegistryKeyContent("org.openoffice.Setup/L10N/") sLocale = oMasterKey.getByName("ooLocale") sLocaleList() = ArrayoutofString_(sLocale, "-") aLocLocale.Language = sLocaleList(0) If Ubound(sLocaleList()) > 0 Then aLocLocale.Country = sLocaleList(1) End If GetStarOfficeLocale_() = aLocLocale End Function
Function GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) Dim oConfigProvider as Object Dim aNodePath(0) as new com.sun.star.beans.PropertyValue oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") aNodePath(0).Name = "nodepath" aNodePath(0).Value = sKeyName If IsMissing(bForUpdate) Then GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) Else If bForUpdate Then GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath()) Else GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) End If End If End Function
Function LoadDialog_(Libname as String, DialogName as String, Optional oLibContainer) Dim oLib as Object Dim oLibDialog as Object Dim oRuntimeDialog as Object If IsMissing(oLibContainer ) then oLibContainer = DialogLibraries End If oLibContainer.LoadLibrary(LibName) oLib = oLibContainer.GetByName(Libname) oLibDialog = oLib.GetByName(DialogName) oRuntimeDialog = CreateUnoDialog(oLibDialog) LoadDialog_() = oRuntimeDialog End Function
Function OpenDocument_(DocPath as String, Args(), Optional bDisposable as Boolean) Dim oComponents as Object Dim oComponent as Object ' Search if one of the active Components ist the one that you search for oComponents = StarDesktop.Components.CreateEnumeration While oComponents.HasmoreElements oComponent = oComponents.NextElement If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then If UCase(oComponent.URL) = UCase(DocPath) then OpenDocument_() = oComponent If Not IsMissing(bDisposable) Then bDisposable = False End If Exit Function End If End If Wend If Not IsMissing(bDisposable) Then bDisposable = True End If OpenDocument_() = StarDesktop.LoadComponentFromURL(DocPath,"_default",0,Args()) End Function
' Retrieves an Array out of a String. ' The fields of the Array are separated by the parameter 'Separator', that is contained ' in the Array ' The Array MaxLocindex delivers the highest Index of this Array Function ArrayOutOfString_(BigString, Separator as String, Optional MaxIndex as integer) Dim i%, OldPos%, Pos%, SepLen%, BigLen% Dim CurUbound as Integer Dim StartUbound as Integer StartUbound = 50 Dim LocList(StartUbound) as String CurUbound = StartUbound OldPos = 1 i = -1 SepLen = Len(Separator) BigLen = Len(BigString) Do Pos = Instr(OldPos,BigString, Separator) i = i + 1 If Pos = 0 Then LocList(i) = Mid(BigString, OldPos, BigLen - OldPos + 1 ) Else LocList(i) = Mid(BigString, OldPos, Pos-OldPos ) OldPos = Pos + SepLen End If If i = CurUbound Then CurUbound = CurUbound + StartUbound ReDim Preserve LocList(CurUbound) as String End If Loop until Pos = 0 If Not IsMissing(Maxindex) Then MaxIndex = i End If If i <> -1 Then ReDim Preserve LocList(i) as String Else ReDim LocList() as String End If ArrayOutofString_ = LocList() End Function |