Option Explicit Private lLookUp&(0 To 30)
Friend Function Replicate12(ByVal lNumber&, sPattern$) As String ' by Marzo Junior, marzojr@taskmail.com.br, 20020527 ' Based on Replicate09 by by Mike Peterson, mpeterson1200@yahoo.com, 20010910 If lNumber > 0 Then Dim lPointer& lPointer = Len(sPattern) Select Case lPointer Case Is > 1 'Contrary to Mike's code, we NEED to do this here: 'Allocate String Buffer Replicate12 = StringHelpers.SysAllocStringLen(ByVal 0&, lNumber * lPointer) Dim i&, lTemp&, lPtr& 'Find the highest bit set on lNumber, store it on variable i and 'clear the bit from lNumber. We modify lNumber here, which is why 'we had to allocate the string buffer above. If lNumber And &H7FFFFF00 Then If lNumber And &H7FFF0000 Then If lNumber And &H40000000 Then lNumber = lNumber Xor &H40000000 i = 30 ElseIf lNumber And &H20000000 Then lNumber = lNumber Xor &H20000000 i = 29 ElseIf lNumber And &H10000000 Then lNumber = lNumber Xor &H10000000 i = 28 ElseIf lNumber And &H8000000 Then lNumber = lNumber Xor &H8000000 i = 27 ElseIf lNumber And &H4000000 Then lNumber = lNumber Xor &H4000000 i = 26 ElseIf lNumber And &H2000000 Then lNumber = lNumber Xor &H2000000 i = 25 ElseIf lNumber And &H1000000 Then lNumber = lNumber Xor &H1000000 i = 24 ElseIf lNumber And &H800000 Then lNumber = lNumber Xor &H800000 i = 23 ElseIf lNumber And &H400000 Then lNumber = lNumber Xor &H400000 i = 22 ElseIf lNumber And &H200000 Then lNumber = lNumber Xor &H200000 i = 21 ElseIf lNumber And &H100000 Then lNumber = lNumber Xor &H100000 i = 20 ElseIf lNumber And &H80000 Then lNumber = lNumber Xor &H80000 i = 19 ElseIf lNumber And &H40000 Then lNumber = lNumber Xor &H40000 i = 18 ElseIf lNumber And &H20000 Then lNumber = lNumber Xor &H20000 i = 17 ElseIf lNumber And &H10000 Then lNumber = lNumber Xor &H10000 i = 16 End If Else If lNumber And &H8000& Then lNumber = lNumber Xor &H8000& i = 15 ElseIf lNumber And &H4000& Then lNumber = lNumber Xor &H4000& i = 14 ElseIf lNumber And &H2000& Then lNumber = lNumber Xor &H2000& i = 13 ElseIf lNumber And &H1000& Then lNumber = lNumber Xor &H1000& i = 12 ElseIf lNumber And &H800& Then lNumber = lNumber Xor &H800& i = 11 ElseIf lNumber And &H400& Then lNumber = lNumber Xor &H400& i = 10 ElseIf lNumber And &H200& Then lNumber = lNumber Xor &H200& i = 9 ElseIf lNumber And &H100& Then lNumber = lNumber Xor &H100& i = 8 End If End If Else If lNumber And &H80& Then lNumber = lNumber Xor &H80& i = 7 ElseIf lNumber And &H40& Then lNumber = lNumber Xor &H40& i = 6 ElseIf lNumber And &H20& Then lNumber = lNumber Xor &H20& i = 5 ElseIf lNumber And &H10& Then lNumber = lNumber Xor &H10& i = 4 ElseIf lNumber And &H8& Then lNumber = lNumber Xor &H8& i = 3 ElseIf lNumber And &H4& Then lNumber = lNumber Xor &H4& i = 2 ElseIf lNumber And &H2& Then lNumber = lNumber Xor &H2& i = 1 Else lNumber = 0 'The following is not needed: 'i = 0 End If End If 'store the value of i lTemp = i 'Store the pointer: lPtr = StrPtr(Replicate12) lPointer = lPointer * 2& '** Unicode=2 bytes 'Do first CopyMem kernel.MoveMemoryFromStr ByVal lPtr, sPattern, ByVal lPointer 'Here we decrease i until it reaches 1, while in the original, 'Mike increased i until 2^i <= lNumber. It is easy to see why 'this way is much faster. While i > 0 kernel.MoveMemoryFromStr ByVal lPtr + lPointer, Replicate12, ByVal lPointer lPointer = lPointer + lPointer: i = i - 1 Wend 'We start back from the stored value, but decrease it by 1. 'This is because we already created the string corresponding 'to the i-th bit alone, and we start from the next bit. i = lTemp - 1 'We now store half the value of lPointer. This will be used to 'get the length of the strings we copy. lTemp = lPointer \ &H2& 'Now we loop until the number is zero. This eliminates the 'recursion from the original, which saves us lots of function 'calls and from having to rebuild the string all over again 'to the specified size: While lNumber If lNumber And lLookUp(i) Then 'bit i is set 'Clear the current bit and copy the string: lNumber = lNumber Xor lLookUp(i) kernel.MoveMemoryFromStr ByVal lPtr + lPointer, Replicate12, ByVal lTemp lPointer = lPointer + lTemp End If i = i - 1 'The length of the string we must copy is halved for every 'bit we go down the road: lTemp = lTemp \ &H2& Wend Case 1 Replicate12 = String$(lNumber, sPattern) End Select End If End Function
Private Sub Class_Initialize() Dim i& For i = 0 To 30 lLookUp(i) = 2 ^ i Next End Sub