?
Solved

Algorithm Problems!

Posted on 2003-03-16
17
Medium Priority
?
240 Views
Last Modified: 2010-08-05
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
Private mintAnswer As Integer   'Correct Answer Variable!
Private mintCurrentGameAnswer As String    'Game in processes ANSWER Variable.
Dim mintAnswerIndex As Integer
Dim mintGameNumber As Integer
Dim mintGameCompleted As Integer ' When = 3 then the user has used each SLOT for the game.

Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
Dim i, pintAnswerIndex, pintRandom As Integer
Randomize
mintGameNumber = 1

'x = RandomNumber * imgAnswer.UBound

'intAnswer = 0
mintGameNumber = 1

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!!)
    mintAnswer = mintAnswer & pintRandom ' Store the answer in a FORM WIDE VARIABLE
   
           
    '****************************************************
    ' REMOVING BEFORE COMPILE: USED FOR TESTING PURPOSES
        imgAnswer(pintAnswerIndex).ToolTipText = pintRandom
    '****************************************************
   

Next pintAnswerIndex

    '****************************************************
    ' REMOVING BEFORE COMPILE: USED FOR TESTING PURPOSES
        StatusBar1.Panels(1).Text = "Answer: " & mintAnswer
    '****************************************************
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
        mintCurrentGameAnswer = mintCurrentGameAnswer & Source.Index
        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!
        blnResult = StrComp(mintAnswer, mintCurrentGameAnswer)
       
            If blnResult = False Then
                'If the result is fales, then you have won:
                MsgBox ("You Won In Game: " & mintGameNumber)
            Else
           
            Call CheckAnswer(Index)
                    Call CheckPlace(Index)
           
           
                       
           
           
           
           
                MsgBox ("Game " & mintGameNumber & " Completed")
                mintGameNumber = mintGameNumber + 1
                mintGameCompleted = 0
                mintCurrentGameAnswer = vbNullString
            End If
        End If

End Sub

Private Sub CheckAnswer(ByRef Index As Integer)
Dim pintIndex As Integer
Dim pintAnswerIndex 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)

        If imgGame(pintIndex).Tag = imgAnswer(pintAnswerIndex).Tag Then
            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
    pintAnswerIndex = pintAnswerIndex + 1
Loop
'        Call CheckPlace(pintIndex - 3)
End Sub

Private Sub CheckPlace(ByRef Index As Integer)
Dim pintAnswerIndex 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
Do Until pintAnswerIndex = 4

    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
    pintAnswerIndex = pintAnswerIndex + 1
Loop
pintIndex = Index - 3
pintAnswerIndex = 0

'Next x
End Sub
0
Comment
Question by:jilamints
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 10
  • 6
17 Comments
 
LVL 101

Expert Comment

by:mlmcc
ID: 8146495
Is there a spot you can post the project as a zip file?

mlmcc
0
 
LVL 38

Accepted Solution

by:
PaulHews earned 1500 total points
ID: 8146980
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 Comment

by:jilamints
ID: 8147645
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 ?

Thank You for your efforts...

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 38

Expert Comment

by:PaulHews
ID: 8148350
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 Comment

by:jilamints
ID: 8151841
Hmm... Well I guess I will look into it then - See what I can work out for myself...
0
 

Author Comment

by:jilamints
ID: 8159592
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 Comment

by:jilamints
ID: 8160245
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
 
LVL 38

Expert Comment

by:PaulHews
ID: 8160325
What is the declaration for the DragDrop subroutine?
0
 

Author Comment

by:jilamints
ID: 8162750
Just like: Private Sub DragDrop(ByRef Index As Integer, ByRef pName As String, Source As Control)

Something like that I think...
0
 
LVL 38

Expert Comment

by:PaulHews
ID: 8163108
But that isn't the line you are getting the error on?  Can you post the line that is throwing the error?
0
 

Author Comment

by:jilamints
ID: 8163215
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
 
LVL 38

Expert Comment

by:PaulHews
ID: 8167554

'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 Comment

by:jilamints
ID: 8178448
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

    If pName(i).Tag = imgAnswer(pbytGameAnswerIndex).Tag Then
        shpResultOne(i).BackColor = vbBlack
        shpResultOne(i).Tag = "0" ' Code ZERO = Black
        X = X + 1 ' Answer check for if statement...
    End If
   
    pbytGameAnswerIndex = pbytGameAnswerIndex + 1
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 Comment

by:jilamints
ID: 8189282
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 Comment

by:jilamints
ID: 8223562
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 Comment

by:jilamints
ID: 8223569
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
 
LVL 38

Expert Comment

by:PaulHews
ID: 8224375
Glad you found an answer. :)
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question