• Status: Solved
• Priority: Medium
• Security: Public
• Views: 244

# Algorithm Problems!

Hi People:

I have been in the process of making a VB version of the game Mastermind...

Now the program can spit out the random balls, and the user can selected their guess for each ball and game as they please... The problem Im having is in my algorithm for confirming the answer...

Im using the .tag area to store the answers for the users selection and Im finding that using the IIf function is just a right royal pain...

You might find it better if I email the project around so if so, pass on your Email address... Here is teh code below... Bit messy I know...

See if the the pctResult(x).Tag = 2 (Colour = Black) it means the user has the right colour ball in the right place...

The problems begin when their is MORE THAN one occurance of a ball...

HELP ME !!!!!!!!!!!

Option Explicit
Dim mintGameCompleted As Integer ' When = 3 then the user has used each SLOT for the game.

Private Sub Command1_Click()

End Sub

Dim i, pintAnswerIndex, pintRandom As Integer
Randomize

For pintAnswerIndex = 0 To imgAnswer.UBound ' Work UP TO the highest INDEX possible in the control array...

'Debug.Print intAnswerIndex     'This will display the last INDEX in the imgAnswer Control Array...

For i = 1 To 250 ' 250 Is the amount of times each Pin will be randomized!

pintRandom = Int(imgPins.Count - 1) * Rnd + 1    ' Select a randome number from the possible selection

'Debug.Print "Random Number: " & intRandom
Next i

imgAnswer(pintAnswerIndex).Picture = imlPins.ListImages(pintRandom).ExtractIcon ' Set the ANSWER Picture Control, to the CORRECT Image BASED ON, the INDEX in the Image List & Random Number
imgAnswer(pintAnswerIndex).Tag = pintRandom ' Set the ANSWERS Picture Control TAG Field, to the RANDOM number (Also the index for the SAME image!!)

'****************************************************
' REMOVING BEFORE COMPILE: USED FOR TESTING PURPOSES
'****************************************************

'****************************************************
' REMOVING BEFORE COMPILE: USED FOR TESTING PURPOSES
'****************************************************
End Sub

Private Sub imgGame_DragDrop(Index As Integer, Source As Control, x As Single, Y As Single)
Dim blnResult As Boolean

If mintGameCompleted < 4 Then
'Get the icon and display it in the answer boxes...
imgGame(Index).Picture = imlPins.ListImages(Source.Index).ExtractIcon

'Set the USERS selections TAG event, to the NUMBER of the ball...
imgGame(Index).Tag = Source.Index
imgGame(Index).ToolTipText = Source.Index       'Just so the PROGRAMMER can see the number

mintGameCompleted = mintGameCompleted + 1
imgGame(Index).Enabled = False

If Index = 23 Then
Else
imgGame(Index + 1).Enabled = True
End If
End If

If mintGameCompleted = 4 Then
' If the user has now completed all FOUR slots,
' then begin to check the answer!

If blnResult = False Then
'If the result is fales, then you have won:
MsgBox ("You Won In Game: " & mintGameNumber)
Else

Call CheckPlace(Index)

MsgBox ("Game " & mintGameNumber & " Completed")
mintGameCompleted = 0
End If
End If

End Sub

Private Sub CheckAnswer(ByRef Index As Integer)
Dim pintIndex As Integer
Dim pintFO As Integer
pintIndex = Index - 3

Do Until pintAnswerIndex = 4    'Do until UBound of imgAnswer Index Array...
pintFO = InStr(1, mintAnswer, imgGame(pintIndex).Tag, vbTextCompare)

pctResults(pintIndex).BackColor = vbBlack
pctResults(pintIndex).Tag = "2"
'    sngFirstOccurance = InStr(temp, intAnswer, imgGame(i).Tag, vbTextCompare)
ElseIf pintFO = 0 Then
pctResults(pintIndex).Tag = "0"
pctResults(pintIndex).BackColor = vbYellow
Else
pctResults(pintIndex).Tag = "1"
pctResults(pintIndex).BackColor = vbGreen
End If

pintIndex = pintIndex + 1
Loop
'        Call CheckPlace(pintIndex - 3)
End Sub

Private Sub CheckPlace(ByRef Index As Integer)
Dim pintFO As Integer
Dim pintIndex As Integer
pintIndex = Index - 3

Dim i, x As Integer
i = 1

'pintIndex = Index
'pintFO = InStr(1, mintAnswer, imgGame(pintIndex).Tag, vbTextCompare)
'For x = 1 To 2

If pctResults(pintIndex).Tag = "1" Then 'IF = GREEN
pintFO = InStr(i, mintAnswer, imgGame(pintIndex).Tag, vbTextCompare)

If pctResults(pintFO).Tag = "0" Or pctResults(pintFO - 1).Tag = "0" Then
pctResults(pintIndex).BackColor = vbRed
pctResults(pintIndex).Tag = "3"

ElseIf pctResults(pintFO).Tag = "1" Or pctResults(pintFO - 1).Tag = "1" Then
pctResults(pintIndex).BackColor = vbRed
'pctResults(pintIndex).Tag = "3"
ElseIf pctResults(pintFO).Tag = "2" Or pctResults(pintFO - 1).Tag = "2" Then
pctResults(pintIndex).BackColor = vbYellow
pctResults(pintIndex).Tag = "0"
i = pintFO + 1
ElseIf pctResults(pintFO).Tag = "3" Or pctResults(pintFO - 1).Tag = "3" Then
pctResults(pintIndex).BackColor = vbRed
pctResults(pintIndex).Tag = "3"
Else
pctResults(pintIndex).BackColor = vbYellow
'pctResults(pintIndex).Tag = "0"
End If

