Results 1 to 1 of 1

Thread: VB6 - Word generator

  1. #1

    Thread Starter
    Junior Member
    Join Date
    Apr 2004
    Location
    Holland
    Posts
    22

    VB6 - Word generator

    This is a simple word generator, it does the folloing things:
    • Choosing letters by using a random generator wich works between one and the length of the word
    • The problem of only choosing words with ascii wich have been used in the original word is sorted by removing that ascii instantly, so word = wod if the loop uses a r
    • The program checks for doubled words in a list by using another loop.


    Controls:
    Label: lblLength
    HScrollbar: hsbScroll
    List: lstList

    Don't care about placing the controls, the code will do that for you.

    A possible solution:

    VB Code:
    1. Option Explicit
    2.  
    3. Const cstNumberNW = 10
    4. 'Each movement of the scrollbar create a maximum if 10 new words
    5. Const cstNumberTests = 100
    6. 'Do a maximum of 100 tests each search
    7.  
    8. Private Sub Form_Click()
    9.      lstList.Clear
    10. End Sub
    11.  
    12. Private Sub Form_Load()
    13.      Randomize Timer
    14.      Me.Caption = "Word generator?"
    15. End Sub
    16.  
    17. Private Sub lstList_Click()
    18.      lstList.RemoveItem lstList.ListIndex
    19. End Sub
    20.  
    21. Private Sub Word_KeyPress(KeyAscii As Integer)
    22.      If KeyAscii = vbKeyReturn Then
    23.           'At least 2 signs
    24.           If Len(Word) > 1 Then
    25.                'Set scrollbar
    26.                hsbScroll.Max = Len(Word.Text)
    27.                hsbScroll.Min = 1
    28.                '\ gives a round number
    29.                hsbScroll.Value = hsbScroll.Max \ 2
    30.                lblLength.Caption = hsbScroll.Value
    31.                KeyAscii = 0
    32.           End If
    33.      End If
    34. End Sub
    35.  
    36. Private Sub hsbScroll_Change()
    37.      If hsbScroll.Value > 1 And Len(Word) > 1 Then
    38.      'Only words of 2 or more signs
    39.           'Show the setup of the scrollbar
    40.           lblLength.Caption = hsbScroll.Value
    41.           'Declarations
    42.           Dim strSign As String, strFoundWord As String
    43.           Dim strTWord As String
    44.           Dim intNumberGenerated As Integer, intLFound As Integer
    45.           Dim intPosition As Integer, intListPointer As Integer
    46.           Dim intNumberLoops As Integer
    47.           'Number of words to be generated
    48.           intNumberGenerated = 1
    49.           Do Until intNumberGenerated = cstNumberNW + 1 Or _
    50.                     intNumberLoops > cstNumberTests
    51.                intNumberLoops = intNumberLoops + 1
    52.                intLFound = 1
    53.                strTWord = Word
    54.                Do
    55.                     'Choose a random sign from the word
    56.                     strSign = Mid(strTWord, Int(Len(strTWord) _
    57.                          * Rnd + 1), 1)
    58.                     'Where in the word is the sign
    59.                     intPosition = InStr(1, strTWord, strSign)
    60.                     'Delete this sign from TWord becouse
    61.                     'a sign may only be used once
    62.                     Select Case intPosition
    63.                          Case 1                    'First sign
    64.                                         strTWord = Right(strTWord, _
    65.                                                             Len(strTWord) - 1)
    66.                          Case Len(strTWord)   'Last sign
    67.                                         strTWord = Left(strTWord, _
    68.                                                             Len(strTWord) - 1)
    69.                          Case Else                 'Somewhere in the middle
    70.                                         strTWord = Left(strTWord, _
    71.                                         InStr(1, strTWord, strSign) _
    72.                                         - 1) & Right(strTWord, InStr(1, _
    73.                                         strSign, strTWord) + 1)
    74.                     End Select
    75.                     'Add sign
    76.                     strFoundWord = strFoundWord + strSign
    77.                     intLFound = intLFound + 1
    78.                Loop Until intLFound > hsbScroll.Value Or _
    79.                     Len(strTWord) = 0
    80.                'Check if the found word is already in the list
    81.                intListPointer = 0
    82.                Do Until intListPointer = lstList.ListCount
    83.                     intListPointer = intListPointer + 1
    84.                     'If the word is in the list
    85.                     If strFoundWord = lstList.List(intListPointer _
    86.                          - 1) Then
    87.                          strFoundWord = ""
    88.                          intListPointer = lstList.ListCount
    89.                     End If
    90.                Loop
    91.                'Add a new word to the list
    92.                If Len(strFoundWord) Then
    93.                     lstList.AddItem strFoundWord
    94.                     Me.Caption = "Word generator, generated: " & _
    95.                          lstList.ListCount & " words so far"
    96.                     DoEvents                    'Give windows the chance
    97.                                                     'to edit the form
    98.                     strFoundWord = ""
    99.                End If
    100.                Me.Caption = "Word generator, so far: " & lstList.ListCount & _
    101.                     " / Test: " & intNumberLoops
    102.           Loop
    103.      End If
    104. End Sub

    Added is a picture of the interface, with control information.
    Also added is a zip file with the full project.

    Koen
    Attached Images Attached Images  
    Attached Files Attached Files

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