Skip to main content

AccessTr.neT


Solitaire

#13
(21/06/2010, 15:09)manyak_1903 yazdı: aga ödev hazırlıyorum bunun kodlarını bana verebilirmisin lütfen bana ulaşırsan sevinirim....

Siz bu gidişle biraz zor tamamlarsınız ödevinizi "AGA"
Cevapla
#14
Siz bu gidişle biraz zor tamamlarsınız ödevinizi "AGA"


RoflmaoRoflmaoRoflmao108061080610806
Son Düzenleme: 21/06/2010, 20:44, Düzenleyen: mustafa_atr.
Cevapla
#15
(21/06/2010, 19:41)BlackEagle yazdı:
(21/06/2010, 15:09)manyak_1903 yazdı: aga ödev hazırlıyorum bunun kodlarını bana verebilirmisin lütfen bana ulaşırsan sevinirim....

Siz bu gidişle biraz zor tamamlarsınız ödevinizi "AGA"

Ercan Bey, Ercan Bey Mahalle Kabadayısı Gibi Konuşmayın Lütfen.RoflmaoRoflmaoRoflmaoRoflmaoRoflmaoBiggrin
Application Engineer
Cevapla
#16
Vb kodunu indirdiğim dosyada göremedim. Eğer bu şekilde değilse burada koymanıza gerek yok. Her yerde bu oyun zaten var.
Cevapla
#17
Sn:cumaarslan
Buyrun istediğiniz kodlar.

Kod:
Option Explicit

Private Sub Form_Load()
    numCardsToDraw = 3
    timingTheGame = True
    keepingScore = True
    Solitaire_New_Game
    Solitaire_Render Me
    
End Sub

Private Sub Form_Mousedown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Solitaire_CheckMouseDown X, Y
    Solitaire_Render Me
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Solitaire_CheckMouseMove X, Y
    Solitaire_Render Me
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Solitaire_Render Me
End Sub

Private Sub Form_Terminate()
    DeleteCardPics
End Sub

Private Sub Form_Unload(Cancel As Integer)
    DeleteCardPics
End Sub

Private Sub Game_Timer_Timer()
    If timingTheGame Then
        time = time + 1
        lblTime = "Time: " & time
    End If
End Sub

Private Sub mnuDeck_Click()
    Load frmDeckOptions
    frmDeckOptions.Show

    
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuNew_Click()
    Solitaire_New_Game
End Sub

Private Sub mnuOptions_Click()
    Load frmSolitaireOptions
    frmSolitaireOptions.Show
End Sub

Modüle1

Option Explicit

Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As Long, ByVal nXDest As Long, ByVal nYDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal dwRop As Long) As Long
Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Public Const CARD_WIDTH = 71
Public Const CARD_HEIGHT = 96

Type Rect
    Top As Long
    bottom As Long
    left As Long
    right As Long
End Type

Enum eSuit
    SUIT_CLUBS = 0
    SUIT_DIAMONDS = 1
    SUIT_HEARTS = 2
    SUIT_SPADES = 3
End Enum

Enum eValue
    CARD_ACE = 1
    CARD_TWO
    CARD_THREE
    CARD_FOUR
    CARD_FIVE
    CARD_SIX
    CARD_SEVEN
    CARD_EIGHT
    CARD_NINE
    CARD_TEN
    CARD_JACK
    CARD_QUEEN
    CARD_KING
End Enum

Type tCardPic
    hdc As Long
    pic As StdPicture
End Type

Public screenWidth As Integer
Public screenHeight As Integer

Public offScreenDC As Long
Public offScreenBMP As Long

Public CardPics(0 To 51) As tCardPic
Public ErrorPic As tCardPic
Public DeckBacks(0 To 14) As tCardPic