End If

pintIndex = pintIndex + 1
Loop
pintIndex = Index - 3

'Next x
End Sub
0
jilamints
• 10
• 6
1 Solution

Commented:
Is there a spot you can post the project as a zip file?

mlmcc
0

Commented:
Way too complicated.  This is what you need to do:
Create a few flag variables:

bCorrect(1 To 4) As Boolean, bExact(1 To 4) As Boolean, bUsed(1 To 4) As Boolean

If you have more than 4 slots in your answer, size the arrays accordingly.

Count the number of guesses that are exactly right.  Set the flags bExact and bUsed for each exactly right guess.

Then count the number of guesses that are correct colours, but not exact position.  Skip bExact flagged positions since they are already guessed.  Set bUsed and bCorrect but skip bUsed for each position since you do not want to count correct guesses twice.  It will look something like this:

'Check exact
For i = 1 To 4
If lngGuess(i) = gSecret(i) Then
bExact(i) = True
bUsed(i) = True
intExact = intExact + 1
End If

Next

If intExact = 4 Then
'you win
fCheckResults = strWin
Else

For i = 1 To 4
If Not bExact(i) Then
For j = 1 To 4
If Not bUsed(j) Then
If lngGuess(i) = gSecret(j) Then
bCorrect(i) = True
bUsed(j) = True
Exit For
End If
End If
Next j
End If
Next i

For i = 1 To 4
If bCorrect(i) Then
intCorrect = intCorrect + 1
End If
Next
0

Author Commented:
http://203.45.161.135:90/Mastermind.zip

PaulHews: I understand what your trying to do, yet had some troubles putting it into practice in my code - Could you maybe edit it were needed ?

0

Commented:
I downloaded it, but don't have enough time to go through it... I also don't really understand the result pins.  Original game had only white (correct colour, wrong position) and black (correct colour, correct position.) I offer you my complete source from my site, maybe it will give you ideas.

http://www11.brinkster.com/notbono/programs.asp

Scroll down for master mind src.
0

Author Commented:
Hmm... Well I guess I will look into it then - See what I can work out for myself...
0

Author Commented:
I have, and am still in the progress as I write this of testing the program... I have used your example as above and have changed it to work without the use of the boolean variables and it of course delivers the same result...

If the second colour is a yellow, and you enter as the user, the first two as being yellow, it detects the second one as being correct, but it then returns that the first yellow you entered is being used, but not in the correct position EVEN when it knows the second one IS CORRECT ?

Whats the story here ? What am I missing ?

0

Author Commented:
OK I now have it working (I think!) lol - Im still using the tags like before, but instead of running all six games in the one control array, I will now run them as 6 seperate arrays...

My new problem is this... Because Im using the drag and drap event for each array, I want to made the one function to deal with the images for the buttons...

For Example:

Private Sub imgGameOne_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Call DragDrop(Index, imgGameOne(Index).Name, Source)
End Sub

Now in the function, it produces the error "Expected Array" now I know what its trying to tell me, but how can I get around this ?
0

Commented:
What is the declaration for the DragDrop subroutine?
0

Author Commented:
Just like: Private Sub DragDrop(ByRef Index As Integer, ByRef pName As String, Source As Control)

Something like that I think...
0

Commented:
But that isn't the line you are getting the error on?  Can you post the line that is throwing the error?
0

Author Commented:
This appear in the function and once called errors on this, the very first line...

pName(Index).Picture = imlPins.ListImages(Source.Index).ExtractIcon

Compile Error:

Expected Array
0

Commented:

'Try changing the event like this:
Private Sub imgGameOne_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Call DragDrop(Index, imgGameOne(Index), Source)
End Sub

'And change the declaration like this:

Private Sub DragDrop(ByRef Index As Integer, ByRef pName As Image, Source As Control)

'Then the error line like this:
pName.Picture = imlPins.ListImages(Source.Index).ExtractIcon

You will have to make changes to other lines in the DragDrop that reference pName to eliminate the index.
0

Author Commented:
OK Then - I have done what you said regarding the drap and drop event yet when it then comes time to confirming the answer, I need to use the index value as my starting point...

For i = Index - 3 To Index

shpResultOne(i).BackColor = vbBlack
shpResultOne(i).Tag = "0" ' Code ZERO = Black
X = X + 1 ' Answer check for if statement...
End If

Next i

So here Im running another function and a loop - I pass pName accross in the same way as we have done for the drag drop event...

i Of course is a variable I declare and is also passed accross which is the Index...

It throws an error here as it doesn't like to extract pName.Name(i) or anything else...

Even declaring another var and having it = pName doesnt work ??????

What The !??!
0

Author Commented:
I suspect I am better off asking my above question again in another question ? Yes ? Cause this is still not working for me ! :-(
0

Author Commented:
After further research of my own, VB seems to have a lot of trouble passing over an array of controls and its index... Passing it over as a variant and using a for each loop seems to fix the problem...
0

Author Commented:
I would feel this answer put me on the best possible track at the time - While I did not use an array like this example, I managed to make it work for me in the end !

Many Thanks!
0

Commented: