DaniWeb Forum Index > Software Development > Visual Basic 4 / 5 / 6

WordScramble expert needed

Please support our Visual Basic 4 / 5 / 6 advertiser: Programming Forums - DaniWeb Sister Site

•

Join Date: Nov 2005

Posts: 2

Reputation: spinnetje is an unknown quantity at this point

Solved Threads: 0

spinnetje

Offline

Newbie Poster

WordScramble expert needed

Nov 9th, 2005

Hi, i'm a bit of a VB-virgin in destress

I've wrote some vb6 to manipulate words in a text-box.
It has some bugs but it does the main job.
I like to compare it with a real VB-expert solution.
Does any of you can show me a small program witch can:

scan the textbox witch contains a text-document (some text lines) for words.
jump to a sub so the letters of that word can be scrambled
and jump back and replace the original word
then find the next word in the document, until the end of the document.
all other characters in the sentence need to be ignored witch are not a part of the abc (26 letters)
only words witch are 4 or more cahracters of length ought to be manipulated

so far i've got this:

'==============================================
'Written by spinnetje 05-11-2005
'Visual Basic 6 - WordScramble
'==============================================
Option Explicit
'load a text file
Private Sub cmdFile_Click()
Dim strTemp As String
On Error GoTo dropout
strTemp = txtFile
txtFile = ""
dlg.FileName = "*.txt"
dlg.ShowOpen
If Dir(dlg.FileName) <> "" Then
txtFile = ""
Open dlg.FileName For Input As 1
While Not EOF(1)
Line Input #1, strTemp
txtFile = txtFile & strTemp & vbCrLf
Wend
Close #1
Else
dropout:
txtFile = strTemp
MsgBox "File not found"
End If
End Sub
-------------------------------------------------------
Private Sub cmdReplace_Click()
'only scramble single given word
opnieuw:
swpReplace
If txtFind = txtReplace And Len(txtReplace) > 3 Then GoTo opnieuw
' If Len(txtFile.SelText) > 0 Then txtFile.SelText = txtReplace
End Sub
-------------------------------------------------------
Private Sub swpReplace()
'scramble all found words
On Error GoTo weg
Dim leng1, x, y, ts, sw(20), rn, lp, jmr As Integer
Dim t$, tst$, m$, h(20) As String
leng1 = Len(txtFind)
If leng1 < 3 Or leng1 > 20 Then
weg:
Exit Sub
End If
y = 0
jmr = 0
x = 1
m$ = ""
tst$ = " ,.-!?$)" + Chr$(13)
ts = Len(tst$)
leng1 = leng1 - 1

'filter words by recognision of one of the characters of TST$
Do
x = x + 1
t$ = Mid$(txtFind, x, 1)

'check if not normal character
For y = 1 To ts
If t$ = Mid$(tst$, y, 1) Then
jmr = 1
Me.txtFind = Left$(Me.txtFind, x - 1)
End If
Next y
'finnish test

h(x) = t$
Loop While x < leng1
If jmr = 0 Then

'scramble

///SCRAMBLE CODE witch scrambles: txtReplace ////

'scramble done

Else
txtReplace = txtFind
End If
End Sub
-------------------------------------------------------
Private Sub cmdFindWords_Click()
Dim lngNumberOfWords, src, tlr As Long
Dim onemoment As String
Dim strWordArray() As String
'remove extra spaces
onemoment = Me.txtFile.Text

'split it
strWordArray = Split(onemoment, " ")

'Count words
lngNumberOfWords = UBound(strWordArray) + 1
Me.Teller.Text = Str$(lngNumberOfWords)
Me.txtFile.Text = ""
For src = 0 To Str$(lngNumberOfWords) - 1
Me.txtFind = strWordArray(src)
tlr = 0

again:
tlr = tlr + 1
swpReplace
If txtFind = txtReplace And Len(txtReplace) > 3 And tlr < 3 Then GoTo again
strWordArray(src) = txtReplace
Me.txtFile.Text = Me.txtFile.Text + txtReplace + " "
txtReplace = ""
Next src
Me.txtFile.Text = Left$(Me.txtFile.Text, Len(Me.txtFile.Text) - 1)
End Sub
------------------------------------------------
used:
textboxes: txtFile / txtFind / txtReplace
buttons: cmdFile / cmdReplace / cmdFindWords

Your feedback will be greatly appreciated !! :lol:

•

Join Date: May 2005

Posts: 41

Reputation: mrmike is an unknown quantity at this point

Solved Threads: 0

mrmike

Offline

Light Poster

Re: WordScramble expert needed

Nov 11th, 2005

create a form with 2 richtextboxes and one command button on it.

next try the following code

 Help with Code Tags 
 Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text) 
Private Sub Command1_Click()
Dim lvStart As Integer
Dim lvEnd As Integer
 
Randomize (Timer)
lvStart = 1
lvOld = 1
RichTextBox2.Text = ""
RichTextBox2.Refresh
RichTextBox1.Text = Replace(RichTextBox1.Text, "  ", " ")
Do
 lvStart = InStr(lvOld, RichTextBox1.Text, " ")
 If lvStart > 0 Then
  RichTextBox2.Text = RichTextBox2.Text + Scramble(Mid$(RichTextBox1.Text, lvOld, lvStart - lvOld)) + " "
  lvOld = lvStart + Len(" ")
 End If
 If lvStart = 0 And lvOld < Len(RichTextBox1.Text) Then
  RichTextBox2.Text = RichTextBox2.Text + Scramble(Mid$(RichTextBox1.Text, lvOld, Len(RichTextBox1.Text) - lvOld + 1)) + " "
 End If
Loop Until lvStart = 0
End Sub
 
Function Scramble(tempstr As String) As String
Dim myloop As Integer
Dim mystring As String
Dim MyValue
MyValue = 0
If Len(tempstr) < 4 Then
 Scramble = tempstr
 Exit Function
End If
mystring = ""
myloop = 0
 While Len(tempstr) > 0
  While MyValue = 0 And Len(tempstr) <> 0
   MyValue = Int((Len(tempstr) * Rnd) + 1)
  Wend
  mychar = Mid$(tempstr, MyValue, 1)
  mystring = mystring + mychar
  tempstr = Mid(tempstr, 1, MyValue - 1) + Mid(tempstr, MyValue + 1, Len(tempstr))
  MyValue = 0
 Wend
Scramble = mystring
End Function
Private Sub Command1_Click()
Dim lvStart As Integer
Dim lvEnd As Integer

Randomize (Timer)
lvStart = 1
lvOld = 1
RichTextBox2.Text = ""
RichTextBox2.Refresh
RichTextBox1.Text = Replace(RichTextBox1.Text, "  ", " ")
Do
 lvStart = InStr(lvOld, RichTextBox1.Text, " ")
 If lvStart > 0 Then
  RichTextBox2.Text = RichTextBox2.Text + Scramble(Mid$(RichTextBox1.Text, lvOld, lvStart - lvOld)) + " "
  lvOld = lvStart + Len(" ")
 End If
 If lvStart = 0 And lvOld < Len(RichTextBox1.Text) Then
  RichTextBox2.Text = RichTextBox2.Text + Scramble(Mid$(RichTextBox1.Text, lvOld, Len(RichTextBox1.Text) - lvOld + 1)) + " "
 End If
Loop Until lvStart = 0
End Sub

Function Scramble(tempstr As String) As String
Dim myloop As Integer
Dim mystring As String
Dim MyValue
MyValue = 0
If Len(tempstr) < 4 Then
 Scramble = tempstr
 Exit Function
End If
mystring = ""
myloop = 0
 While Len(tempstr) > 0
  While MyValue = 0 And Len(tempstr) <> 0
   MyValue = Int((Len(tempstr) * Rnd) + 1)
  Wend
  mychar = Mid$(tempstr, MyValue, 1)
  mystring = mystring + mychar
  tempstr = Mid(tempstr, 1, MyValue - 1) + Mid(tempstr, MyValue + 1, Len(tempstr))
  MyValue = 0
 Wend
Scramble = mystring
End Function

as you can see the above does exactly what you want in less code, you'll just have to modify it for characters you don't want moving about

if loading the text in just load it straight to the box

regards
mrmike