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

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.

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

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

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

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 article has been dead for over six months. Start a new discussion instead.