Hangman Style Search (1 Viewer)

murray83

Games Collector
Local time
Today, 08:44
Joined
Mar 31, 2017
Messages
728
Howdy access gods

Question is can you or is there a function with vba or sql to check whether a string in a text box contains certain characters

so if the word was "Microsoft and the user asked does it have any O it would then put two O's and if it was word without any O it would then add a bit of the gallows


cheers
 

theDBguy

I’m here to help
Staff member
Local time
Today, 01:44
Joined
Oct 29, 2018
Messages
21,357
Hi. Don't think there's anything pre-built. You can certainly create one.
 

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 08:44
Joined
Jul 9, 2003
Messages
16,243
Well, it depends on whether you are actually making a hangman game or not. If you're going to make a hangman game then you will want to divide your word out, with each letter in a single text box..

More information is required before the the correct answer can be given.

However to give you a start, have a look at this vb6 code, it should give you some ideas on how to go about it, in fact that's where I got the idea of putting each letter in a separate text box!

http://www.vbforums.com/showthread.php?699415-RESOLVED-Need-help-creating-quot-Hangman-quot-program


Code:
Option Explicit
Dim myWord As String
Dim myLetters() As String
Dim numWrongGuesses As Integer
Dim bCorrect As Boolean
Private Sub Command1_Click()
Dim myGuess As String, numBlacks As Integer, X As Integer, y As Integer
numBlacks = 0
myGuess = UCase(InputBox("Guess a Letter"))
If Len(myGuess) = 1 Then
    bCorrect = False
    For X = 0 To Len(myWord) - 1  'number of visible text boxes
        If myGuess = Text1(X).Text Then
            Text1(X).ForeColor = vbBlack
            bCorrect = True
            For y = 0 To Len(myWord) - 1
                If Text1(y).ForeColor = vbBlack Then
                   numBlacks = numBlacks + 1
                   If numBlacks = Len(myWord) Then
                      MsgBox ("Congratulations!  You WIN!")
                   End If
                End If
            Next y
         End If
     Next X
     If bCorrect = False Then
        numWrongGuesses = numWrongGuesses + 1
        Label1.Visible = True
        Timer1.Enabled = True
        drawman
     End If
End If
End Sub
Private Sub drawman()
    Select Case numWrongGuesses
    Case 1
       Shape1.Visible = True
    Case 2
       Shape1.Visible = True
       Line1.Visible = True
    Case 3
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
    Case 4
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
    Case 5
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
       Line4.Visible = True
    Case 6
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
       Line4.Visible = True
       Line5.Visible = True
       MsgBox "You Lose!"
       Dim X As Integer
       For X = 0 To Len(myWord) - 1
           Text1(X).ForeColor = vbBlack
       Next X
    End Select
End Sub
Private Sub Command2_Click()
Dim X As Integer
For X = 0 To 9
   Text1(X).Visible = False
Next X
List1.ListIndex = Val(Combo1.Text) - 1
myWord = List1.Text
ReDim myLetters(Len(myWord)) As String
For X = 0 To Len(myWord) - 1
   Text1(X).Visible = True  'temp for testing
   Text1(X).Text = Mid(myWord, X + 1, 1)
   Text1(X).ForeColor = vbWhite
Next X
Shape1.Visible = False
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Line5.Visible = False
End Sub
Private Sub Form_Load()
List1.AddItem ("COMPUTER")
List1.AddItem ("HOUSE")
List1.AddItem ("VISUAL")
List1.AddItem ("BASIC")
List1.AddItem ("STUDIO")
List1.AddItem ("LESSONS")
Dim X As Integer
For X = 0 To List1.ListCount - 1
    Combo1.AddItem Str(X + 1)
Next X
Combo1.Text = "1"
End Sub
Private Sub Timer1_Timer()
Label1.Visible = False
Timer1.Enabled = False
End Sub
 

murray83

Games Collector
Local time
Today, 08:44
Joined
Mar 31, 2017
Messages
728
Well, it depends on whether you are actually making a hangman game or not. If you're going to make a hangman game then you will want to divide your word out, with each letter in a single text box..

More information is required before the the correct answer can be given.

However to give you a start, have a look at this vb6 code, it should give you some ideas on how to go about it, in fact that's where I got the idea of putting each letter in a separate text box!

http://www.vbforums.com/showthread.php?699415-RESOLVED-Need-help-creating-quot-Hangman-quot-program


Code:
Option Explicit
Dim myWord As String
Dim myLetters() As String
Dim numWrongGuesses As Integer
Dim bCorrect As Boolean
Private Sub Command1_Click()
Dim myGuess As String, numBlacks As Integer, X As Integer, y As Integer
numBlacks = 0
myGuess = UCase(InputBox("Guess a Letter"))
If Len(myGuess) = 1 Then
    bCorrect = False
    For X = 0 To Len(myWord) - 1  'number of visible text boxes
        If myGuess = Text1(X).Text Then
            Text1(X).ForeColor = vbBlack
            bCorrect = True
            For y = 0 To Len(myWord) - 1
                If Text1(y).ForeColor = vbBlack Then
                   numBlacks = numBlacks + 1
                   If numBlacks = Len(myWord) Then
                      MsgBox ("Congratulations!  You WIN!")
                   End If
                End If
            Next y
         End If
     Next X
     If bCorrect = False Then
        numWrongGuesses = numWrongGuesses + 1
        Label1.Visible = True
        Timer1.Enabled = True
        drawman
     End If
End If
End Sub
Private Sub drawman()
    Select Case numWrongGuesses
    Case 1
       Shape1.Visible = True
    Case 2
       Shape1.Visible = True
       Line1.Visible = True
    Case 3
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
    Case 4
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
    Case 5
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
       Line4.Visible = True
    Case 6
       Shape1.Visible = True
       Line1.Visible = True
       Line2.Visible = True
       Line3.Visible = True
       Line4.Visible = True
       Line5.Visible = True
       MsgBox "You Lose!"
       Dim X As Integer
       For X = 0 To Len(myWord) - 1
           Text1(X).ForeColor = vbBlack
       Next X
    End Select
End Sub
Private Sub Command2_Click()
Dim X As Integer
For X = 0 To 9
   Text1(X).Visible = False
Next X
List1.ListIndex = Val(Combo1.Text) - 1
myWord = List1.Text
ReDim myLetters(Len(myWord)) As String
For X = 0 To Len(myWord) - 1
   Text1(X).Visible = True  'temp for testing
   Text1(X).Text = Mid(myWord, X + 1, 1)
   Text1(X).ForeColor = vbWhite
Next X
Shape1.Visible = False
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Line5.Visible = False
End Sub
Private Sub Form_Load()
List1.AddItem ("COMPUTER")
List1.AddItem ("HOUSE")
List1.AddItem ("VISUAL")
List1.AddItem ("BASIC")
List1.AddItem ("STUDIO")
List1.AddItem ("LESSONS")
Dim X As Integer
For X = 0 To List1.ListCount - 1
    Combo1.AddItem Str(X + 1)
Next X
Combo1.Text = "1"
End Sub
Private Sub Timer1_Timer()
Label1.Visible = False
Timer1.Enabled = False
End Sub

cheers for that i thought some where along id have to split the word down this is what i have v basically put together, no laughing
 

Attachments

  • Hangman.accdb
    408 KB · Views: 79

murray83

Games Collector
Local time
Today, 08:44
Joined
Mar 31, 2017
Messages
728
Sorry for DP but have done a bit of more work and not sure but im thinking i need to count cycles when the player puts in a letter

see updated db attached
 

Attachments

  • Hangman.accdb
    420 KB · Views: 93

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 08:44
Joined
Jul 9, 2003
Messages
16,243
I'm not sure if you want this, I get the impression you want to build it yourself! However, if you want a pre-made one, then have a look at this....

By the way it's not mine and I have no idea where I got it from, I've had it for years!

 

Attachments

  • Hangman.zip
    131.7 KB · Views: 96
  • Hangman.JPG
    Hangman.JPG
    43.3 KB · Views: 231

murray83

Games Collector
Local time
Today, 08:44
Joined
Mar 31, 2017
Messages
728
I'm not sure if you want this, I get the impression you want to build it yourself! However, if you want a pre-made one, then have a look at this....

By the way it's not mine and I have no idea where I got it from, I've had it for years!


i shall look at the code and thanks yeah want to try and build it my self, but thanks again for pointers so far I may end up coming back for more hehe
 

murray83

Games Collector
Local time
Today, 08:44
Joined
Mar 31, 2017
Messages
728
hi you lovely people

so trying to search on that website which starts with a G, and all i can find on 'Next Item' is not of any help to me in access vba

as im trying to get the guessing part run through each square and then if it has the guessed letter put it

for now i haven't got an else i will have a counter and tries which link to a noose

but my code is wrong some slight help would be appreciated cheers

see attached for code and example
 

Attachments

  • ok.png
    ok.png
    23.6 KB · Views: 67
  • Hang wiv two forms.accdb
    548 KB · Views: 83

jdraw

Super Moderator
Staff member
Local time
Today, 04:44
Joined
Jan 23, 2006
Messages
15,361
Sorry about that. I didn't realize it was password protected. Should have checked- sorry.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:44
Joined
May 21, 2018
Messages
8,463
The code is not locked, just select show all access objects in the navigation pane.

Import your form into the database
Change code to
To modify the hangman to use a selected word instead of random word

Code:
Private Sub cmdChoose_Click()
  Dim wrd As String
  Me.Visible = False
  If Trim(Me.WordList & " ") <> "" Then
    wrd = Me.WordList
    DoCmd.OpenForm "frmHangMan", , , , , , wrd
  End If
End Sub

update the frmHangMan code to

I greatly reduced the code using some tags and commond functions.

Code:
Private Sub cmdReset_Click()
    'Start new game
    NewGame
    intPoints = 0
    lblPoints.Caption = "Points : " & intPoints
    HideBody
End Sub

Private Sub Form_Load()
  If Not Trim(Me.OpenArgs & " ") = "" Then
    NewGame
  End If
End Sub

Private Sub SelectWord()
    strWord = Me.OpenArgs
    ResetLetters
End Sub

Private Sub CheckLetter()
On Error GoTo ErrorHandler
    'Checks the letter entered against the random word
    Dim i As Integer
    Dim booGotLetter As Boolean
    dim ID as string
    booGotLetter = False
    Dim strSingleLetter As String
    
    'Go through the selected word
    For i = 1 To intWordLength
        'Get letter from word
        strSingleLetter = Right(Left(strWord, i), 1)
        
        'Check if selected letter is same as letter in word
        If strLetter = strSingleLetter Then
            
            'Increment got letters count
            intLettersGot = intLettersGot + 1
            booGotLetter = True
            
            'Place the letter on the board
            If I < 10 then 
              ID = "0" & I
            else
              id = cstr(i)
            end if
            me.controls("lblLetter" & ID).Caption = strLetter
        End If
    Next i
    
    'Check if the user got the whole word finished
    If intLettersGot = intWordLength Then
        'They have completed the word
        intPoints = intPoints + intHangman
        lblPoints.Caption = "Points : " & intPoints
        If MsgBox("Well done, you have beaten the hangman!" & vbCrLf & vbCrLf & _
            "Would you like another go?", vbYesNo, "Congratulations") = vbYes Then
            'User wants another go
            NewGame
        Else
            'Close form
            DoCmd.Close acForm, "frmHangman"
        End If
    End If
            
    'Check if the user got a letter
    If booGotLetter = False Then
        'Didn't get a letter
        intHangman = intHangman - 1
    End If
     
    'Update screen details
    lblTries.Caption = "Tries Remaining : " & intHangman
   hidebody
   head.Visible = (intHangman = 9)
   body.Visible = (intHangman = 8)
   right_arm.Visible = (intHangman = 7)
   left_arm.Visible = (intHangman = 6)
   right_leg.Visible = (intHangman = 5)
   left_leg.Visible = (intHangman = 4)
   right_hand.Visible = (intHangman = 3)
   left_hand.Visible = (intHangman = 2)
   right_foot.Visible = (intHangman = 1)
   'Check if the game is over!
    If intHangman = 0 Then
        'Game over
        intPoints = intPoints - 10
        If intPoints < 1 Then intPoints = 0
        lblPoints.Caption = "Points : " & intPoints
        hung.Visible = True
        If MsgBox("Sorry, you did not get the word!" & vbCrLf & vbCrLf & _
            "Would you like to try again?", vbYesNo, "Unlucky!") = vbYes Then
            'New game
            NewGame
            Exit Sub
        Else
            'Quit
            DoCmd.Close acForm, "frmHangman"
            Exit Sub
        End If
    End If
