WordScramble expert needed

Expand Post »

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:

Similar Threads

Urgent Pascal Expert Needed in Pascal and Delphi
Java Expert (Needed) in Java

spinnetje

Reputation Points: 10

Solved Threads: 0

Newbie Poster

Offline

2 posts
since Nov 2005

Permalink

Nov 11th, 2005

Re: WordScramble expert needed

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

next try the following code

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

mrmike

Reputation Points: 11

Solved Threads: 0

Light Poster

Offline

41 posts
since May 2005

Permalink

Nov 11th, 2005

Re: WordScramble expert needed

Great mrmike !!!!
I'ved used first part of your code.
Told you i am a newbe so i wil find out how that part works line by line

The scramble part i made special. (may need you again to help lose "code-overweight") :mrgreen:

Thanx again.

spinnetje

Reputation Points: 10

Solved Threads: 0

Newbie Poster

Offline

2 posts
since Nov 2005

This thread is more than three months old

No one has posted to this discussion for at least three months. Please let old threads die and do not reply to them unless you feel you have something new and valuable to contribute that absolutely must be added to make the discussion complete. Otherwise, please start a new thread in this forum instead.

Previous Thread in Visual Basic 4 / 5 / 6 Forum Timeline: Help! Got external program to open from VB6 but now??

Next Thread in Visual Basic 4 / 5 / 6 Forum Timeline: Beginner- Karoke Style Needed

DaniWeb Message

Cancel Changes

User Name
Password