form1.frm

超级纸牌游戏源代码

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

' InitDrag returns the number of the card that contains the
' mouse, as well as setting up the drag operation

Dim nStatus As Integer

' save mouse x and y position for double click event
DblClickX = x
DblClickY = y

If bDragDemo = True Then
    nSourceCard = InitDrag(Form1.hwnd, x, y)
    If nSourceCard = 0 Then
        ' no card selected
        AbortDrag
    Else
        ' save old position for later use
        ' if the drag is invalid
        OldX = GetCardX(nSourceCard)
        OldY = GetCardY(nSourceCard)
        ' if card is not blocked, it is a single drag
        ' if it's blocked, it means were doing a block drag
        nStatus = GetCardBlocked(nSourceCard)
        If nStatus = 0 Then
            bSingleDragging = True
        Else
            bBlockDragging = True
        End If
    End If
End If

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

If bSingleDragging = True Then
    ' if just a single card, it's number was set with InitDrag call
    DoDrag Form1.hwnd, x, y
ElseIf bBlockDragging = True Then
    ' determine which pile we are dealing with
    nSourceArrayID = GetUser4(nSourceCard)
    ' determine the position of the first card in drag
    nSourceArrayPos = GetUser3(nSourceCard)
    ' how many cards are we moving
    nItems = Counter(nSourceArrayID) - nSourceArrayPos + 1
    ' create an array to hold the numbers of the cards to move
    ' and fill the array starting at 0
    ReDim Temp(nItems)
    For i = nSourceArrayPos To Counter(nSourceArrayID)
        Temp(i - nSourceArrayPos) = CardArray(nSourceArrayID, i)
    Next i
    ' pass the BlockDrag sub the actual array, referencing it's
    ' first element. This acts as a "pointer" to the rest of
    ' the elements in the array in memory
    BlockDrag Form1.hwnd, Temp(0), nItems, x, y
    ' let the MouseUp event know that it is ok to
    ' reference the Temp(0) array for this instance
    bMouseMoved = True
End If

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

' most of the code here involves relocating cards
' to their new homes/arrays

Dim nDeltaX As Integer
Dim nDeltaY As Integer
Dim nSourceX As Integer
Dim nSourceY As Integer
Dim nNewX As Integer
Dim nNewY As Integer
Dim nUnused As Integer
Dim nSourceColor As Integer
Dim nDestColor As Integer

If bSingleDragging = True Then
    ' end the drag operation and
    ' find out who we are dropping in on
    nDestCard = EndDrag(Form1.hwnd, x, y)
    nSourceColor = GetCardColor(nSourceCard)
    nDestColor = GetCardColor(nDestCard)
    nSourceArrayPos = GetUser3(nSourceCard)
    
    ' do some color testing
    ' only allow drop if source and destination colors are the same
    ' and if nSourceCard is not the last card in it's pile.
    ' if nDestCard is 0, the Source Card was dropped at an invalid location
    If nDestCard = 0 Or nSourceColor <> nDestColor Or nSourceArrayPos = 1 Then
        ' if not a valid drop site, return drag
        ReturnDrag Form1.hwnd, nSourceCard, OldX, OldY
        bSingleDragging = False
    Else
        ' valid single drag/drop... proceed with relocation
        
        ' which array did we come from
        nSourceArrayID = GetUser4(nSourceCard)
        ' reduce our old array counter
        Counter(nSourceArrayID) = Counter(nSourceArrayID) - 1
        ' which array are we joining
        nDestArrayID = GetUser4(nDestCard)
        ' add another to it's counter
        Counter(nDestArrayID) = Counter(nDestArrayID) + 1
        ' block our new neighbor
        AdjustCardBlocked nDestCard, True
        ' install our new arrayID and position
        SetUser3 nSourceCard, Counter(nDestArrayID)
        SetUser4 nSourceCard, nDestArrayID
        ' align with left side of card above us
        ' and down OFFSET (16)
        nNewX = GetCardX(nDestCard)
        nNewY = GetCardY(nDestCard)
        RemoveCard Form1.hwnd, nSourceCard
        DealCard Form1.hwnd, nSourceCard, nNewX, nNewY + OFFSET
        ' unblock last card in old array
        AdjustCardBlocked CardArray(nSourceArrayID, Counter(nSourceArrayID)), False
        ' add ourselves to new array
        CardArray(nDestArrayID, Counter(nDestArrayID)) = nSourceCard
        bSingleDragging = False
    End If
