05-06-2025, 10:24 AM
And here's another version for testing. Note that this, on my PC at least, is now producing quicker times for the fill with MID$ than it is with _MEMFILL... but only by about 2 - 3 times faster!! 
Give that a shot and see how it does on your machine for you.
Code: (Select All)
Dim Returns(10) As String
Dim As Long Scr
Scr = _NewImage(800, 600, 32)
Screen Scr
_ControlChr Off
_Title "FillString: a new STRING$"
Cls , _RGB32(33, 172, 172)
Locate 2, 1: Print "Starting Test :"
S$ = "1234" ' Substring
Size = 800 * 600 * 40 '1.920.000 (Increased by 10 times more by Steve for better results)
Print "Fillstring concatenation with 2*n formula"
t1# = Timer(0.001)
Print FillString(Size, S$, Returns(1)), Size, Len(Returns(1))
t2# = Timer(0.001)
Print " Fillstring with MID$"
Fs$ = "" ' FinalString
t3# = Timer(0.001)
Print FillString2(Size, S$, Returns(2)), Size, Len(Returns(2))
t4# = Timer(0.001)
Print "Fillstring concatenation with n+n formula"
Fs$ = "" ' FinalString
t5# = Timer(0.001)
Print SlowFillString(Size, S$, Returns(3)), Size, Len(Returns(3))
t6# = Timer(0.001)
Print "Fillstring concatenation with STRING$ formula"
t7# = Timer(0.001)
Print FString(Size, S$, Returns(4)), Size, Len(Returns(4))
t8# = Timer(0.001)
Print
Print
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + String "; (t2# - t1#); t1#; t2#
Print Using " Steve & ###.#### ######.#### ######.#### "; "MID$ way "; t4# - t3#; t3#; t4#
Print Using " Tempo & ###.#### ######.#### ######.#### "; "String = String + Pattern "; t6# - t5#; t5#; t6#
Print Using " Steve & ###.#### ######.#### ######.#### "; "_MemFill Method "; t8# - t7#; t7#; t8#
Print
Print
For i = 1 To 4
Print Left$(Returns(i), 50)
Next
For i = 1 To 4
Print Right$(Returns(i), 50)
Next
For i = 1 To 4
If i = 3 Then _Continue
For j = i + 1 To 4
If j = 3 Then _Continue 'we know method 3 doesn't match as the fill lengths don't match
If Returns(i) <> Returns(j) Then
Print Using "Method # does not match results of method #"; i, j
broken = -1
End If
Next
Next
If Not broken Then Print "All Methods produce the same string."
End
Function FString (Size, bases As String, S As String)
$Checking:Off
Dim m As _MEM: m = _MemNew(Size)
_MemFill m, m.OFFSET, Size, bases
S = Space$(Size)
_MemGet m, m.OFFSET, S
_MemFree m
FString = -1
$Checking:On
End Function
Function FillString (Size As Long, Bases As String, S As String)
FillString = 0
S = Bases
Do
S = S + S
Loop Until Len(S) > Size
S = Left$(S, Size)
FillString = -1
End Function
Function FillString2 (Size As Long, Bases As String, S As String)
'Tempo's original routine modified by STEVE in an attempt to improve speeds.
'It worked a widdle bit.
$Checking:Off
FillString2 = 0
Dim posi As Long
S = Space$(Size)
posi = 1
b$ = Bases
Do
count = count + 1
l = Len(b$)
Mid$(S, posi, l) = b$
posi = posi + l
If count Mod 10 = 0 Then b$ = Left$(S, posi - 1)
Loop Until posi > Size
S = Left$(S, Size)
FillString2 = -1
$Checking:On
End Function
Function SlowFillString (Size As Long, Bases As String, S As String)
SlowFillString = 0
Dim As Double Starts, Ends
Dim Counter As Long
Starts = Timer(.001)
Ends = 10#
Counter = 0
Do
Counter = Counter + 1
S = S + Bases
Loop Until Len(S) > Size Or (Timer(.001) - Starts >= Ends)
Print , Counter; " cycles", Len(S); " lenght of string vs max size"; Size
S = Left$(S, Size)
SlowFillString = -1
End Function
Give that a shot and see how it does on your machine for you.