Exit Sub

ErrorHandler:
    'Close the form
    DoCmd.Close acForm, "frmHangman"
End Sub

Private Sub NewGame()
    'Set variables and screen for a new game
     SelectWord

    'Reset all the command buttons
     enableCommands
     'Hide body    
     resetBody
    
    'Reset letters got
     intLettersGot = 0
     intHangman = 10
     lblTries.Caption = "Tries Remaining : " & intHangman
End Sub

Public Sub EnableCommands
  dim ctrl as access.control
  for each ctrl in me.controls
   if ctrl.tag = "Command" then
     ctrl.enabled = true
   end if
  next ctrl
 

jdraw

Super Moderator
Staff member
Local time
Today, 04:44
Joined
Jan 23, 2006
Messages
15,361
Interesting -- still asking me for a password???


 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:44
Joined
May 21, 2018
Messages
8,463
My fault, I thought you were talking about the first db. The first DB is nicer in my opinion, but should be easy to modify the code. If you do not want the command buttons
 

jdraw

Super Moderator
Staff member
Local time
Today, 04:44
Joined
Jan 23, 2006
Messages
15,361
Yes, I thought there may be some miscommunication. I was just offering that link as another approach to code underlying "Hangman" for reference.
Glad the issue has been cleared.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:44
Joined
May 21, 2018
Messages
8,463
Instead of command buttons if you want it to work like the second version where you type into a textbox here is the code.

Code:
Option Compare Database
Private strWord As String
Private strLetter As String
Private intWordLength As Integer
Private intLettersGot As Integer
Private intHangman As Integer
Private intPoints As Integer
Private colLetters As Collection

Private Function ClickLetter()
  Dim ctrl As Access.CommandButton
  Set ctrl = Me.ActiveControl
  strLetter = Right(ctrl.Caption, 1)
  cmdReset.SetFocus
  ctrl.Enabled = False
  Call CheckLetter
End Function

Private Sub cmdCheck_Click()
  Dim tempLetter As String
  If Trim(Me.txtLetter & " ") <> "" Then
    tempLetter = Left(Me.txtLetter, 1)
    If (Asc(tempLetter) > 64 And Asc(tempLetter) < 98) Or (Asc(tempLetter) > 96 And Asc(tempLetter) < 123) Then
      strLetter = tempLetter
      Me.txtLetter = tempLetter
      If VerifyLetter(tempLetter) Then
        Call CheckLetter
      Else
        MsgBox "Letter already used", vbInformation
      End If
    End If
  End If
  Me.txtLetter.SetFocus
  Me.txtLetter.Text = ""
  Me.txtLetter = Null
End Sub
Public Function VerifyLetter(tempLetter As String) As Boolean
  'do it the lazy way
  Dim i As Integer
  For i = 1 To colLetters.Count
    If colLetters(i) = tempLetter Then Exit Function
  Next i
    VerifyLetter = True
    colLetters.Add (tempLetter)
End Function
Private Sub cmdReset_Click()
    'Start new game
    NewGame
    intPoints = 0
    lblPoints.Caption = "Points : " & intPoints
End Sub