ElseIf bBlockDragging = True And bMouseMoved = True Then
    ' we can reuse the Temp() array from MouseMove
    ' as long as MouseMove actually occurred
    
    ' end the drag and find out the destination card
    nDestCard = EndBlockDrag(Form1.hwnd, Temp(0), nItems, x, y)
    nSourceColor = GetCardColor(nSourceCard)
    nDestColor = GetCardColor(nDestCard)
    nSourceArrayPos = GetUser3(nSourceCard)
    ' do some color testing
    ' only allow drop if source and destination colors are the same
    ' and nSourceCard is not the last card in it's pile
    If nDestCard = 0 Or nSourceColor <> nDestColor Or nSourceArrayPos = 1 Then
        ' if not a valid drop site, return drag
        ReturnBlockDrag Form1.hwnd, Temp(0), nItems, OldX, OldY

        bBlockDragging = False
        bMouseMoved = False
    Else
        ' which array did we come from
        nSourceArrayID = GetUser4(nSourceCard)
        ' reduce our old array counter
        Counter(nSourceArrayID) = Counter(nSourceArrayID) - nItems
        ' which array are we joining
        nDestArrayID = GetUser4(nDestCard)
        ' block our new neighbor
        AdjustCardBlocked nDestCard, True
        
        ' this bit of code demonstrates how you can "fool" a drag operation
        ' to drag the item to a specific location. Usually, you pass the
        ' BlockDrag sub the x,y location of the mouse. If you first determine
        ' your current mouse position in relation to the object you are dragging
        ' you can add that difference (nDeltaX, nDeltaY) to the position you
        ' want to drag to, and pass those points to BlockDrag. We want to align
        ' with the left side of DestCard and down OFFSET (16) pixels from its top
        nNewX = GetCardX(nDestCard)
        nNewY = GetCardY(nDestCard)
        nSourceX = GetCardX(nSourceCard)
        nSourceY = GetCardY(nSourceCard)
        nDeltaX = x - nSourceX
        nDeltaY = y - nSourceY
        nUnused = InitDrag(Form1.hwnd, x, y)
        BlockDrag Form1.hwnd, Temp(0), nItems, nNewX + nDeltaX, nNewY + OFFSET + nDeltaY
        nUnused = EndBlockDrag(Form1.hwnd, Temp(0), nItems, nNewX + nDeltaX, nNewY + OFFSET + nDeltaY)
        
        ' install our new arrayIDs and positions
        For i = 0 To nItems - 1
            Counter(nDestArrayID) = Counter(nDestArrayID) + 1
            CardArray(nDestArrayID, Counter(nDestArrayID)) = Temp(i)
            SetUser3 Temp(i), Counter(nDestArrayID)
            SetUser4 Temp(i), nDestArrayID
        Next i
        
        ' unblock last card in old array
        AdjustCardBlocked CardArray(nSourceArrayID, Counter(nSourceArrayID)), False
        
        ' remove temporary block on last card in block drag array
        AdjustCardBlocked Temp(nItems - 1), False
        
        bBlockDragging = False
        bMouseMoved = False
    End If

ElseIf bBlockDragging = True And bMouseMoved = False Then
    ' There was a MouseDown event but no MouseMove event
    AbortDrag
    bBlockDragging = False
End If
End Sub

Private Sub Form_Paint()
' Even when the AutoRedraw property for your
' form is set to TRUE, VB will not redraw any
' of your cards for you. You must handle the
' redrawing in the Paint Event. In a normal card
' game, your Paint Event will look a lot like
' Case 6 below

