0

I'm writing a solitaire game in vb6 and have cards in gui on the left side of the screen lined up by suits. I have blank bitmaps on the right hand side of the screen for each suit; therefore I would drop the left hand card on the location of the right hand card that matches the card number and suit; i.e. image1 image of hearts king would drop on the blank card, equalling hearts(12) array.

This is my code, but I am having so many problems with this. I cannot find a way to state that when I drag a card such as image1(12) from the left hand side, it matches the right hand side card and allows for a drop, else an error message is displayed...

Option Explicit

Public Sub Main()
Start_Game.Show

End Sub
Private Sub Exit_Click()
MsgBox ("Thank you for playing. Good Bye.")
End

End Sub
Private Sub Start_Click()

Dim arrDeck(52)
Randomize
Dim Cardcount As Integer
Dim Counter As Integer
Dim Card1 As Integer
Dim Card2 As Integer

' Fill deck with cards in order 1 to 52
Cardcount = 0
Do While Cardcount <= 51
arrDeck(Cardcount) = Cardcount
Cardcount = Cardcount + 1
Loop

' Shuffle the deck - end value (100)
Counter = 0
For Counter = 0 To 100
Card1 = Int(52 * Rnd)
Card2 = Int(52 * Rnd)
If (Card1 <> Card2) Then
Image1(0).Picture = Image1(Card1).Picture
Image1(Card1).Picture = Image1(Card2).Picture
Image1(Card2).Picture = Image1(0).Picture
End If
Next Counter

' Re-shuffle the deck
Counter = 0
For Counter = 0 To 100
Card1 = Int(52 * Rnd)
Card2 = Int(52 * Rnd)
If (Card1 <> Card2) Then
Image1(0).Picture = Image1(Card1).Picture
Image1(Card1).Picture = Image1(Card2).Picture
Image1(Card2).Picture = Image1(0).Picture
End If
Next Counter

' Now output images in order
Counter = 0

For Counter = 0 To 51
Image1(Counter).Visible = True
Next Counter

End Sub

'This is where I'm having problems...
Private Sub Hearts_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Dim NewIndex As Integer
Dim i As Integer
Dim j As Integer

For Index = 0 To 12
For NewIndex = 0 To 12

If TypeOf Source Is Image Then
Hearts(Index).Picture = Source.Picture
Hearts(Index).Tag = Source.Tag
Source.Picture = Image1(NewIndex).Picture

Set i = Hearts(Index).Tag
Set j = Image1(NewIndex).Tag

If i = j Then
Image1(NewIndex).Drag vbEndDrag
MsgBox ("You're right!")
Exit Sub

Else

Image1(NewIndex).Drag vbCancel
MsgBox ("This card does not belong here")
Exit Sub

End If
Next
Next
End Sub

3
Contributors
6
Replies
7
Views
8 Years
Discussion Span
Last Post by Jupiter 2
0

I have written some 50 solitaire games in VB4, including spider, klondyke, etc. I found that images would not drag properly, but staggered across the screen, and pictures (using drag drop) only moved the picture outline, I resolved this by programming the picturebox to follow the mousedown, mousemove and mouseup events. Not quite sure about your problem though as I am not familiar with VB6.

0

I think you are just missing an End if before the first Next because you 2 x If but only one End If.

0

Hi,

I tried that and I got an error 340, array element 13 does not exist.

This what I'm trying to do, but what happens is "it is always right" and with "any" card I put into any hearts slot on the right, will put that card right up at hearts(0) and say, you're right. How do I initialize the cards pictures to equal each other, then use next and next for the "for's in the beginning, then question whether the tags = each other. The tag numbers are set in design view.

Here's my code:

Private Sub Hearts_DragDrop(Index As Integer, Source As Control, X As Single, Y As Single)
Dim NewIndex As Integer

For Index = 0 To 12
For NewIndex = 0 To 12
Hearts(Index).Picture = Source.Picture
Source.Picture = Image1(NewIndex).Picture
If Hearts(Index).Tag = Image1(NewIndex).Tag Then
Image1(NewIndex).Drag vbEndDrag
MsgBox ("You're right!")
Exit Sub
Else
Image1(NewIndex).Drag vbCancel
MsgBox ("This card does not belong here")
Exit Sub
End If
Next
Next

End Sub

0

Add Controls
Windows Common Controls 6.0 (sp6)
This will give you the imagelist control to store your card images.
As you drop a card, move it to the end of the control.

Make a Module level Counter mintCountCardsLeft =52

As you drop a card deduct 1 from Cards remaining.
mintCountCardsLeft =mintCountCardsLeft
-1

0

You also could create an array of objects so you can remove names as you take the cards.

Attached (hopefully) is a card picture. I created them from the Freecell Game. I captured the image and cut the card out. It took a while until I got all 52 cards. I wrote a javascript card game. Maybe you could use the concept of it to help you?
http://www.geocities.com/windsofmark/myster/puzzlers/carter.htm
Click Puzzlers 16 to 20 button then click Puzzler 18 for the card game.

Attachments 0aclu.gif 1.05 KB
This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.