diff options
Diffstat (limited to 'wizards/source/tools/Strings.xba')
| -rw-r--r-- | wizards/source/tools/Strings.xba | 452 |
1 files changed, 452 insertions, 0 deletions
diff --git a/wizards/source/tools/Strings.xba b/wizards/source/tools/Strings.xba new file mode 100644 index 000000000000..a2a8907e02f2 --- /dev/null +++ b/wizards/source/tools/Strings.xba @@ -0,0 +1,452 @@ +<?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="Strings" script:language="StarBasic">Option Explicit +Public sProductname as String + + +' Deletes out of a String 'BigString' all possible PartStrings, that are summed up +' in the Array 'ElimArray' +Function ElimChar(ByVal BigString as String, ElimArray() as String) +Dim i% ,n% + For i = 0 to Ubound(ElimArray) + BigString = DeleteStr(BigString,ElimArray(i) + Next + ElimChar = BigString +End Function + + +' Deletes out of a String 'BigString' a possible Partstring 'CompString' +Function DeleteStr(ByVal BigString,CompString as String) as String +Dim i%, CompLen%, BigLen% + CompLen = Len(CompString) + i = 1 + While i <> 0 + i = Instr(i, BigString,CompString) + If i <> 0 then + BigLen = Len(BigString) + BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen) + End If + Wend + DeleteStr = BigString +End Function + + +' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString' +Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String +Dim StartPos%, EndPos% +Dim BigLen%, PreLen%, PostLen% + StartPos = Instr(SearchPos,BigString,PreString) + If StartPos <> 0 Then + PreLen = Len(PreString) + EndPos = Instr(StartPos + PreLen,BigString,PostString) + If EndPos <> 0 Then + BigLen = Len(BigString) + PostLen = Len(PostString) + FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen)) + SearchPos = EndPos + PostLen + Else + Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName()) + FindPartString = "" + End If + Else + FindPartString = "" + End If +End Function + + +' Note iCompare = 0 (Binary comparison) +' iCompare = 1 (Text comparison) +Function PartStringInArray(BigArray(), SearchString as String, iCompare as Integer) as Integer +Dim MaxIndex as Integer +Dim i as Integer + MaxIndex = Ubound(BigArray()) + For i = 0 To MaxIndex + If Instr(1, BigArray(i), SearchString, iCompare) <> 0 Then + PartStringInArray() = i + Exit Function + End If + Next i + PartStringInArray() = -1 +End Function + + +' Deletes the String 'SmallString' out of the String 'BigString' +' in case SmallString's Position in BigString is right at the end +Function RTrimStr(ByVal BigString, SmallString as String) as String +Dim SmallLen as Integer +Dim BigLen as Integer + SmallLen = Len(SmallString) + BigLen = Len(BigString) + If Instr(1,BigString, SmallString) <> 0 Then + If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then + RTrimStr = Mid(BigString,1,BigLen - SmallLen) + Else + RTrimStr = BigString + End If + Else + RTrimStr = BigString + End If +End Function + + +' Deletes the Char 'CompChar' out of the String 'BigString' +' in case CompChar's Position in BigString is right at the beginning +Function LTRimChar(ByVal BigString as String,CompChar as String) as String +Dim BigLen as integer + BigLen = Len(BigString) + If BigLen > 1 Then + If Left(BigString,1) = CompChar then + BigString = Mid(BigString,2,BigLen-1) + End If + ElseIf BigLen = 1 Then + BigString = "" + End If + LTrimChar = BigString +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 MaxIndex delivers the highest Index of this Array +Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as Integer) +Dim LocList() as String + LocList=Split(BigString,Separator) + + If not isMissing(MaxIndex) then maxIndex=ubound(LocList()) + + ArrayOutOfString=LocList +End Function + + +' Deletes all fieldvalues in one-dimensional Array +Sub ClearArray(BigArray) +Dim i as integer + For i = Lbound(BigArray()) to Ubound(BigArray()) + BigArray(i) = "" + Next +End Sub + + +' Deletes all fieldvalues in a multidimensional Array +Sub ClearMultiDimArray(BigArray,DimCount as integer) +Dim n%, m% + For n = Lbound(BigArray(),1) to Ubound(BigArray(),1) + For m = 0 to Dimcount - 1 + BigArray(n,m) = "" + Next m + Next n +End Sub + + +' Checks if a Field (LocField) is already defined in an Array +' Returns 'True' or 'False' +Function FieldinArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean +Dim i as integer + For i = Lbound(LocArray()) to MaxIndex + If Ucase(LocArray(i)) = Ucase(LocField) Then + FieldInArray = True + Exit Function + End if + Next + FieldInArray = False +End Function + + +' Checks if a Field (LocField) is already defined in an Array +' Returns 'True' or 'False' +Function FieldinList(LocField, BigList()) As Boolean +Dim i as integer + For i = Lbound(BigList()) to Ubound(BigList()) + If LocField = BigList(i) Then + FieldInList = True + Exit Function + End if + Next + FieldInList = False +End Function + + +' Retrieves the Index of the delivered String 'SearchString' in +' the Array LocList()' +Function IndexinArray(SearchString as String, LocList()) as Integer +Dim i as integer + For i = Lbound(LocList(),1) to Ubound(LocList(),1) + If Ucase(LocList(i,0)) = Ucase(SearchString) Then + IndexinArray = i + Exit Function + End if + Next + IndexinArray = -1 +End Function + + +Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer) +Dim oListbox as Object +Dim i as integer +Dim a as Integer + a = 0 + oListbox = oDialog.GetControl(ListboxName) + oListbox.RemoveItems(0, oListbox.GetItemCount) + For i = 0 to Ubound(ValList(), 1) + If ValList(i) <> "" Then + oListbox.AddItem(ValList(i, iDim-1), a) + a = a + 1 + End If + Next +End Sub + + +' Searches for a String in a two-dimensional Array by querying all Searchindexex of the second dimension +' and delivers the specific String of the ReturnIndex in the second dimension of the Searchlist() +Function StringInMultiArray(SearchList(), SearchString as String, SearchIndex as Integer, ReturnIndex as Integer, Optional MaxIndex as Integer) as String +Dim i as integer +Dim CurFieldString as String + If IsMissing(MaxIndex) Then + MaxIndex = Ubound(SearchList(),1) + End If + For i = Lbound(SearchList()) to MaxIndex + CurFieldString = SearchList(i,SearchIndex) + If Ucase(CurFieldString) = Ucase(SearchString) Then + StringInMultiArray() = SearchList(i,ReturnIndex) + Exit Function + End if + Next + StringInMultiArray() = "" +End Function + + +' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension +' and delivers the Index where it is found. +Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer +Dim i as integer +Dim MaxIndex as Integer +Dim CurFieldValue + MaxIndex = Ubound(SearchList(),1) + For i = Lbound(SearchList()) to MaxIndex + CurFieldValue = SearchList(i,SearchIndex) + If CurFieldValue = SearchValue Then + GetIndexInMultiArray() = i + Exit Function + End if + Next + GetIndexInMultiArray() = -1 +End Function + + +' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension +' and delivers the Index where the Searchvalue is found as a part string +Function GetIndexForPartStringinMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer +Dim i as integer +Dim MaxIndex as Integer +Dim CurFieldValue + MaxIndex = Ubound(SearchList(),1) + For i = Lbound(SearchList()) to MaxIndex + CurFieldValue = SearchList(i,SearchIndex) + If Instr(CurFieldValue, SearchValue) > 0 Then + GetIndexForPartStringinMultiArray() = i + Exit Function + End if + Next + GetIndexForPartStringinMultiArray = -1 +End Function + + +Function ArrayfromMultiArray(MultiArray as String, iDim as Integer) +Dim MaxIndex as Integer +Dim i as Integer + MaxIndex = Ubound(MultiArray()) + Dim ResultArray(MaxIndex) as String + For i = 0 To MaxIndex + ResultArray(i) = MultiArray(i,iDim) + Next i + ArrayfromMultiArray() = ResultArray() +End Function + + +' Replaces the string "OldReplace" through the String "NewReplace" in the String +' 'BigString' +Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String + ReplaceString=join(split(BigString,OldReplace),NewReplace) +End Function + + +' Retrieves the second value for a next to 'SearchString' in +' a two-dimensional string-Array +Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String +Dim i as Integer + For i = 0 To Ubound(TwoDimList,1) + If Ucase(SearchString) = Ucase(TwoDimList(i,0)) Then + FindSecondValue = TwoDimList(i,1) + Exit For + End If + Next +End Function + + +' raises a base to a certain power +Function Power(Basis as Double, Exponent as Double) as Double + Power = Exp(Exponent*Log(Basis)) +End Function + + +' rounds a Real to a given Number of Decimals +Function Round(BaseValue as Double, Decimals as Integer) as Double +Dim Multiplicator as Long +Dim DblValue#, RoundValue# + Multiplicator = Power(10,Decimals) + RoundValue = Int(BaseValue * Multiplicator) + Round = RoundValue/Multiplicator +End Function + + +'Retrieves the mere filename out of a whole path +Function FileNameoutofPath(ByVal Path as String, Optional Separator as String) as String +Dim i as Integer +Dim SepList() as String + If IsMissing(Separator) Then + Path = ConvertFromUrl(Path) + Separator = GetPathSeparator() + End If + SepList() = ArrayoutofString(Path, Separator,i) + FileNameoutofPath = SepList(i) +End Function + + +Function GetFileNameExtension(ByVal FileName as String) +Dim MaxIndex as Integer +Dim SepList() as String + SepList() = ArrayoutofString(FileName,".", MaxIndex) + GetFileNameExtension = SepList(MaxIndex) +End Function + + +Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String) +Dim MaxIndex as Integer +Dim SepList() as String + If not IsMissing(Separator) Then + FileName = FileNameoutofPath(FileName, Separator) + End If + SepList() = ArrayoutofString(FileName,".", MaxIndex) + GetFileNameWithoutExtension = RTrimStr(FileName, "." & SepList(MaxIndex) +End Function + + +Function DirectoryNameoutofPath(sPath as String, Separator as String) as String +Dim LocFileName as String + LocFileName = FileNameoutofPath(sPath, Separator) + DirectoryNameoutofPath = RTrimStr(sPath, Separator & LocFileName) +End Function + + +Function CountCharsinString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer +Dim LocCount%, LocPos% + LocCount = 0 + Do + LocPos = Instr(StartPos,BigString,LocChar) + If LocPos <> 0 Then + LocCount = LocCount + 1 + StartPos = LocPos+1 + End If + Loop until LocPos = 0 + CountCharsInString = LocCount +End Function + + +Function BubbleSortList(ByVal SortList(),optional sort2ndValue as Boolean) +'This function bubble sorts an array of maximum 2 dimensions. +'The default sorting order is the first dimension +'Only if sort2ndValue is True the second dimension is the relevant for the sorting order + Dim s as Integer + Dim t as Integer + Dim i as Integer + Dim k as Integer + Dim dimensions as Integer + Dim sortvalue as Integer + Dim DisplayDummy + dimensions = 2 + +On Local Error Goto No2ndDim + k = Ubound(SortList(),2) + No2ndDim: + If Err <> 0 Then dimensions = 1 + + i = Ubound(SortList(),1) + If ismissing(sort2ndValue) then + sortvalue = 0 + else + sortvalue = 1 + end if + + For s = 1 to i - 1 + For t = 0 to i-s + Select Case dimensions + Case 1 + If SortList(t) > SortList(t+1) Then + DisplayDummy = SortList(t) + SortList(t) = SortList(t+1) + SortList(t+1) = DisplayDummy + End If + Case 2 + If SortList(t,sortvalue) > SortList(t+1,sortvalue) Then + For k = 0 to UBound(SortList(),2) + DisplayDummy = SortList(t,k) + SortList(t,k) = SortList(t+1,k) + SortList(t+1,k) = DisplayDummy + Next k + End If + End Select + Next t + Next s + BubbleSortList = SortList() +End Function + + +Function GetValueoutofList(SearchValue, BigList(), iDim as Integer, Optional ValueIndex) +Dim i as Integer +Dim MaxIndex as Integer + MaxIndex = Ubound(BigList(),1) + For i = 0 To MaxIndex + If BigList(i,0) = SearchValue Then + If Not IsMissing(ValueIndex) Then + ValueIndex = i + End If + GetValueOutOfList() = BigList(i,iDim) + End If + Next i +End Function + + +Function AddListtoList(ByVal FirstArray(), ByVal SecondArray(), Optional StartIndex) +Dim n as Integer +Dim m as Integer +Dim MaxIndex as Integer + MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1 + If MaxIndex > -1 Then + Dim ResultArray(MaxIndex) + For m = 0 To Ubound(FirstArray()) + ResultArray(m) = FirstArray(m) + Next m + For n = 0 To Ubound(SecondArray()) + ResultArray(m) = SecondArray(n) + m = m + 1 + Next n + AddListToList() = ResultArray() + Else + Dim NullArray() + AddListToList() = NullArray() + End If +End Function + + +Function CheckDouble(DoubleString as String) +On Local Error Goto WRONGDATATYPE + CheckDouble() = CDbl(DoubleString) +WRONGDATATYPE: + If Err <> 0 Then + CheckDouble() = 0 + Resume NoErr: + End If +NOERR: +End Function +</script:module>
\ No newline at end of file |