Private Sub Form_Load()
  If Not Trim(Me.OpenArgs & " ") = "" Then
    strWord = Me.OpenArgs
    NewGame
  End If
End Sub
Private Sub CheckLetter()
On Error GoTo ErrorHandler
    'Checks the letter entered against the random word
    Dim i As Integer
    Dim booGotLetter As Boolean
    Dim id As String
    booGotLetter = False
    Dim strSingleLetter As String
    
    'Go through the selected word
    For i = 1 To intWordLength
        'Get letter from word
        strSingleLetter = Right(Left(strWord, i), 1)
        'Check if selected letter is same as letter in word
        If strLetter = strSingleLetter Then
            'Increment got letters count
            intLettersGot = intLettersGot + 1
            booGotLetter = True
            'Place the letter on the board
            If i < 10 Then
              id = "0" & i
            Else
              id = CStr(i)
            End If
            Me.Controls("lblLetter" & id).Caption = strLetter
        End If
    Next i
    
    'Check if the user got the whole word finished
    If intLettersGot = intWordLength Then
        'They have completed the word
        intPoints = intPoints + intHangman
        lblPoints.Caption = "Points : " & intPoints
        If MsgBox("Well done, you have beaten the hangman!" & vbCrLf & vbCrLf & _
            "Would you like another go?", vbYesNo, "Congratulations") = vbYes Then
            'User wants another go
            NewGame
        Else
            'Close form
            DoCmd.Close acForm, "frmHangman"
        End If
    End If
            
    'Check if the user got a letter
    If booGotLetter = False Then
        'Didn't get a letter
        intHangman = intHangman - 1
    End If
     
    'Update screen details
   lblTries.Caption = "Tries Remaining : " & intHangman
   HideBody
   head.Visible = (intHangman = 9)
   body.Visible = (intHangman = 8)
   right_arm.Visible = (intHangman = 7)
   left_arm.Visible = (intHangman = 6)
   right_leg.Visible = (intHangman = 5)
   left_leg.Visible = (intHangman = 4)
   right_hand.Visible = (intHangman = 3)
   left_hand.Visible = (intHangman = 2)
   right_foot.Visible = (intHangman = 1)
   'Check if the game is over!
    If intHangman = 0 Then
        'Game over
        intPoints = intPoints - 10
        If intPoints < 1 Then intPoints = 0
        lblPoints.Caption = "Points : " & intPoints
        hung.Visible = True
        If MsgBox("Sorry, you did not get the word!" & vbCrLf & vbCrLf & _
            "Would you like to try again?", vbYesNo, "Unlucky!") = vbYes Then
            'New game
            NewGame
            Exit Sub
        Else
            'Quit
            DoCmd.Close acForm, "frmHangman"
            Exit Sub
        End If
    End If
Exit Sub

ErrorHandler:
    'Close the form
    DoCmd.Close acForm, "frmHangman"
End Sub

Private Sub NewGame()
    'Set variables and screen for a new game
     'SelectWord
    'Reset all the command buttons
     Set colLetters = New Collection
    ' EnableCommands
     'Hide body
     HideBody
    'Reset letters got
    ResetLetters
     intLettersGot = 0
     intHangman = 10
     lblTries.Caption = "Tries Remaining : " & intHangman
End Sub

Public Sub HideBody()
  Dim ctrl As Access.Control
  For Each ctrl In Me.Controls
   If ctrl.Tag = "Body" Then
     ctrl.Visible = False
   End If
  Next ctrl
End Sub

Public Sub ResetLetters()
  Dim ctrl As Access.Control
  Dim i As Integer
  Dim id As String
  intWordLength = Len(strWord)
  For i = 1 To 16
    If i < 10 Then
      id = "0" & i
    Else
      id = CStr(i)
   End If
   Set ctrl = Me.Controls("lblLetter" & id)
   ctrl.Caption = "_"
   If i <= intWordLength Then
     ctrl.Visible = True
   Else
     ctrl.Visible = False
   End If
  Next i
End Sub
 

Users who are viewing this thread

Top Bottom