Sub SetCardPics()
    Dim hTempDC As Long
    Dim i As Integer
    
    hTempDC = GetDC(0)
    
    For i = 0 To 51
    
        Set CardPics(i).pic = New StdPicture
        Set CardPics(i).pic = LoadPicture(App.Path & "\cards\" & i + 1 & ".bmp")
        CardPics(i).hdc = CreateCompatibleDC(hTempDC)
        Call SelectObject(CardPics(i).hdc, CardPics(i).pic.Handle)
    
    Next
    
    For i = 0 To 14
    
        Set DeckBacks(i).pic = New StdPicture
        Set DeckBacks(i).pic = LoadPicture(App.Path & "\Cards\Card backs\" & i + 1 & ".bmp")
        DeckBacks(i).hdc = CreateCompatibleDC(hTempDC)
        Call SelectObject(DeckBacks(i).hdc, DeckBacks(i).pic.Handle)
        
    Next
    
        Set ErrorPic.pic = New StdPicture
        Set ErrorPic.pic = LoadPicture(App.Path & "\Cards\error!.bmp")
        ErrorPic.hdc = CreateCompatibleDC(hTempDC)
        Call SelectObject(ErrorPic.hdc, ErrorPic.pic.Handle)
    
    ReleaseDC 0, hTempDC
End Sub

Public Sub offScreenSet()
  Dim hTempDC As Long
  Dim hOldBMP As Long

  hTempDC = GetDC(0)
  offScreenDC = CreateCompatibleDC(hTempDC)

  offScreenBMP = CreateCompatibleBitmap(hTempDC, screenWidth, screenHeight)
  hOldBMP = SelectObject(offScreenDC, offScreenBMP)
  ReleaseDC 0, hTempDC

End Sub

Function SuitsAreOpposite(Card1 As clsCard, Card2 As clsCard) As Boolean
    If (Card1.Suit = SUIT_CLUBS Or Card1.Suit = SUIT_SPADES) And (Card2.Suit = SUIT_DIAMONDS Or Card2.Suit = SUIT_HEARTS) Then
        SuitsAreOpposite = True
        Exit Function
    End If
    
    If (Card1.Suit = SUIT_DIAMONDS Or Card1.Suit = SUIT_HEARTS) And (Card2.Suit = SUIT_CLUBS Or Card2.Suit = SUIT_SPADES) Then
        SuitsAreOpposite = True
        Exit Function
    End If
End Function

Sub DeleteCardPics()
    Dim i As Integer
    
    For i = 0 To 51
        DeleteDC CardPics(i).hdc
        DeleteObject CardPics(i).pic
    Next
    
    For i = 0 To 14
        DeleteDC DeckBacks(i).hdc
        DeleteObject DeckBacks(i).pic
    Next
    
    DeleteDC ErrorPic.hdc
    DeleteObject ErrorPic.pic
End Sub

Modüle2

Option Explicit

Public numCardsToDraw As Integer
Public Score As Long
Public keepingScore As Boolean
Public timingTheGame As Boolean
Public time As Long

Dim bla4 As Boolean

Type tSelectedCard
    card() As New clsCard
    PosFrom As Integer
End Type

Type tPileCard
    numCards As Integer
    card() As New clsCard
End Type

Public GameDeck As New clsDeck
Public DispDeck As New clsDeck
Public GoalDeck(0 To 3) As New clsDeck
Public Pile(0 To 6) As New clsDeck

Public CardPile(0 To 6) As tPileCard
Public SelectedCard As tSelectedCard
Public NumSelected As Integer
Public CardIsSelected As Boolean

Sub Solitaire_New_Game()
    Dim i As Integer, j As Integer
    
    
    Randomize
    
    CardIsSelected = False
    NumSelected = 1
    ReDim SelectedCard.card(NumSelected)
    
    Score = 0
    time = 0
    frmSolitaire.lblTime.Caption = ""
    If keepingScore Then
        frmSolitaire.lblScore.Caption = "Score: 0"
    Else
        frmSolitaire.lblScore.Caption = ""
    End If
    SelectedCard.card(NumSelected).FacingUp = True
    SelectedCard.PosFrom = -1

    GameDeck.Initialize 52
    GameDeck.Shuffle
    
    DispDeck.Initialize 0, GameDeck.DeckBack
    
    For i = 0 To 6
        Pile(i).Initialize 0, GameDeck.DeckBack
    Next

    For i = 0 To 6
        For j = 0 To i
            Pile(i).AddCardToTop GameDeck.DrawCard
        Next
        CardPile(i).numCards = 1
        ReDim CardPile(i).card(CardPile(i).numCards)
        Set CardPile(i).card(0) = Pile(i).DrawCard
    Next
    
    For i = 0 To 3
        GoalDeck(i).Initialize 0, GameDeck.DeckBack
    Next
    
    
End Sub

Sub Solitaire_CheckMouseDown(ByVal X As Single, ByVal Y As Single)
    Dim i As Integer, j As Integer, k As Integer
    Dim done As Boolean, bla As Boolean, bla2 As Boolean, bla3 As Boolean
    
    bla4 = False
    
    If GameDeck.CheckClicked(X, Y) Then
        If CardIsSelected = False Then
            If GameDeck.m_NumCards = 0 Then
                For i = 0 To DispDeck.m_NumCards - 1
                    GameDeck.AddCardToTop DispDeck.DrawCard
                    done = True
                    AddToScore -Score
                Next
            End If
            If done = False Then
                For i = 0 To numCardsToDraw - 1
                    If GameDeck.m_NumCards = 0 Then Exit For
                    DispDeck.AddCardToTop GameDeck.DrawCard
                Next
                DispDeck.NumToDraw = 3
            End If
        End If
    End If
    
    
    If DispDeck.CheckClicked(X, Y) Then
        If CardIsSelected = False Then
            If DispDeck.m_NumCards > 0 Then
                NumSelected = 1
                Set SelectedCard.card(0) = DispDeck.DrawCard
                If DispDeck.NumToDraw > 1 Then DispDeck.NumToDraw = DispDeck.NumToDraw - 1
                SelectedCard.PosFrom = 0
                CardIsSelected = True
            End If
        Else
            ReturnSelectedCard
        End If
    End If

    
    
    For i = 0 To 3
        If GoalDeck(i).CheckClicked(X, Y) Then
            If CardIsSelected = True Then
                If SelectedCard.PosFrom = 0 Or SelectedCard.PosFrom > 4 Then AddToScore 10
                AddCardsToGoalDecks i

            Else
                If GoalDeck(i).m_NumCards > 0 Then
                    NumSelected = 1
                    ReDim SelectedCard.card(NumSelected)
                    SelectedCard.PosFrom = i + 1
                    Set SelectedCard.card(0) = GoalDeck(i).DrawCard
                    CardIsSelected = True

                End If
            End If
        End If
    Next
    
    done = False
    

    bla = True
    bla2 = False
    bla3 = False
    
    
    For i = 0 To 6
        If Pile(i).CheckClicked(X, Y) Then
            If CardPile(i).numCards = 0 Then
                If CardIsSelected = False Then
                    If Pile(i).m_NumCards > 0 Then
                        CardPile(i).numCards = 1
                        ReDim CardPile(i).card(CardPile(i).numCards)
                        Set CardPile(i).card(0) = Pile(i).DrawCard
                        CardPile(i).card(0).FacingUp = True
                        done = True
                    End If
                Else
                    If SelectedCard.card(0).value = CARD_KING And Pile(i).m_NumCards = 0 And done = False Then
                        If SelectedCard.PosFrom = 0 Then AddToScore 5
                        If SelectedCard.PosFrom >= 1 And SelectedCard.PosFrom <= 4 Then AddToScore -15
                        AddCardsToPiles i
                        bla3 = True
                    Else
                        bla2 = True
                        ReturnSelectedCard
                        Exit For
                    End If
                End If
            End If
        End If
    Next
    
    bla = False
    
    For i = 0 To 6
        For j = CardPile(i).numCards - 1 To 0 Step -1
            If CardPile(i).card(j).Clicked(X, Y) Then
                If CardIsSelected = False Then
                    If done = False And bla = False And bla2 = False And bla3 = False And bla4 = False Then
                        GetCardsFromPile i, j
                    End If
                    Exit For
                Else
                    If CardPile(i).numCards > 0 Then
                        If (SuitsAreOpposite(SelectedCard.card(0), CardPile(i).card(CardPile(i).numCards - 1))) And (SelectedCard.card(0).value = CardPile(i).card(CardPile(i).numCards - 1).value - 1) Then
                            If SelectedCard.PosFrom = 0 Then
                                AddToScore 5
                            ElseIf SelectedCard.PosFrom >= 1 And SelectedCard.PosFrom <= 4 Then
                                AddToScore -15
                            End If
                            AddCardsToPiles i
                            Exit For
                        Else
                            ReturnSelectedCard
                            bla = True
                            Exit For
                        End If
                    End If
                End If
            End If
        Next
    Next
    
    If GoalDeck(0).m_NumCards = 14 And GoalDeck(1).m_NumCards = 14 And GoalDeck(2).m_NumCards = 14 And GoalDeck(3).m_NumCards = 14 Then
        MsgBox "Hurrah, you won.", , "Solitaire!"
        Solitaire_New_Game
    End If
    
End Sub

Sub Solitaire_CheckMouseMove(ByVal X As Single, Y As Single)
    If CardIsSelected Then
        SelectedCard.card(0).left = X - CARD_WIDTH / 2
        SelectedCard.card(0).Top = Y - CARD_HEIGHT / 2
    End If
End Sub

Sub Solitaire_Render(Form As Form)
    Dim i As Integer, j As Integer
    Dim DrawOffsetX As Integer, DrawOffsetY As Integer
    
    DrawOffsetX = 2
    DrawOffsetY = 15
    
    frmSolitaire.Cls
    
    Rectangle offScreenDC, 0, 0, screenWidth, screenHeight
    
    GameDeck.Draw 10, 10, 2, 2, 5
    DispDeck.Draw 100, 10, 15, 0, , True, True
    
    For i = 0 To 3
        GoalDeck(i).Draw 280 + 90 * i, 10, 1, 2, 5, True, True
    Next
    
    For i = 0 To 6
        Pile(i).Draw 10 + 90 * i, 130, 2, 3, 7
    Next
    
    For i = 0 To 6
        For j = 0 To CardPile(i).numCards - 1
            CardPile(i).card(j).Draw (Pile(i).left + 2 * Pile(i).m_NumCards) + DrawOffsetX * j, (Pile(i).Top + 3 * Pile(i).m_NumCards) + DrawOffsetY * j
        Next
    Next
    
    If CardIsSelected Then
        For i = 0 To NumSelected - 1
            SelectedCard.card(i).Draw SelectedCard.card(0).left + DrawOffsetX * i, SelectedCard.card(0).Top + DrawOffsetY * i
        Next
    End If
    
    BitBlt Form.hdc, 0, 0, screenWidth, screenHeight, offScreenDC, 0, 0, vbSrcCopy
    
    frmSolitaire.Refresh
End Sub

Private Sub ReturnSelectedCard()
    Dim Index As Integer

    If SelectedCard.PosFrom = 0 Then
        DispDeck.AddCardToTop SelectedCard.card(0)
        DispDeck.NumToDraw = DispDeck.NumToDraw + 1
        CardIsSelected = False
    ElseIf SelectedCard.PosFrom >= 1 And SelectedCard.PosFrom <= 4 Then
        GoalDeck(SelectedCard.PosFrom - 1).AddCardToTop SelectedCard.card(0)
        CardIsSelected = False
    ElseIf SelectedCard.PosFrom >= 5 And SelectedCard.PosFrom <= 11 Then
        Index = SelectedCard.PosFrom - 5
        AddCardsToPiles Index
        
    End If
    
    CardIsSelected = False
End Sub

Private Sub AddCardsToGoalDecks(Index As Integer)
    Dim ItsAllGood As Boolean
    
    If NumSelected = 1 Then
        If GoalDeck(Index).m_NumCards = 0 Then
            If SelectedCard.card(0).value = CARD_ACE Then
                ItsAllGood = True
                GoalDeck(Index).AddCardToTop SelectedCard.card(0)
                CardIsSelected = False
                
            End If
        Else
            If SelectedCard.card(0).value = GoalDeck(Index).GetTopCard.value + 1 Then
                If SelectedCard.card(0).Suit = GoalDeck(Index).GetTopCard.Suit Then
                    ItsAllGood = True
                    GoalDeck(Index).AddCardToTop SelectedCard.card(0)
                    CardIsSelected = False
                End If
            End If
        End If
    Else
        ReturnSelectedCard
        ItsAllGood = True
        bla4 = True
    End If
    
    If ItsAllGood = False Then
        ReturnSelectedCard
        NumSelected = 0
    Else
        SelectedCard.PosFrom = Index + 1
    End If
    
    CardIsSelected = False
End Sub

Private Sub AddCardsToPiles(Index As Integer)
    Dim i As Integer
    For i = 0 To NumSelected - 1
        CardPile(Index).numCards = CardPile(Index).numCards + 1
        ReDim Preserve CardPile(Index).card(CardPile(Index).numCards)
        Set CardPile(Index).card(CardPile(Index).numCards - 1) = SelectedCard.card(i)

    Next
    
    CardIsSelected = False
End Sub

Private Sub GetCardsFromPile(pileIndex As Integer, cardIndex As Integer)
    Dim i As Integer, curIndex As Integer
    
    curIndex = 0
    
    SelectedCard.PosFrom = pileIndex + 5
    NumSelected = CardPile(pileIndex).numCards - cardIndex
    ReDim SelectedCard.card(NumSelected)
    
    For i = cardIndex To CardPile(pileIndex).numCards - 1
        Set SelectedCard.card(curIndex) = CardPile(pileIndex).card(i)
        curIndex = curIndex + 1
    Next
    
    CardPile(pileIndex).numCards = CardPile(pileIndex).numCards - NumSelected
    
    CardIsSelected = True
    
End Sub

Private Sub AddToScore(ByVal amount As Integer)
    If keepingScore Then
        Score = Score + amount
        If Score < 0 Then Score = 0
        frmSolitaire.lblScore.Caption = "Score: " & Score
    End If
End Sub


ClassModüle1

Option Explicit

Public Top As Integer
Public bottom As Integer
Public left As Integer
Public right As Integer
Private cardIndex As Integer
Private m_Suit As eSuit
Private m_Value As eValue
Private m_FacingUp As Boolean

Property Get Card_Index()
    Card_Index = cardIndex
End Property

Property Get Suit() As eSuit
    Suit = m_Suit
End Property

Property Let Suit(value As eSuit)
    m_Suit = value
    cardIndex = m_Suit * 13 + m_Value - 1
End Property

Property Get value() As eValue
    value = m_Value
End Property

Property Let value(CardValue As eValue)
    m_Value = CardValue
    cardIndex = m_Suit * 13 + m_Value - 1
End Property

Property Get FacingUp() As Boolean
    FacingUp = m_FacingUp
End Property

Property Let FacingUp(value As Boolean)
    m_FacingUp = value
End Property

Public Sub Draw(ByVal X As Integer, ByVal Y As Integer, Optional BackIndex As Integer = 0)
    Top = Y
    left = X
    right = X + CARD_WIDTH
    bottom = Y + CARD_HEIGHT
    
    If cardIndex <> -1 Then
    
        If (m_Value = 0) And (m_Suit = 0) Then
            BitBlt offScreenDC, X, Y, CARD_WIDTH, CARD_HEIGHT, ErrorPic.hdc, 0, 0, vbSrcCopy
        Else
            If m_FacingUp Then
                BitBlt offScreenDC, X, Y, CARD_WIDTH, CARD_HEIGHT, CardPics(cardIndex).hdc, 0, 0, vbSrcCopy
            Else
                BitBlt offScreenDC, X, Y, CARD_WIDTH, CARD_HEIGHT, DeckBacks(BackIndex).hdc, 0, 0, vbSrcCopy
            End If
        
            
        End If
    
    End If
End Sub

Private Sub Class_Initialize()
    m_FacingUp = True
End Sub

Public Function Clicked(ByVal X As Single, ByVal Y As Single) As Boolean
    Clicked = False
    If cardIndex <> -1 Then
        If X >= left And X <= right And Y >= Top And Y <= bottom Then
            Clicked = True
        End If
    End If
End Function

ClassModüle2

Option Explicit

Const NumCardsInADeck = 52

Public Top As Integer
Public bottom As Integer
Public left As Integer
Public right As Integer

Public DeckBack As Integer
Public NumToDraw As Integer
Public m_NumCards As Integer
Private m_Card() As New clsCard

Property Get card(Index As Integer) As clsCard
    Set card = m_Card(Index)
End Property

Property Let card(Index As Integer, CardValue As clsCard)
    Set m_Card(Index) = CardValue
End Property

Private Sub Class_Initialize()

    Dim i As Integer
    Dim currSuit As Integer, currValue As Integer
    
    Randomize
    
    currSuit = 0
    currValue = 1
    
    NumToDraw = 3
    
    m_NumCards = NumCardsInADeck
    DeckBack = Rnd * 11 + 1
    
    ReDim m_Card(m_NumCards)
    
    For i = 0 To m_NumCards - 1
        m_Card(i).Suit = currSuit
        m_Card(i).value = currValue
        
        currValue = currValue + 1
        
        If currValue > 13 Then
            currValue = 1
            currSuit = currSuit + 1
        End If
        
        If currSuit > 4 Then currSuit = 1
    Next
    
End Sub

Public Sub Initialize(DeckSize As Integer, Optional theDeckBack As Integer = -1)
    Dim i As Integer
    Dim currSuit As Integer, currValue As Integer
    
    Randomize

    currSuit = 0
    currValue = 1
    
    m_NumCards = DeckSize
    
    If theDeckBack = -1 Then
        DeckBack = Rnd * 9 + 2
    Else
        DeckBack = theDeckBack
    End If
    
    ReDim m_Card(m_NumCards)
    
    For i = 0 To m_NumCards - 1
        m_Card(i).Suit = currSuit
        m_Card(i).value = currValue
        
        currValue = currValue + 1
        
        If currValue > 13 Then
            currValue = 1
            currSuit = currSuit + 1
        End If
        
        If currSuit > 4 Then currSuit = 1
    Next
End Sub


Public Sub Shuffle()

    Dim i As Integer
    Dim Temp As Integer
    Dim used() As Boolean
    Dim tempCards() As New clsCard
    Dim ShuffleCount As Integer
    
    ReDim used(m_NumCards)
    ReDim tempCards(m_NumCards)
    
    For i = 0 To m_NumCards - 1
        tempCards(i).Suit = m_Card(i).Suit
        tempCards(i).value = m_Card(i).value
    Next
    
    For i = 0 To m_NumCards - 1
        Temp = Int(Rnd * m_NumCards)
        Do While used(Temp) = True
            Temp = Int(Rnd * m_NumCards)
        Loop
        
        m_Card(i).Suit = tempCards(Temp).Suit
        m_Card(i).value = tempCards(Temp).value
        
        used(Temp) = True
    Next
End Sub

Public Sub Draw(X As Integer, Y As Integer, OffsetX As Integer, OffsetY As Integer, Optional theNumToDraw As Integer = -1, Optional FacingUp As Boolean = False, Optional TopCardFacingUp As Boolean = False)
    Dim DrawPosX As Integer, DrawPosY As Integer, i As Integer
    DrawPosX = X
    DrawPosY = Y
    
    If NumToDraw < 0 Then NumToDraw = 0
    If theNumToDraw <> -1 Then NumToDraw = theNumToDraw
    
    Top = Y
    left = X
    right = X + OffsetX * NumToDraw + CARD_WIDTH
    bottom = Y + OffsetY * NumToDraw + CARD_HEIGHT
    
    If m_NumCards = 0 Then
        BitBlt offScreenDC, DrawPosX, DrawPosY, 71, 96, DeckBacks(0).hdc, 0, 0, vbSrcCopy
        Exit Sub
    End If
    
    If NumToDraw > m_NumCards Then NumToDraw = m_NumCards
    
    For i = m_NumCards - NumToDraw To m_NumCards - 1
        If i = m_NumCards - 1 Then
            m_Card(i).FacingUp = TopCardFacingUp
        Else
            m_Card(i).FacingUp = FacingUp
        End If
    
        m_Card(i).Draw DrawPosX, DrawPosY, DeckBack
        
        DrawPosX = DrawPosX + OffsetX
        DrawPosY = DrawPosY + OffsetY
    Next
End Sub

Function DrawCard() As clsCard
    If m_NumCards > 0 Then
        m_NumCards = m_NumCards - 1
        Set DrawCard = m_Card(m_NumCards)
    End If
End Function

Public Sub KillTopCard()
    If m_NumCards > 0 Then
        m_NumCards = m_NumCards - 1
        'ReDim Preserve m_Card(m_NumCards)
    End If
End Sub

Public Sub KillCards(StartIndex As Long, Optional EndIndex As Integer = 1)
    Dim i As Long
    
    For i = StartIndex To EndIndex
        m_Card(i) = m_Card(i + 1)
    Next
    
    m_NumCards = m_NumCards - EndIndex - StartIndex + 1
    
    ReDim Preserve m_Card(m_NumCards)
End Sub

Function GetTopCard() As clsCard
    If m_NumCards > 0 Then
        Set GetTopCard = m_Card(m_NumCards - 1)
    End If
End Function

Sub AddCardToTop(card As clsCard)
    m_NumCards = m_NumCards + 1
    
    ReDim Preserve m_Card(m_NumCards)
    
    Set m_Card(m_NumCards - 1) = card
End Sub

Function CheckClicked(ByVal X As Single, ByVal Y As Single) As Boolean
    CheckClicked = (X >= left And X <= right And Y >= Top And Y <= bottom)
End Function

OĞULCAN & OLCAYTUĞ

Oğulcan Excel Web Sitesi
Excel İle Programlama
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task