Results 1 to 8 of 8

Thread: Help, What Is The Code To Scramble Words In A Text Box?

  1. #1

    Thread Starter
    Hyperactive Member flame_211's Avatar
    Join Date
    Jun 2000
    Location
    I dont really think I know where I am???
    Posts
    393
    Help, What Is The Code To Scramble Words In A Text Box?

    Flame
    Reach me at:
    AIM: FlameWide
    AIM: Itz deep6
    MSN/Email: flame_gandalf@hotmail.com

    Check out these sites:
    My Blog

  2. #2
    Lively Member
    Join Date
    Oct 2000
    Location
    Chicago
    Posts
    97

    Not clear

    Not clear as what you want..Can you be more specific about your need
    Anil

  3. #3

    Thread Starter
    Hyperactive Member flame_211's Avatar
    Join Date
    Jun 2000
    Location
    I dont really think I know where I am???
    Posts
    393
    I mean i want to know the code toscramble a word, just scramble it and put it into a text box.
    Reach me at:
    AIM: FlameWide
    AIM: Itz deep6
    MSN/Email: flame_gandalf@hotmail.com

    Check out these sites:
    My Blog

  4. #4
    Serge's Avatar
    Join Date
    Feb 1999
    Location
    Scottsdale, Arizona, USA
    Posts
    2,744
    You can reverse the word:
    Code:
    Dim strWord As String
    
    strWord = StrReverse("MyWord")
    MsgBox strWod

  5. #5
    Fanatic Member ExcalibursZone's Avatar
    Join Date
    Feb 2000
    Location
    Western NY State
    Posts
    908
    Define scramble:
    Do you have a set idea on what you want (IE: phase shift the alphabet left or right by a certain number of characters), an encryption, a 'word jumble' or 'cryptoquip', or a random placing of existing letters into different positions?
    -Excalibur

  6. #6
    Guest
    Code:
    Private Function scrambleword(Word$)
    Static letter(1000)
    Static KK(1000)
    S = Word$
    tak = 0
    
    For Y = 1 To Len(S)
    p = p + 1
    letter(p) = Mid(S, Y, 1)
    Next Y
    
    For Q = 1 To Len(S) '- 1
    again:
    Randomize Timer
    F = Int(Rnd * Len(S) + 1)
    If F = 0 Then GoTo again
    For W = 0 To tak
    If F = KK(W) Then GoTo again
    Next W
    tak = tak + 1
    KK(tak) = F
    tempt = tempt & letter(F)
    Next Q
    scrambleword = tempt '& Right(S, 1)
    End Function
    
    
    Usage
    
    Private Sub Command1_Click()
    
    MsgBox scrambleword("Scramble")
    
    End Sub

  7. #7
    Hyperactive Member
    Join Date
    Aug 2000
    Posts
    258
    Visual Basic 6 SP4 on win98se

    QUIT THE RAT RACE BECAUSE YOUR MESSING THE WORLD UP !!!!!

  8. #8
    _______ HeSaidJoe's Avatar
    Join Date
    Jun 1999
    Location
    Canada
    Posts
    3,946

    <?>

    Code:
    'being as every one has had a guess, my guess is you
    'would like to scramble the words around so here it is
    
    'you first split the string into individual words
    'you then randomize a collection of the count of the words
    'then you redim your zero based myArr to a 1 based array
    '
    'then you read the array back using the random numbers as the
    'order in which the words are recalled from the array.
    '
    'add a command button and a text box  (Command1 and Text1)
    '
    'for the split function to work you need VB6 and if you don't have it
    'do a search or post for it cause there is a function for VB5 written by
    'Aaron Young (Least I think that is who posted it.)
    
    Option Explicit
    
    Private Sub Command1_Click()
    
        Dim nTry As Integer
        Dim nAddCount As Integer
        Dim bFound As Integer
        Dim intCre As Integer
        Dim nDummy As Integer
        Dim MyCollection As New Collection
        Dim myString As String
        Dim myArr As Variant
        
        myString = Text1.Text
        
        myArr = Split(myString, " ")
        nAddCount = UBound(myArr) + 1
        
        Randomize
        
        Do Until intCre = UBound(myArr) + 1
            nTry = Int((nAddCount * Rnd)) + 1
            
            On Error Resume Next
                nDummy = MyCollection.Item(CStr(nTry))
                bFound = (Err = 0)
            If bFound Then
                Err.Clear
            Else
                MyCollection.Add nTry, CStr(nTry)
                intCre = intCre + 1
             End If
        Loop
            
         Dim myArray()
         Dim i As Integer
         
         Text1.Text = ""
         
         ReDim Preserve myArr(1 To nAddCount)
         
         For i = 1 To nAddCount
         
           ReDim Preserve myArray(i)
           myArray(i) = MyCollection(i)
           
           If i = 1 Then
            Text1.Text = myArr(myArray(i))
           Else
            Text1.Text = Text1.Text & " " & myArr(myArray(i))
           End If
           
         Next i
                  
       End Sub
    "A myth is not the succession of individual images,
    but an integerated meaningful entity,
    reflecting a distinct aspect of the real world."

    ___ Adolf Jensen

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width