create multiple copies of a string

Hello,

In REXX, I can create a specified number (92 in this example) of hyphens like this:

COPIES('-',92)

Is there an equivalent function in VB ?

Thanks...

Dim s As String

s = String(92, "-")

Here is a function that works just like String$ function, but you can pass strings longer than 1 character:

Code:

---

Public Function Replicate(ByVal Count As Long, ByRef Text As String) As String
    If Len(Text) > 1 Then
        If Count > 1 Then
            Replicate = Space$(Len(Text) * Count)
            Mid$(Replicate, 1, Len(Text)) = Text
            Mid$(Replicate, Len(Text) + 1) = Replicate
        ElseIf Count = 1 Then
            Replicate = Text
        End If
    Else
        Replicate = String$(Count, Text)
    End If
End Function

---

Check this out for multiple identical strings (92 Johns, in this case):

Code:

---

Private Sub Command1_Click()
Dim MyString As String
MyString = Replace(Space$(92), " ", "John")
MsgBox MyString
End Sub

---

Code Doc, you forgot one of your own thread of more than 7 months ago, so you went back to the slowest (but shortest) method.
http://www.vbforums.com/showthread.php?t=524574

Merri and other experts also had big contributions in that thread.

Oddly enough, the code I posted here is not featured in that thread :) I didn't know about Mid$'s native replication ability at that time. And it is just as fast as Logophobic's CopyMemory method.


Edit!
Experience is a weird thing. I downloaded the benchmark from the thread linked by anhn and wrote a new optimized code using the new things that I've picked up within the past year:

Code:

---

Option Explicit

Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Dim lngLen As Long
    lngLen = LenB(Text)
    If lngLen Then
        If Count > 1 Then
            PutMem4 VarPtr(Merri), SysAllocStringByteLen(0, lngLen * Count)
            MidB$(Merri, 1, lngLen) = Text
            MidB$(Merri, lngLen + 1) = Merri
        ElseIf Count = 1 Then
            Merri = Text
        End If
    End If
End Function

---

anhn: 0,73281
Logophobic: 0,32319
dilettante: 4,52065
leinad31: 0,40865
Merri: 0,20261

Updated the code to work correctly with one character and half character strings:

Code:

---

Option Explicit

Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal Ptr As Long, ByVal Length As Long) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Dim lngLen As Long
    lngLen = LenB(Text)
    If lngLen Then
        If Count > 1 Then
            PutMem4 VarPtr(Merri), SysAllocStringByteLen(0, lngLen * Count)
            MidB$(Merri, 1, lngLen) = Text
            If lngLen > 2 Then
                MidB$(Merri, lngLen + 1) = Merri
            ElseIf lngLen = 2 Then
                MidB$(Merri, 3, 2) = Text
                If Count > 2 Then MidB$(Merri, 5) = Merri
            ElseIf lngLen = 1 Then
                MidB$(Merri, 2, 1) = Text
                If Count > 2 Then MidB$(Merri, 3, 1) = Text
                If Count > 3 Then MidB$(Merri, 4, 1) = Text
                If Count > 4 Then MidB$(Merri, 5) = Merri
            End If
        ElseIf Count = 1 Then
            Merri = Text
        End If
    End If
End Function

---

Quote:

---

Originally Posted by anhn

Code Doc, you forgot one of your own thread of more than 7 months ago, so you went back to the slowest (but shortest) method.
http://www.vbforums.com/showthread.php?t=524574

Merri and other experts also had big contributions in that thread.

---

No, I did not forget it. I couldn't find the thread, and now I'm snarled up in a huge application. :blush:

Logophobic built some super-fast code on that thread also. However, in my own fruitless defense, OP appeared to be looking for a small, simple solution rather than a brute. :eek:

Thanks for the Link.

For what it's worth, here's some simplistic code that will likely be much faster than using the Replace() function for building a big string that repeats a little one. Again, I will build 92 Johns:

Code:

---

Const Repeats = 92 ' Adjust as you see fit

Private Sub Command1_Click()
Dim MyString As String, StrLen As Long
MyString = "John"
StrLen = Len(MyString) * Repeats
Do While Len(MyString) < StrLen
    MyString = MyString & MyString
Loop
MyString = Left$(MyString, StrLen)
MsgBox MyString
End Sub

---

That might save a few nanoseconds because the string grows nonlinearly--2, 4, 8, 16, 32, etc. Worst-case scenario is that the next to the last loop builds a string that is only a few bytes less than the required length, so Left$() has to truncate it almost in half at the finish.

Inlined longer code is already hard to follow. To make comparing code lengths easier, here is a function version of your code:

Code:

---

Public Function Code_Doc(ByVal Count As Long, ByRef Text As String) As String
    Dim StrLen As Long
    Code_Doc = Text
    StrLen = Len(Code_Doc) * Count
    Do While Len(Code_Doc) < StrLen
        Code_Doc = Code_Doc & Code_Doc
    Loop
    Code_Doc = Left$(Code_Doc, StrLen)
End Function

---

Here is a compacted version of my code for comparison:

Code:

---

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Merri = String$(Len(Text) * Count, Text)
    Mid$(Merri, 1, Len(Text)) = Text
    Mid$(Merri, Len(Text) + 1) = Merri
End Function

---

Quote:

---

Originally Posted by Merri

Inlined longer code is already hard to follow. To make comparing code lengths easier, here is a function version of your code:

Code:

---

Public Function Code_Doc(ByVal Count As Long, ByRef Text As String) As String
    Dim StrLen As Long
    Code_Doc = Text
    StrLen = Len(Code_Doc) * Count
    Do While Len(Code_Doc) < StrLen
        Code_Doc = Code_Doc & Code_Doc
    Loop
    Code_Doc = Left$(Code_Doc, StrLen)
End Function

---

Here is a compacted version of my code for comparison:

Code:

---

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Merri = String$(Len(Text) * Count, Text)
    Mid$(Merri, 1, Len(Text)) = Text
    Mid$(Merri, Len(Text) + 1) = Merri
End Function

---

---

Merri, your modified code is easy to understand by anyone (including me) and it executes faster that anything I have ever seen written on this issue. (Swapping is ramarkably fast and enjoys a lack of concatenation, which is notoriously slow--perhaps even when concatenation grows strings in a non-linear rate, as I posted). :thumb:

I believe that Logophobic might also agree, but he needs to test your above posted function against his code that he posted last year that was also easy to understand but yet lightning quick.;)

Quote:

---

Originally Posted by Merri

Inlined longer code is already hard to follow. To make comparing code lengths easier, here is a function version of your code:

Code:

---

Public Function Code_Doc(ByVal Count As Long, ByRef Text As String) As String
    Dim StrLen As Long
    Code_Doc = Text
    StrLen = Len(Code_Doc) * Count
    Do While Len(Code_Doc) < StrLen
        Code_Doc = Code_Doc & Code_Doc
    Loop
    Code_Doc = Left$(Code_Doc, StrLen)
End Function

---

Here is a compacted version of my code for comparison:

Code:

---

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Merri = String$(Len(Text) * Count, Text)
    Mid$(Merri, 1, Len(Text)) = Text
    Mid$(Merri, Len(Text) + 1) = Merri
End Function

---

---

Merri, your modified code is easy to understand by anyone (including me) and it executes faster that anything I have ever seen written on this issue. (Swapping is ramarkably fast and enjoys a lack of concatenation, which is notoriously slow--perhaps even when concatenation grows strings in a non-linear rate, as I posted). :thumb:

I believe that Logophobic might also agree, but he needs to test your above posted function against his code that he posted last year that was also easy to understand but yet lightning quick.;)

I am really impressed with what you have written here, and I can easily adapt it to my all of applications. :cool:

Here is my version of Merri's code, attached to a command button to generate 92 Johns:

Code:

---

Private Sub Command1_Click()
Dim Merri As String, Text As String, Count As Integer
Text = "John": Count = 92
Merri = String$(Len(Text) * Count, Text)
Mid$(Merri, 1, Len(Text)) = Text
Mid$(Merri, Len(Text) + 1) = Merri
MsgBox Merri
End Sub

---

What is not obvious to anyone, except perhaps Merri, is how this code works with no looping whatsoever. Mid$() is powerful. Once again: :thumb:

It probably wasn't obvious to Merri either. I played with it for a minute, and found that Mid() is not able to repeat a single character string. I scratched my head for another minute before I realized exactly what was going on: Mid() copies 4 bytes (2 characters) at a time. Merri's compact function does repeat a single character because it uses String$() to initialize the return string.

Here's what the Mid() statement is doing:

Code:

---

s="123------"
Mid(s, 4) = s

Read  4 bytes from s: "123------"
Write 4 bytes  to  s: "12312----"

Read  4 bytes from s: "12312----"
Write 4 bytes  to  s: "1231231--"

Read  4 bytes from s: "1231231--"
Write 4 bytes  to  s: "123123123"

---

I've noticed that Mid() is less efficient when length of the string being repeated is odd. This can be alleviated by copying the text twice before using the Mid() statement for additional replication.

Code:

---

Public Function Merri(ByVal Count As Long, ByRef Text As String) As String
    Merri = String$(Len(Text) * Count, Text)
    If Len(Text) > 1 Then
        Mid$(Merri, 1, Len(Text)) = Text
        If Count > 1 Then Mid$(Merri, Len(Text) + 1) = Merri
    End If
End Function

Public Function MerriLogo(ByVal Count As Long, ByRef Text As String) As String
    MerriLogo = String$(Len(Text) * Count, Text)
    If Len(Text) > 1 Then
        Mid$(MerriLogo, 1, Len(Text)) = Text
        If Count > 1 Then
            Mid$(MerriLogo, Len(Text) + 1, Len(Text)) = Text
            If Count > 2 Then Mid$(MerriLogo, Len(Text) + Len(Text) + 1) = MerriLogo
        End If
    End If
End Function

---

It appears to me that the OP who asked for a very simple answer to a very simple question may have a slight problem determining which one of the contest examples to pick from.

Quote:

---

Originally Posted by jmsrickland

It appears to me that the OP who asked for a very simple answer to a very simple question may have a slight problem determining which one of the contest examples to pick from.

---

I think that at this point, Merri and Logophobic have driven us all loco, encouraged somewhat by AnHn. My hat's off to all three of them. :bigyello:

pssst... Merri may need to check Logophobic's odd/even string length claim.

This code generate's 92 Sues just as easily as it generates 92 Johns and also works with single-character and double-character strings. I'm not sure where or how it is going to fail:

Code:

---

Private Sub Command1_Click()
Dim Merri As String, Text As String, Count As Integer
Text = "Sue": Count = 92
Merri = String$(Len(Text) * Count, Text)
Mid$(Merri, 1, Len(Text)) = Text
Mid$(Merri, Len(Text) + 1) = Merri
MsgBox Merri
End Sub

---

Another version:

Code:

---

Function RepeatStr(sText As String, Count As Long) As String
  If Len(sText) And (Count > 0) Then
      RepeatStr = Space$(Len(sText) * Count)
      LSet RepeatStr = sText
      Mid$(RepeatStr, Len(sText) + 1) = RepeatStr
  End If
End Function

---