Select Case nDrawSelection
    Case 1
        MenuDealCard_Click
    Case 2
        MenuDrawCard_Click
    Case 3
        MenuDrawBack_Click
    Case 4
        MenuDrawSymbol_Click
    Case 5
        x = GetCardX(nInformationCard)
        y = GetCardY(nInformationCard)
        Form1.Cls
        DrawCard Form1.hwnd, nInformationCard, x, y
        DoText nInformationCard
    Case 6
        For i = 1 To 4
            For j = 1 To Counter(i)
                x = GetCardX(CardArray(i, j))
                y = GetCardY(CardArray(i, j))
                DrawCard Form1.hwnd, CardArray(i, j), x, y
            Next j
        Next i
End Select
End Sub

Private Sub MenuAbout_Click()
About.Show 1
'Form1.Refresh
End Sub

Private Sub MenuDoDrag_Click()
nDrawSelection = 6
' clear out any old card properties
SetDefaultValues
Form1.Cls

Dim cxSpacer As Integer
cxSpacer = (Form1.ScaleWidth - 4 * CARDWIDTH) / 5

' draw in symbols
For i = 1 To 4
    DrawSymbol Form1.hwnd, 1, cxSpacer * i + ((i - 1) * CARDWIDTH), 10
Next i

' each pile has it's own array identifying the cards
' each pile has a counter to maintain the pile
' each card uses it's User3 and User4 properties to
' store which array it belongs to and what position
' it's in within the array. This makes dragging and
' dropping easier

' deal first pile and set up array
For i = 1 To 13
    DealCard Form1.hwnd, i, cxSpacer, 10 + ((i - 1) * OFFSET)
    CardArray(1, i) = i
    SetUser3 i, i   ' card's position in array
    SetUser4 i, 1   ' array ID
    If i < 13 Then
        ' block all cards except the one on top
        AdjustCardBlocked i, True
    End If
Next i

' there are 13 cards per pile
Counter(1) = 13

For i = 14 To 26
    DealCard Form1.hwnd, i, (cxSpacer * 2) + CARDWIDTH, 10 + ((i - 14) * OFFSET)
    CardArray(2, i - 13) = i
    SetUser3 i, i - 13  ' card's position in array
    SetUser4 i, 2       ' array ID
    If i < 26 Then
        AdjustCardBlocked i, True
    End If
Next i
Counter(2) = 13

For i = 27 To 39
    DealCard Form1.hwnd, i, (cxSpacer * 3) + (2 * CARDWIDTH), 10 + ((i - 27) * OFFSET)
    CardArray(3, i - 26) = i
    SetUser3 i, i - 26  ' card's position in array
    SetUser4 i, 3       ' array ID
    If i < 39 Then
        AdjustCardBlocked i, True
    End If
Next i
Counter(3) = 13

For i = 40 To 52
    DealCard Form1.hwnd, i, (cxSpacer * 4) + (3 * CARDWIDTH), 10 + ((i - 40) * OFFSET)
    CardArray(4, i - 39) = i
    SetUser3 i, i - 39  ' card's position in array
    SetUser4 i, 4       ' array ID
    If i < 52 Then
        AdjustCardBlocked i, True
    End If
Next i
Counter(4) = 13
bDragDemo = True
End Sub

Private Sub MenuExit_Click()
End
End Sub

Private Sub MenuHowTo_Click()

Help$ = CurDir$
Help$ = Help$ + "\qcard32.hlp"
x% = WinHelp(hwnd, Help$, &H3, -1)

End Sub

Private Sub MenuRemoveCard_Click()
nDrawSelection = 0
Form1.Cls

' deal 13 cards and enable the timer sub which will remove them
For i = 1 To 13
    DealCard Form1.hwnd, i, (Form1.ScaleWidth - CARDWIDTH) / 2, 10 + ((i - 1) * 16)
Next i

Timer1.Enabled = True

End Sub




Private Sub Timer1_Timer()

' remove cards one at a time
' don't forget to take them off in reverse order
' or you will have a mess

RemoveCard Form1.hwnd, n

n = n - 1

If n = 0 Then
    n = 13
    Timer1.Enabled = False
End If

End Sub