Imports System.Drawing
Imports System.Windows.Forms

Public Class form1
    Inherits Form

    ' Card dimensions
    Private Const CARD_WIDTH As Integer = 73
    Private Const CARD_HEIGHT As Integer = 97
    Private Const CARD_SPACING As Integer = 25
    Private Const PILE_OFFSET As Integer = 20

    ' Game areas
    Private stockPile As New List(Of Card)
    Private wastePile As New List(Of Card)
    Private foundationPiles(3) As List(Of Card)
    Private tableauPiles(6) As List(Of Card)

    ' UI elements
    Private stockPicture As PictureBox
    Private wastePicture As PictureBox
    Private foundationPictures(3) As PictureBox
    Private tableauPictures(6) As List(Of PictureBox)
    Private draggedCards As New List(Of PictureBox)
    Private dragOffset As Point

    ' Deck and game state
    Private deck As New List(Of Card)
    Private random As New Random()
    Private dragging As Boolean = False

    Private dragCard As Card = Nothing
    Private dragSourcePile As String = ""
    Private dragSourceIndex As Integer = -1
    Private dragVisual As PictureBox = Nothing

    Public Sub New()
        Me.Text = "Solitaire"
        Me.Size = New Size(800, 600)
        Me.BackColor = Color.DarkGreen
        Me.DoubleBuffered = True
        InitializeGame()
        CreateControls()
        DealCards()
    End Sub

    ' Card class representing a playing card
    Private Class Card
        Public Property Suit As String
        Public Property Rank As Integer
        Public Property FaceUp As Boolean
        Public Property PictureBox As PictureBox

        Public Sub New(suit As String, rank As Integer)
            Me.Suit = suit
            Me.Rank = rank
            Me.FaceUp = False
        End Sub

        Public Function GetColor() As Color
            If Suit = "Hearts" OrElse Suit = "Diamonds" Then
                Return Color.Red
            Else
                Return Color.Black
            End If
        End Function

        Public Function GetRankSymbol() As String
            Select Case Rank
                Case 1 : Return "A"
                Case 11 : Return "J"
                Case 12 : Return "Q"
                Case 13 : Return "K"
                Case Else : Return Rank.ToString()
            End Select
        End Function
    End Class

    Private Sub InitializeGame()
        ' Initialize piles
        For i As Integer = 0 To 3
            foundationPiles(i) = New List(Of Card)
        Next

        For i As Integer = 0 To 6
            tableauPiles(i) = New List(Of Card)
            tableauPictures(i) = New List(Of PictureBox)
        Next

        ' Create deck
        Dim suits() As String = {"Hearts", "Diamonds", "Clubs", "Spades"}
        For Each suit As String In suits
            For rank As Integer = 1 To 13
                deck.Add(New Card(suit, rank))
            Next
        Next

        ' Shuffle deck
        ShuffleDeck()
    End Sub

    Private Sub ShuffleDeck()
        For i As Integer = deck.Count - 1 To 0 Step -1
            Dim j As Integer = random.Next(i + 1)
            Dim temp As Card = deck(i)
            deck(i) = deck(j)
            deck(j) = temp
        Next
    End Sub

    Private Sub CreateControls()
        ' Create stock pile
        stockPicture = New PictureBox With {
            .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
            .Location = New Point(20, 20),
            .BackColor = Color.White,
            .BorderStyle = BorderStyle.FixedSingle,
            .Tag = "Stock"
        }
        AddHandler stockPicture.MouseDown, AddressOf Stock_MouseDown
        Me.Controls.Add(stockPicture)

        ' Create waste pile
        wastePicture = New PictureBox With {
            .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
            .Location = New Point(stockPicture.Right + 20, 20),
            .BackColor = Color.LightGray,
            .BorderStyle = BorderStyle.FixedSingle,
            .Tag = "Waste"
        }
        AddHandler wastePicture.MouseDown, AddressOf Waste_MouseDown
        Me.Controls.Add(wastePicture)

        ' Create foundation piles
        For i As Integer = 0 To 3
            foundationPictures(i) = New PictureBox With {
                .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
                .Location = New Point(wastePicture.Right + 40 + (i * (CARD_WIDTH + 10)), 20),
                .BackColor = Color.LightGray,
                .BorderStyle = BorderStyle.FixedSingle,
                .Tag = "Foundation" & i
            }
            AddHandler foundationPictures(i).MouseDown, AddressOf Foundation_MouseDown
            Me.Controls.Add(foundationPictures(i))
        Next

        ' Create tableau piles
        For i As Integer = 0 To 6
            Dim pilePicture As New PictureBox With {
                .Size = New Size(CARD_WIDTH, CARD_HEIGHT + (CARD_SPACING * 10)),
                .Location = New Point(20 + (i * (CARD_WIDTH + 10)), 150),
                .BackColor = Color.Transparent,
                .BorderStyle = BorderStyle.FixedSingle,
                .Tag = "Tableau" & i
            }
            AddHandler pilePicture.MouseDown, AddressOf Tableau_MouseDown
            Me.Controls.Add(pilePicture)
        Next
    End Sub

    Private Sub DealCards()
        ' Clear all piles
        stockPile.Clear()
        wastePile.Clear()
        For i As Integer = 0 To 3
            foundationPiles(i).Clear()
        Next
        For i As Integer = 0 To 6
            tableauPiles(i).Clear()
        Next

        ' Add all cards to stock
        stockPile.AddRange(deck)

        ' Deal to tableau
        For i As Integer = 0 To 6
            For j As Integer = i To 6
                Dim card As Card = stockPile(0)
                stockPile.RemoveAt(0)
                tableauPiles(j).Add(card)
                If j = i Then ' Last card in each column
                    card.FaceUp = True
                End If
            Next
        Next

        UpdateDisplay()
    End Sub

    Private Sub UpdateDisplay()
        ' Clear all card pictures
        For Each ctrl As Control In Me.Controls
            If TypeOf ctrl Is PictureBox AndAlso ctrl.Tag IsNot Nothing AndAlso
               (DirectCast(ctrl.Tag, String).StartsWith("Card_") OrElse
                DirectCast(ctrl.Tag, String).StartsWith("WasteCard_")) Then
                Me.Controls.Remove(ctrl)
            End If
        Next

        ' Display stock pile
        If stockPile.Count > 0 Then
            stockPicture.BackColor = Color.White
            stockPicture.Image = Nothing
        Else
            stockPicture.BackColor = Color.LightGray
        End If

        ' Display waste pile
        DisplayWastePile()

        ' Display foundation piles
        For i As Integer = 0 To 3
            DisplayFoundationPile(i)
        Next

        ' Display tableau piles
        For i As Integer = 0 To 6
            DisplayTableauPile(i)
        Next
    End Sub

    Private Sub DisplayWastePile()
        If wastePile.Count > 0 Then
            Dim topCard As Card = wastePile(wastePile.Count - 1)
            Dim pb As New PictureBox With {
                .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
                .Location = wastePicture.Location,
                .BackColor = Color.White,
                .BorderStyle = BorderStyle.FixedSingle,
                .Tag = "WasteCard_Top"
            }
            AddHandler pb.Paint, Sub(sender As Object, e As PaintEventArgs)
                                     DrawCard(e.Graphics, topCard, New Rectangle(0, 0, CARD_WIDTH, CARD_HEIGHT))
                                 End Sub
            AddHandler pb.MouseDown, AddressOf WasteCard_MouseDown
            Me.Controls.Add(pb)
            pb.BringToFront()
        End If
    End Sub

    Private Sub DisplayFoundationPile(index As Integer)
        If foundationPiles(index).Count > 0 Then
            Dim topCard As Card = foundationPiles(index)(foundationPiles(index).Count - 1)
            foundationPictures(index).BackColor = Color.White
            AddHandler foundationPictures(index).Paint, Sub(sender As Object, e As PaintEventArgs)
                                                            DrawCard(e.Graphics, topCard, New Rectangle(0, 0, CARD_WIDTH, CARD_HEIGHT))
                                                        End Sub
        Else
            foundationPictures(index).BackColor = Color.LightGray
            foundationPictures(index).Image = Nothing
        End If
    End Sub

    Private Sub DisplayTableauPile(index As Integer)
        Dim x As Integer = 20 + (index * (CARD_WIDTH + 10))
        Dim y As Integer = 150

        ' Clear existing card pictures for this pile
        For Each ctrl As Control In Me.Controls
            If TypeOf ctrl Is PictureBox AndAlso ctrl.Tag IsNot Nothing AndAlso
               DirectCast(ctrl.Tag, String) = "TableauCard_" & index Then
                Me.Controls.Remove(ctrl)
            End If
        Next

        ' Display cards in tableau pile
        For i As Integer = 0 To tableauPiles(index).Count - 1
            Dim card As Card = tableauPiles(index)(i)
            Dim pb As New PictureBox With {
                .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
                .Location = New Point(x, y + (i * PILE_OFFSET)),
                .BackColor = Color.White,
                .BorderStyle = BorderStyle.FixedSingle,
.Tag = String.Format("TableauCard_{0}_{1}", index, i)
            }

            If card.FaceUp Then
                AddHandler pb.Paint, Sub(sender As Object, e As PaintEventArgs)
                                         DrawCard(e.Graphics, card, New Rectangle(0, 0, CARD_WIDTH, CARD_HEIGHT))
                                     End Sub
            Else
                pb.BackColor = Color.Blue
            End If

            AddHandler pb.MouseDown, AddressOf TableauCard_MouseDown
            Me.Controls.Add(pb)
            pb.BringToFront()
        Next
    End Sub

    Private Sub DrawCard(g As Graphics, card As Card, rect As Rectangle)
        g.FillRectangle(Brushes.White, rect)
        g.DrawRectangle(Pens.Black, rect)

        Dim font As New Font("Arial", 12)
        Dim brush As Brush = If(card.GetColor() = Color.Red, Brushes.Red, Brushes.Black)

        ' Draw rank and suit
        g.DrawString(card.GetRankSymbol(), font, brush, 5, 5)
        g.DrawString(card.Suit.Substring(0, 1), font, brush, 5, 25)

        ' Draw suit symbol in center
        Dim suitFont As New Font("Arial", 20)
        Dim suitSymbol As String = GetSuitSymbol(card.Suit)
        g.DrawString(suitSymbol, suitFont, brush, rect.Width \ 2 - 10, rect.Height \ 2 - 10)
    End Sub

    Private Function GetSuitSymbol(suit As String) As String
        Select Case suit
            Case "Hearts" : Return "♥"
            Case "Diamonds" : Return "♦"
            Case "Clubs" : Return "♣"
            Case "Spades" : Return "♠"
            Case Else : Return ""
        End Select
    End Function

    ' Event handlers
    Private Sub Stock_MouseDown(sender As Object, e As MouseEventArgs)
        If stockPile.Count > 0 Then
            ' Draw three cards to waste
            For i As Integer = 1 To Math.Min(3, stockPile.Count)
                Dim card As Card = stockPile(0)
                stockPile.RemoveAt(0)
                card.FaceUp = True
                wastePile.Add(card)
            Next
            UpdateDisplay()
        Else
            ' Reset stock from waste
            For i As Integer = wastePile.Count - 1 To 0 Step -1
                Dim card As Card = wastePile(i)
                card.FaceUp = False
                stockPile.Insert(0, card)
            Next
            wastePile.Clear()
            UpdateDisplay()
        End If
    End Sub

    Private Sub Waste_MouseDown(sender As Object, e As MouseEventArgs)
        ' Handle waste pile click
    End Sub

    Private Sub WasteCard_MouseDown(sender As Object, e As MouseEventArgs)

        If wastePile.Count = 0 Then Return

        Dim card As Card = wastePile(wastePile.Count - 1)

        StartDragging(
        CType(sender, Control),
        card,
        "Waste",
        wastePile.Count - 1,
        e)

    End Sub

    Private Sub Foundation_MouseDown(sender As Object, e As MouseEventArgs)
        Dim index As Integer = Integer.Parse(DirectCast(sender, PictureBox).Tag.ToString().Substring(10))
        If foundationPiles(index).Count > 0 Then
            Dim card As Card =
    foundationPiles(index)(
        foundationPiles(index).Count - 1)

            StartDragging(
    CType(sender, Control),
    card,
    "Foundation" & index,
    foundationPiles(index).Count - 1,
    e)
        End If
    End Sub

    Private Sub Tableau_MouseDown(sender As Object, e As MouseEventArgs)
        ' Handle empty tableau pile click
    End Sub

    Private Sub TableauCard_MouseDown(sender As Object,
                                  e As MouseEventArgs)

        Dim parts() As String =
        CType(sender, PictureBox).Tag.ToString().Split("_"c)

        Dim pileIndex As Integer = Integer.Parse(parts(1))
        Dim cardIndex As Integer = Integer.Parse(parts(2))

        Dim card As Card =
        tableauPiles(pileIndex)(cardIndex)

        If Not card.FaceUp Then Return

        StartDragging(
        CType(sender, Control),
        card,
        "Tableau" & pileIndex,
        cardIndex,
        e)

    End Sub

    Private Sub TableauCard_MouseDown2(sender As Object,
                                  e As MouseEventArgs)

        Dim parts() As String =
        CType(sender, PictureBox).Tag.ToString().Split("_"c)

        Dim pileIndex As Integer = Integer.Parse(parts(1))
        Dim cardIndex As Integer = Integer.Parse(parts(2))

        Dim card As Card = tableauPiles(pileIndex)(cardIndex)

        If Not card.FaceUp Then Return

        StartDragging(
        CType(sender, Control),
        card,
        "Tableau" & pileIndex,
        cardIndex,
        e)

    End Sub

    Private Sub StartDragging(sender As Control,
                          card As Card,
                          sourcePile As String,
                          sourceIndex As Integer,
                          e As MouseEventArgs)

        dragging = True

        dragCard = card
        dragSourcePile = sourcePile
        dragSourceIndex = sourceIndex

        dragOffset = e.Location

        dragVisual = New PictureBox With {
        .Size = New Size(CARD_WIDTH, CARD_HEIGHT),
        .Location = sender.Parent.PointToClient(sender.PointToScreen(Point.Empty)),
        .BackColor = Color.White,
        .BorderStyle = BorderStyle.FixedSingle
    }

        AddHandler dragVisual.Paint,
        Sub(s, pe)
            DrawCard(pe.Graphics,
                     dragCard,
                     New Rectangle(0, 0, CARD_WIDTH, CARD_HEIGHT))
        End Sub

        Me.Controls.Add(dragVisual)
        dragVisual.BringToFront()

        Me.Capture = True
    End Sub

    Private Sub Game_MouseMove(sender As Object, e As MouseEventArgs)
        If dragging AndAlso draggedCards.Count > 0 Then
            For Each pb As PictureBox In draggedCards
                pb.Location = New Point(e.X - dragOffset.X, e.Y - dragOffset.Y)
            Next
        End If
    End Sub

    Private Sub Game_MouseUp(sender As Object, e As MouseEventArgs)
        If dragging Then
            dragging = False
            RemoveHandler Me.MouseMove, AddressOf Game_MouseMove
            RemoveHandler Me.MouseUp, AddressOf Game_MouseUp

            ' Check for valid drop locations
            Dim dropLocation As Point = e.Location

            ' Check foundation piles
            For i As Integer = 0 To 3
                If foundationPictures(i).Bounds.Contains(dropLocation) Then
                    ' Check if move is valid
                    If CanMoveToFoundation(dragCard, i) Then

                    End If
                    ' Move card to foundation
                    ' Implementation would go here
                End If
            Next

            ' Check tableau piles
            For i As Integer = 0 To 6
                Dim tableauBounds As New Rectangle(
                    20 + (i * (CARD_WIDTH + 10)),
                    150,
                    CARD_WIDTH,
                    CARD_HEIGHT + (CARD_SPACING * 10)
                )
                If tableauBounds.Contains(dropLocation) Then
                    ' Check if move is valid
                    If CanMoveToTableau(dragCard, i) Then
                        ' Move card to tableau
                        ' Implementation would go here
                    End If
                End If
            Next

            ' Remove dragged cards
            For Each pb As PictureBox In draggedCards
                Me.Controls.Remove(pb)
            Next
            draggedCards.Clear()

            UpdateDisplay()
        End If
    End Sub

    Private Function CanMoveToFoundation(card As Card,
                                     foundationIndex As Integer) As Boolean

        Dim pile = foundationPiles(foundationIndex)

        If pile.Count = 0 Then
            Return card.Rank = 1
        End If

        Dim topCard = pile.Last()

        Return topCard.Suit = card.Suit AndAlso
           card.Rank = topCard.Rank + 1

    End Function

    Private Function CanMoveToTableau(card As Card,
                                  tableauIndex As Integer) As Boolean

        Dim pile = tableauPiles(tableauIndex)

        If pile.Count = 0 Then
            Return card.Rank = 13
        End If

        Dim topCard = pile.Last()

        Return topCard.FaceUp AndAlso
           topCard.GetColor() <> card.GetColor() AndAlso
           topCard.Rank = card.Rank + 1

    End Function

    Protected Overrides Sub OnMouseMove(e As MouseEventArgs)

        MyBase.OnMouseMove(e)

        If Not dragging Then Return
        If dragVisual Is Nothing Then Return

        dragVisual.Left = e.X - dragOffset.X
        dragVisual.Top = e.Y - dragOffset.Y

    End Sub

    Protected Overrides Sub OnMouseUp(e As MouseEventArgs)

        MyBase.OnMouseUp(e)

        If Not dragging Then Return

        Me.Capture = False

        Dim dropped As Boolean = False

        ' Foundations
        For i As Integer = 0 To 3

            If foundationPictures(i).Bounds.Contains(e.Location) Then

                If CanMoveToFoundation(dragCard, i) Then

                    MoveCardToFoundation(i)

                    dropped = True
                End If

                Exit For

            End If

        Next

        ' Tableau
        If Not dropped Then

            For i As Integer = 0 To 6

                Dim pileRect As Rectangle =
                New Rectangle(
                    20 + (i * (CARD_WIDTH + 10)),
                    150,
                    CARD_WIDTH,
                    400)

                If pileRect.Contains(e.Location) Then

                    If CanMoveToTableau(dragCard, i) Then

                        MoveCardToTableau(i)

                        dropped = True
                    End If

                    Exit For

                End If

            Next

        End If

        If dragVisual IsNot Nothing Then
            Me.Controls.Remove(dragVisual)
            dragVisual.Dispose()
            dragVisual = Nothing
        End If

        dragCard = Nothing
        dragSourcePile = ""
        dragSourceIndex = -1
        dragging = False

        UpdateDisplay()

    End Sub

    Private Sub MoveCardToFoundation(foundationIndex As Integer)

        RemoveDraggedCardFromSource()

        foundationPiles(foundationIndex).Add(dragCard)

        RevealNextTableauCard(dragSourcePile)

    End Sub

    Private Sub MoveCardToTableau(tableauIndex As Integer)

        RemoveDraggedCardFromSource()

        tableauPiles(tableauIndex).Add(dragCard)

        RevealNextTableauCard(dragSourcePile)

    End Sub

    Private Sub RemoveDraggedCardFromSource()

        If dragSourcePile = "Waste" Then

            wastePile.RemoveAt(dragSourceIndex)

        ElseIf dragSourcePile.StartsWith("Foundation") Then

            Dim i = Integer.Parse(dragSourcePile.Substring(10))
            foundationPiles(i).RemoveAt(dragSourceIndex)

        ElseIf dragSourcePile.StartsWith("Tableau") Then

            Dim i = Integer.Parse(dragSourcePile.Substring(7))
            tableauPiles(i).RemoveAt(dragSourceIndex)

        End If

    End Sub

    Private Sub RevealNextTableauCard(sourcePile As String)

        If sourcePile.StartsWith("Tableau") Then

            Dim i As Integer = Integer.Parse(sourcePile.Substring(7))

            If tableauPiles(i).Count > 0 Then

                Dim topCard As Card = tableauPiles(i)(tableauPiles(i).Count - 1)
                topCard.FaceUp = True

            End If

        End If

    End Sub

    ' Main entry point
    Public Shared Sub Main()
        Application.EnableVisualStyles()
        Application.SetCompatibleTextRenderingDefault(False)
        Application.Run(New Form1())
    End Sub
End Class
