Dominó BRAV

Dominó BRAV es una variante que me inventé del tradicional juego de dominó, que consiste en hacer coincidir colores con las cartas adyacentes.

Las cartas son cuadradas y están divididas en cuatro sectores coloreados en diferentes combinaciones de blanco, rojo, azul y verde (de ahí el nombre BRAV), de modo que al colocar una carta junto a otra dos sectores de cada una quedan en contacto con los de la otra.

Cada sector que coincide con el color del sector correspondiente de la carta adyacente es un punto para el jugador que colocó la carta.

He aquí el aspecto de la "mesa de juego". La interfaz es mínima y no hay mensajes, pero funciona así.

Instrucciones para el Dominó Brav.

Al hacer clic sobre el "mazo" que está abajo a la derecha pregunta si quiere empezar un nuevo juego. Esto se puede hacer en cualquier momento para iniciar otro juego aunque haya uno ya empezado.

Al responder que sí, parecen las cartas. El primer turno es del jugador de la derecha.

Al hacer clic izquierdo sobre una carta ésta se "activa" y se desplaza ligeramente. Al hacer clic nuevamente se "desactiva".

Para girar la carta hacer clic derecho sobre la carta activa tantas veces como sea necesario hasta obtener la posición deseada.

Una vez activada y rotada la carta convenientemente, hacer clic sobre el lugar donde se desea jugar la carta.

La cantidad de coincidencias obtenida aparece en en el recuadrito debajo de las cartas.

La carta jugada se repone inmediatamente con una nueva del mazo. La cantidad de cartas remanentes en el mazo aparece en el recuadrito abajo en el centro.

Una vez jugada una carta, el turno pasa al otro jugador.

Cuando el contador de cartas remanentes llega a 0 el juego prosigue pero ya no se reponen las cartas jugadas.

El juego termina cuando ambos jugadores han jugado todas las cartas.

Gana el que obtuvo más coincidencias.

Código fuente. (Descargar)

El juego está programado en Visual Basic 6.0. Los nombres de las variables y funciones, así como los comentarios, están en inglés.

Archivo de proyecto BravDomino.vbp

Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation
Form=frmDominoTable.frm
Class=Brav; Brav.cls
Class=BravDeck; BravDeck.cls
Class=BravCard; BravCard.cls
Class=CardNode; CardNode.cls
Module=mdlBravDomino; mdlBravDomino.bas
Startup="frmDominoTable"
HelpFile=""
ExeName32="BravDomino.exe"
Command32=""
Name="BravDomino"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="VBProjects"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1 
Formulario principal frmDominoTable.frm

VERSION 5.00
Begin VB.Form frmDominoTable
   BackColor       =   &H00008000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Brav Domino"
   ClientHeight    =   8295
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   8505
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   8295
   ScaleWidth      =   8505
   StartUpPosition =   2  'CenterScreen
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picRight
      Appearance      =   0  'Flat
      BackColor       =   &H00008000&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1215
      Index           =   0
      Left            =   7200
      ScaleHeight     =   1215
      ScaleWidth      =   1215
      TabIndex        =   3
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox picLeft
      Appearance      =   0  'Flat
      BackColor       =   &H00008000&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1215
      Index           =   0
      Left            =   120
      ScaleHeight     =   1215
      ScaleWidth      =   1215
      TabIndex        =   2
      Top             =   120
      Width           =   1215
   End
   Begin VB.PictureBox picBack
      Appearance      =   0  'Flat
      BackColor       =   &H00808000&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   1215
      Left            =   7080
      ScaleHeight     =   1215
      ScaleWidth      =   1215
      TabIndex        =   1
      Top             =   6840
      Width           =   1215
   End
   Begin VB.PictureBox picPlay
      Appearance      =   0  'Flat
      BackColor       =   &H0080FF80&
      BorderStyle     =   0  'None
      FontTransparent =   0   'False
      ForeColor       =   &H80000008&
      Height          =   1215
      Index           =   0
      Left            =   3720
      ScaleHeight     =   1215
      ScaleWidth      =   1215
      TabIndex        =   0
      Top             =   3600
      Width           =   1215
   End
   Begin VB.Label lblNodeCount
      Alignment       =   2  'Center
      BeginProperty Font
         Name            =   "MS Reference Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   3840
      TabIndex        =   6
      Top             =   7800
      Width           =   855
   End
   Begin VB.Label lblRight
      Alignment       =   2  'Center
      BeginProperty Font
         Name            =   "MS Reference Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7440
      TabIndex        =   5
      Top             =   6240
      Width           =   855
   End
   Begin VB.Label lblLeft
      Alignment       =   2  'Center
      BeginProperty Font
         Name            =   "MS Reference Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   4
      Top             =   6600
      Width           =   855
   End
End
Attribute VB_Name = "frmDominoTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_Deck As BravDeck

Private m_LeftHand(0 To 4) As BravCard
Private m_RightHand(0 To 4) As BravCard

Private m_iLeftIndex As Integer
Private m_iRightIndex As Integer

Private m_iLeftBorder As Integer
Private m_iRightBorder As Integer
Private m_iCardSize As Integer

Private m_iTableTopX As Integer
Private m_iTableTopY As Integer
Private m_iTableBottomX As Integer
Private m_iTableBottomY As Integer

Private m_Root As CardNode
Private m_iPicture As Integer
Private m_bLeft As Boolean

Private Sub Form_Load()
  Set m_Deck = New BravDeck
 
  m_Deck.UseFirst = False
 
  SetSides
 
  Randomize
End Sub

Private Sub Form_Paint()
  Line (m_iTableTopX, m_iTableTopY)- _
    (m_iTableBottomX, m_iTableBottomY), &H80FF80, BF
End Sub

Private Sub Form_Resize()
  If WindowState <> 1 Then SetLayout  ' If not minimized
End Sub

Private Sub SetLayout()
  Dim I As Integer
 
  m_iCardSize = _
    (ScaleHeight - c_DoubleMargin * (c_TableHeight + 1)) \ _
    c_TableHeight
  I = (ScaleWidth - c_DoubleMargin * 4) \ (c_TableWidth + 2)
 
  If I < m_iCardSize Then m_iCardSize = I
 
  m_iLeftBorder = c_DoubleMargin
  With picLeft(0)
    .Width = m_iCardSize
    .Height = m_iCardSize
    .Top = c_DoubleMargin
    .Left = m_iLeftBorder
  End With
 
  For I = 1 To 4
    With picLeft(I)
      .Width = m_iCardSize
      .Height = m_iCardSize
      .Top = BottomSide(picLeft(I - 1)) + c_DoubleMargin
      .Left = m_iLeftBorder
      .Visible = True
    End With
  Next
 
  With lblLeft
    .Top = BottomSide(picLeft(4)) + c_DoubleMargin
    .Left = RightSide(picLeft(4)) - .Width
  End With
 
  With picRight(0)
    .Width = m_iCardSize
    .Height = m_iCardSize
    m_iRightBorder = ScaleWidth - .Width - c_DoubleMargin
    .Top = c_DoubleMargin
    .Left = m_iRightBorder
  End With
 
  For I = 1 To 4
    With picRight(I)
      .Width = m_iCardSize
      .Height = m_iCardSize
      .Top = BottomSide(picRight(I - 1)) + c_DoubleMargin
      .Left = m_iRightBorder
      .Visible = True
    End With
  Next
 
  With lblRight
    .Top = BottomSide(picRight(4)) + c_DoubleMargin
    .Left = picRight(4).Left
  End With
 
  With lblNodeCount
    .Top = ScaleHeight - .Height - c_DoubleMargin
    .Left = (ScaleWidth - .Width) / 2
    .Caption = 35 - m_iPicture
  End With
 
  With picPlay(0)
    .Width = m_iCardSize
    .Height = m_iCardSize
    .Top = (lblNodeCount.Top - m_iCardSize) / 2
    .Left = (ScaleWidth - .Width) / 2
   
    m_iTableTopY = _
      .Top - m_iCardSize * c_MaxY - c_DoubleMargin
    m_iTableTopX = _
      .Left - m_iCardSize * c_MaxX - c_DoubleMargin
    m_iTableBottomY = _
      .Top + m_iCardSize * (c_MaxY + 1) + c_DoubleMargin
    m_iTableBottomX = _
      .Left + m_iCardSize * (c_MaxX + 1) + c_DoubleMargin
  End With
 
  With picBack
    .Width = m_iCardSize
    .Height = m_iCardSize
    .Top = ScaleHeight - .Height - c_DoubleMargin
    .Left = picRight(0).Left
  End With
End Sub

Private Sub SetNeighbours(ByRef Node As CardNode)
  Dim I As Integer
  Dim N As CardNode
  Dim P As PictureBox
  Dim pic As PictureBox
 
  Set pic = Node.Picture
 
  For I = 0 To 3
    Set N = Node.Neighbour(I)
    If Not N Is Nothing Then
      If N.Picture Is Nothing Then
        m_iPicture = m_iPicture + 1
        Load picPlay(m_iPicture)
       
        Set P = picPlay(m_iPicture)
       
        With P
          .Width = m_iCardSize
          .Height = m_iCardSize
         
          Select Case I
            Case eSideTop
              .Top = pic.Top - .Height
              .Left = pic.Left
            Case eSideRight
              .Top = pic.Top
              .Left = RightSide(pic)
            Case eSideBottom
              .Top = BottomSide(pic)
              .Left = pic.Left
            Case eSideLeft
              .Top = pic.Top
              .Left = pic.Left - .Width
          End Select
        End With
 
        With N
          Set .Picture = P
          .Index = m_iPicture
        End With
      End If
    End If
  Next
End Sub

Private Sub lblLeft_Click()
  CheckAll m_Root    ' Just for debugging
End Sub

Private Sub lblRight_Click()
  UncheckAll m_Root  ' Just for debugging
End Sub

Private Sub picBack_Click()
  If MsgBox("Start new game?", vbQuestion + vbYesNo, "New game") = _
    vbYes Then NewGame
End Sub

Private Sub picBack_Paint()
  With picBack
    .Cls
    .FillStyle = 7
    picBack.Line _
      (30, 30)-Step(.ScaleWidth - 75, .ScaleHeight - 75), , B
  End With
End Sub

Private Sub SetSides()
  Dim I As Integer
  Dim C As BravCard
 
  Set C = New BravCard
  With C
    Set .Picture = picLeft(0)
    .Index = 0
  End With
  Set m_LeftHand(0) = C
 
  For I = 1 To 4
    Load picLeft(I)
   
    Set C = New BravCard
    With C
      Set .Picture = picLeft(I)
      .Index = I
    End With
    Set m_LeftHand(I) = C
  Next
 
  Set C = New BravCard
  With C
    Set .Picture = picRight(0)
    .Index = 0
  End With
  Set m_RightHand(0) = C
 
  For I = 1 To 4
    Load picRight(I)
   
    Set C = New BravCard
    With C
      Set .Picture = picRight(I)
      .Index = I
    End With
    Set m_RightHand(I) = C
  Next
End Sub

Private Sub SetRoot()
  Set m_Root = New CardNode
 
  With m_Root
    .Index = 0
    .X = 0
    .Y = 0
    Set .Picture = picPlay(0)
    Set .Brav = m_Deck.Card(0)
  End With
 
  SetNeighbours m_Root
End Sub

Public Function FindNode(ByRef Node As CardNode, _
  ByVal iIndex As Integer) As CardNode
  Dim N As CardNode
  Dim I As Integer
 
  If Node Is Nothing Then
    Set N = Nothing
  ElseIf Node.Checked Then
    Set N = Nothing
  Else
    Node.Checked = True
    If Node.Index = iIndex Then
      Set N = Node
      UncheckAll Node
    Else
      For I = 0 To 3
        Set N = FindNode(Node.Neighbour(I), iIndex)
        If Not N Is Nothing Then Exit For
      Next
    End If
  End If
 
  Set FindNode = N
End Function

Private Sub NewGame()
  Dim I As Integer
 
  If Not m_Root Is Nothing Then m_Root.Dispose
 
  Do While m_iPicture
    Unload picPlay(m_iPicture)
    m_iPicture = m_iPicture - 1
  Loop
 
  SetRoot
 
  With m_Deck
    .Mix
   
    For I = 0 To 4
      Set m_LeftHand(I).Brav = .NextCard
      Set m_RightHand(I).Brav = .NextCard
    Next
 
    lblNodeCount = 35 - .Top
  End With
 
  m_iLeftIndex = -1
  m_iRightIndex = -1
  lblLeft = 0
  lblRight = 0
End Sub

Private Sub picLeft_MouseDown(Index As Integer, _
  Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Not m_bLeft Then Exit Sub
  If m_LeftHand(Index).IsEmpty Then Exit Sub
 
  If Button And vbRightButton Then
    If Index <> m_iLeftIndex Then Exit Sub
    m_LeftHand(m_iLeftIndex).RotateRight
    BestNode m_Root, m_LeftHand(m_iLeftIndex), True
    UncheckAll m_Root
  Else
    If m_iLeftIndex >= 0 Then picLeft(m_iLeftIndex).Left = m_iLeftBorder
    If m_iLeftIndex = Index Then
      m_iLeftIndex = -1
    Else
      picLeft(Index).Left = m_iLeftBorder + c_DoubleMargin
      m_iLeftIndex = Index
      BestNode m_Root, m_LeftHand(m_iLeftIndex), True
      UncheckAll m_Root
    End If
  End If
End Sub

Private Sub picRight_MouseDown(Index As Integer, _
  Button As Integer, Shift As Integer, X As Single, Y As Single)
  If m_bLeft Then Exit Sub
  If m_RightHand(Index).IsEmpty Then Exit Sub
 
  If Button And vbRightButton Then
    If Index <> m_iRightIndex Then Exit Sub
    m_RightHand(m_iRightIndex).RotateRight
    BestNode m_Root, m_RightHand(m_iRightIndex), True
    UncheckAll m_Root
  Else
    If m_iRightIndex >= 0 Then _
      picRight(m_iRightIndex).Left = m_iRightBorder
    If m_iRightIndex = Index Then
      m_iRightIndex = -1
    Else
      picRight(Index).Left = m_iRightBorder - c_DoubleMargin
      m_iRightIndex = Index
      BestNode m_Root, m_RightHand(m_iRightIndex), True
      UncheckAll m_Root
    End If
  End If
End Sub

Private Sub picLeft_Paint(Index As Integer)
  m_LeftHand(Index).Draw
End Sub

Private Sub picRight_Paint(Index As Integer)
  m_RightHand(Index).Draw
End Sub

Private Sub picPlay_Paint(Index As Integer)
  Dim N As CardNode
 
  Set N = FindNode(m_Root, Index)
 
  If Not N Is Nothing Then N.Draw
End Sub

Private Sub picPlay_Click(Index As Integer)
  Dim N As CardNode
  Dim C As BravCard
  Dim iBorder As Integer
  Dim bCount As Byte
 
  Set N = FindNode(m_Root, Index)
  If Not N.IsEmpty Then Exit Sub
 
  If m_bLeft Then
    If m_iLeftIndex < 0 Then Exit Sub
   
    Set C = m_LeftHand(m_iLeftIndex)
    iBorder = m_iLeftBorder
    m_iLeftIndex = -1
  Else
    If m_iRightIndex < 0 Then Exit Sub
   
    Set C = m_RightHand(m_iRightIndex)
    iBorder = m_iRightBorder
    m_iRightIndex = -1
  End If
 
  With C
    .Picture.Left = iBorder
    Set N.Brav = .Brav
    Set .Brav = m_Deck.NextCard
  End With
 
  bCount = MatchCount(N)
 
  If m_bLeft Then
    lblLeft = Val(lblLeft) + bCount
  Else
    lblRight = Val(lblRight) + bCount
  End If
 
  SetNeighbours N
 
  lblNodeCount = 35 - m_Deck.Top
  m_bLeft = Not m_bLeft
End Sub

Private Function MatchCount(ByRef Node As CardNode) As Byte
  Dim I As Integer
  Dim N As CardNode
  Dim bCount As Byte
 
  bCount = 0
 
  For I = 0 To 3
    Set N = Node.Neighbour(I)
    If Not N Is Nothing Then bCount = bCount + Node.Card.MatchCount(N.Card, I)
  Next
 
  MatchCount = bCount
End Function

Private Function TryCount(ByRef Card As BravCard, _
  ByRef Node As CardNode) As Byte
  Dim I As Integer
  Dim N As CardNode
  Dim bCount As Byte
 
  bCount = 0
  For I = 0 To 3
    Set N = Node.Neighbour(I)
    If Not N Is Nothing Then bCount = bCount + Card.MatchCount(N.Card, I)
  Next
 
  TryCount = bCount
End Function

Private Function BestNode(ByRef Node As CardNode, _
  ByRef Card As BravCard, ByVal bRestart As Boolean) As CardNode
  Static bMaxCount As Byte
  Static MaxNode As CardNode
 
  Dim N As CardNode
  Dim I As Integer
  Dim C As Byte
 
  If bRestart Then
    bMaxCount = 0
    Set MaxNode = Node
  End If
 
  With Node
    .Checked = True
   
    If .IsEmpty Then
      C = TryCount(Card, Node)
     
      If C > bMaxCount Then
        bMaxCount = C
        Set MaxNode = Node
      End If
    End If
   
    For I = 0 To 3
      Set N = .Neighbour(I)
      If Not N Is Nothing Then If Not N.Checked Then _
        Set MaxNode = BestNode(N, Card, False)
    Next
  End With
 
  Set BestNode = MaxNode
End Function

' Just for debugging
Private Sub CheckAll(ByRef Node As CardNode)
  Dim N As CardNode
  Dim I As Integer
 
  With Node
    .Checked = True
    Debug.Print "Checking "; .X; ","; .Y
    For I = 0 To 3
      Set N = .Neighbour(I)
      If Not N Is Nothing Then If Not N.Checked Then CheckAll N
    Next
  End With
End Sub

Private Sub UncheckAll(ByRef Node As CardNode)
  Dim N As CardNode
  Dim I As Integer
 
  With Node
    .Checked = False
    Debug.Print "Unchecking "; .X; ","; .Y
    For I = 0 To 3
      Set N = .Neighbour(I)
      If Not N Is Nothing Then If N.Checked Then UncheckAll N
    Next
  End With
End Sub


módulo mdlBravDomino.bas


Attribute VB_Name = "mdlBravDomino"
Option Explicit

Public Enum enumSide
  eSideTop
  eSideRight
  eSideBottom
  eSideLeft
End Enum

Public Enum enumColor
  eColWhite
  eColRed
  eColGreen
  eColBlue
End Enum

Public Const c_TableWidth As Integer = 11
Public Const c_TableHeight As Integer = 7

Public Const c_MaxY As Integer = c_TableHeight \ 2
Public Const c_MaxX As Integer = c_TableWidth \ 2
Public Const c_MinY As Integer = -c_MaxY
Public Const c_MinX As Integer = -c_MaxX

Public Const c_Margin As Integer = 120
Public Const c_HalfMargin As Integer = c_Margin \ 2
Public Const c_DoubleMargin As Integer = c_Margin * 2

Public Const c_pxMargin As Integer = c_Margin \ 15
Public Const c_pxHalfMargin As Integer = c_pxMargin \ 2
Public Const c_pxDoubleMargin As Integer = c_pxMargin * 2

Public Const c_RotLeft As Byte = 1
Public Const c_RotRight As Byte = 3

Public Function RightSide(ByRef obj As Object) As Long
  With obj
    RightSide = .Left + .Width
  End With
End Function

Public Function BottomSide(ByRef obj As Object) As Long
  With obj
    BottomSide = .Top + .Height
  End With
End Function

Public Function ColorArray(ByVal eColor As enumColor) As Long
  Select Case eColor
    Case eColWhite
      ColorArray = vbWhite
    Case eColRed
      ColorArray = vbRed
    Case eColGreen
      ColorArray = vbGreen
    Case eColBlue
      ColorArray = vbBlue
  End Select
End FunctionMódulo de clase Brav.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Brav"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private m_bRotation As Byte       ' 0..3
Private m_Sector(0 To 3) As Byte  ' 0=White, 1=Red, 2=Green, 3=Blue
Private m_Id As Byte

Public Property Let Rotation(ByVal bRotation As Byte)
  m_bRotation = bRotation Mod 4
End Property

Public Property Get Rotation() As Byte
  Rotation = m_bRotation
End Property

Public Sub Rotate(ByVal bRotation As Byte)
  m_bRotation = (m_bRotation + bRotation) Mod 4
End Sub

Public Property Let Sector(ByVal iSector As Byte, _
  ByVal bColor As Byte)
  Dim bOffset As Byte
 
  iSector = iSector Mod 4
  bColor = bColor Mod 4
 
  m_Sector(iSector) = bColor
 
  bOffset = 4 ^ iSector
  m_Id = m_Id And Not (3 * bOffset)   'Clean 2 bits
  m_Id = m_Id Or (bColor * bOffset)   'Set 2 bits
End Property

Public Property Get Id() As Byte
  Id = m_Id
End Property

Public Property Get Sector(ByVal iSector As Byte) As Byte
  Sector = m_Sector(iSector Mod 4)
End Property

Public Function Side(ByVal eSide As enumSide) As Byte
  Dim bStart As Byte
 
  bStart = m_bRotation + eSide
 
  Side = m_Sector(bStart Mod 4) * 10 + m_Sector((bStart + 1) Mod 4)
End Function

Public Function MatchCount(ByRef Neighbour As Brav, _
  ByVal eSide As enumSide) As Byte
  Dim bMySide As Byte
  Dim bNeighbourSide As Byte
  Dim bCount As Byte
 
  bMySide = Side(eSide)
  bNeighbourSide = Neighbour.Side((eSide + 2) Mod 4)
  bCount = 0
 
  If bMySide \ 10 = bNeighbourSide Mod 10 Then bCount = bCount + 1
  If bMySide Mod 10 = bNeighbourSide \ 10 Then bCount = bCount + 1
 
  MatchCount = bCount
End Function

Módulo de clase BravCard.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BravCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Event Activate()

Private m_Brav As Brav
Private m_Picture As PictureBox
Private m_iIndex As Integer

Private m_iBorder As Integer

Private Sub Class_Initialize()
  Dispose
  m_iIndex = -1
  m_iBorder = 15
End Sub

Public Sub Dispose()
  Set m_Brav = Nothing
  Set m_Picture = Nothing
End Sub

Public Property Get Brav() As Brav
  Set Brav = m_Brav
End Property

Public Property Set Brav(ByRef B As Brav)
  Set m_Brav = B
 
  If m_Brav Is Nothing Then
    m_Picture.Cls
  Else
    Draw
    RaiseEvent Activate
  End If
 
End Property

Public Property Get Picture() As PictureBox
  Set Picture = m_Picture
End Property

Public Property Set Picture(ByRef P As PictureBox)
  Set m_Picture = P
 
  m_Picture.Visible = True
End Property

Public Property Get Index() As Integer
  Index = m_iIndex
End Property

Public Property Let Index(ByVal iIndex As Integer)
  m_iIndex = iIndex
End Property

Public Property Get Border() As Integer
  Border = m_iBorder
End Property

Public Property Let Border(ByVal iBorder As Integer)
  m_iBorder = iBorder
End Property

Public Sub Draw()
  Dim iWidth As Integer
  Dim iHeight As Integer
  Dim X As Integer
  Dim Y As Integer
  Dim W As Integer
  Dim H As Integer
  Dim R As Byte
 
  If m_Picture Is Nothing Then Exit Sub
 
  With m_Picture
    iWidth = .ScaleWidth \ 2 - (m_iBorder + 10)
    iHeight = .ScaleHeight \ 2 - (m_iBorder + 10)
   
    .Cls
  End With
 
  If m_Brav Is Nothing Then
    With m_Picture
      .DrawStyle = 2
      m_Picture.Line _
        (0, 0)-Step(.ScaleWidth - 10, .ScaleHeight - 10), , B
    End With
  Else
    m_Picture.DrawStyle = 0
   
    With m_Brav
      R = .Rotation
     
      X = m_iBorder
      Y = m_iBorder
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), ColorArray(.Sector(R)), BF
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), , B
     
      X = m_iBorder + iWidth
      Y = m_iBorder
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), _
          ColorArray(.Sector((R + 1) Mod 4)), BF
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), , B
     
      X = m_iBorder + iWidth
      Y = m_iBorder + iHeight
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), _
          ColorArray(.Sector((R + 2) Mod 4)), BF
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), , B
     
      X = m_iBorder
      Y = m_iBorder + iHeight
      m_Picture.Line _
        (X, Y)-Step(iWidth, iHeight), _
          ColorArray(.Sector((R + 3) Mod 4)), BF
      m_Picture.Line (X, Y)-Step(iWidth, iHeight), , B
    End With
  End If
End Sub

Public Property Get IsEmpty() As Boolean
  IsEmpty = m_Brav Is Nothing
End Property

Public Function MatchCount(ByRef Neighbour As BravCard, _
  ByVal eSide As enumSide) As Byte
  With Neighbour
    If .IsEmpty Then
      MatchCount = 0
    Else
      MatchCount = m_Brav.MatchCount(.Brav, eSide)
    End If
  End With
End Function

Public Sub RotateRight()
  m_Brav.Rotate c_RotRight
  Draw
End Sub

Public Sub RotateLeft()
  m_Brav.Rotate c_RotLeft
  Draw
End Sub
Módulo de clase BravDeck.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BravDeck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const c_LastCard As Integer = 34

Private m_Brav(0 To c_LastCard) As Brav
Private m_bUseFirst As Boolean
Private m_iTopCard As Integer

Private Sub Class_Initialize()
  SetDeck
 
  m_bUseFirst = True
  m_iTopCard = 0
End Sub

Private Sub Class_Terminate()
  Dispose
End Sub

Public Sub Dispose()
  Dim I As Integer

  For I = 0 To c_LastCard
    Set m_Brav(I) = Nothing
  Next
End Sub

Private Sub SetDeck()
  Dim B As Brav
  Dim iBrav As Integer
 
  Dim I As Byte
  Dim S As Byte
  Dim C As Byte
 
  ' 1+1+1+1
  Set B = New Brav
  For S = 0 To 3
    B.Sector(S) = S
  Next
 
  iBrav = 0
  Set m_Brav(iBrav) = B
 
  ' 1+1+2
  For S = 0 To 3
    For C = 0 To 3
      If C <> S Then
        Set B = New Brav
        For I = 0 To 3
          If I = S Then
            B.Sector(I) = C
          Else
            B.Sector(I) = I
          End If
        Next
       
        iBrav = iBrav + 1
        Set m_Brav(iBrav) = B
      End If
    Next
  Next

  ' 2+2
  For S = 0 To 2
    For C = S + 1 To 3
      Set B = New Brav
      For I = 0 To 3
        If I = S Then
          B.Sector(I) = S
        ElseIf I = C Then
          B.Sector(I) = C
        ElseIf (I + 1) Mod 4 = S Then
          B.Sector(I) = S
        ElseIf (I + 1) Mod 4 = C Then
          B.Sector(I) = C
        ElseIf C - S = 1 Then
          B.Sector(I) = C
        Else
          B.Sector(I) = S
        End If
      Next
     
      iBrav = iBrav + 1
      Set m_Brav(iBrav) = B
    Next
  Next

  ' 1+3
  For S = 0 To 3
    For C = 0 To 3
      If C <> S Then
        Set B = New Brav
        For I = 0 To 3
          If I = S Then
            B.Sector(I) = I
          Else
            B.Sector(I) = C
          End If
        Next
       
        iBrav = iBrav + 1
        Set m_Brav(iBrav) = B
      End If
    Next
  Next

  ' 4
  For S = 0 To 3
    Set B = New Brav
    For I = 0 To 3
      B.Sector(I) = S
    Next
   
    iBrav = iBrav + 1
    Set m_Brav(iBrav) = B
  Next
End Sub

Public Property Get UseFirst() As Boolean
  UseFirst = m_bUseFirst
End Property

Public Property Let UseFirst(ByVal bUse As Boolean)
  m_bUseFirst = bUse
End Property

Public Property Get DeckEnd() As Boolean
  DeckEnd = m_iTopCard > c_LastCard
End Property

Public Property Get NextCard() As Brav
  If m_iTopCard > c_LastCard Then
    Set NextCard = Nothing
  Else
    Set NextCard = m_Brav(m_iTopCard)
    m_iTopCard = m_iTopCard + 1
  End If
End Property

Public Property Get TopCard() As Brav
  If m_iTopCard > c_LastCard Then
    Set TopCard = Nothing
  Else
    Set TopCard = m_Brav(m_iTopCard)
  End If
End Property

Public Property Get Card(ByVal iIndex As Integer) As Brav
  If iIndex < 0 Or iIndex > c_LastCard Then
    Set Card = Nothing
  Else
    Set Card = m_Brav(iIndex)
  End If
End Property

Public Property Get Top() As Integer
  Top = m_iTopCard
End Property

Public Sub Reset()
  m_iTopCard = IIf(m_bUseFirst, 0, 1)
End Sub

Public Sub Mix()
  Dim I As Integer
  Dim N As Integer
 
  Reset
 
  N = c_LastCard - m_iTopCard + 1
  For I = m_iTopCard To c_LastCard
    Swap I, Int(Rnd * N) + m_iTopCard
  Next
End Sub

Private Sub Swap(ByVal I As Integer, ByVal J As Integer)
  Dim Card As Brav
 
  Set Card = m_Brav(I)
  Set m_Brav(I) = m_Brav(J)
  Set m_Brav(J) = Card
End Sub
Módulo de clase CardNode.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CardNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private WithEvents m_Card As BravCard
Attribute m_Card.VB_VarHelpID = -1

Private m_X As Integer
Private m_Y As Integer

Private m_Neighbour(0 To 3) As CardNode
Private m_bChecked As Boolean

Private Sub Class_Initialize()
  Dim I As Integer
 
  Set m_Card = New BravCard
 
  For I = 0 To 3
    Set m_Neighbour(I) = Nothing
  Next
End Sub

Public Sub Dispose()
  Dim I As Integer
 
  For I = 0 To 3
    If Not m_Neighbour(I) Is Nothing Then
      With m_Neighbour(I)
        Set .Neighbour((I + 2) Mod 4) = Nothing
                                            ' Don't come back to Me!
        .Dispose
      End With
      Set m_Neighbour(I) = Nothing
    End If
  Next
 
  If Not m_Card Is Nothing Then
    m_Card.Dispose
    Set m_Card = Nothing
  End If
End Sub

Public Property Set Brav(ByRef B As Brav)
  Set m_Card.Brav = B
End Property

Public Property Get Card() As BravCard
  Set Card = m_Card
End Property

Public Property Set Card(ByRef C As BravCard)
  Set m_Card = C
End Property

Public Property Get Picture() As PictureBox
  Set Picture = m_Card.Picture
End Property

Public Property Set Picture(ByRef pic As PictureBox)
  Set m_Card.Picture = pic
End Property

Public Property Get Index() As Integer
  Index = m_Card.Index
End Property

Public Property Let Index(ByVal iIndex As Integer)
  m_Card.Index = iIndex
End Property

Public Property Get Checked() As Boolean
  Checked = m_bChecked
End Property

Public Property Let Checked(ByVal bChecked As Boolean)
  m_bChecked = bChecked
End Property

Private Sub CreateNeighbours()
  Dim I As Integer
  Dim bIsInside As Boolean
  Dim N As CardNode
 
  For I = 0 To 3              ' Look at 4 sides
    If m_Neighbour(I) Is Nothing Then  
                              ' If no neighbour yet on this side
      Select Case I           ' Check bounds
        Case eSideTop
          bIsInside = (m_Y > c_MinY)
        Case eSideRight
          bIsInside = (m_X < c_MaxX)
        Case eSideBottom
          bIsInside = (m_Y < c_MaxY)
        Case eSideLeft
          bIsInside = (m_X > c_MinX)
      End Select
     
      If bIsInside Then          ' If bounds are right
        Set N = FindNeighbour(I) ' Is there a neighbour's neighbour?
        If N Is Nothing Then     ' If not, create a new one
          Set N = New CardNode
          With N          ' Set the coords for the new node
            Select Case I ' depending on its relative position to Me
              Case eSideTop
                .X = m_X
                .Y = m_Y - 1
              Case eSideRight
                .X = m_X + 1
                .Y = m_Y
              Case eSideBottom
                .X = m_X
                .Y = m_Y + 1
              Case eSideLeft
                .X = m_X - 1
                .Y = m_Y
            End Select
          End With
        End If
       
        ' Link neighbour node to Me
        Set N.Neighbour((I + 2) Mod 4) = Me
        ' Link Me to the neighbour node
        Set m_Neighbour(I) = N      End If
    End If
  Next
End Sub

Public Property Get Neighbour(ByVal eSide As enumSide) As CardNode
  Set Neighbour = m_Neighbour(eSide)
End Property

Public Property Set Neighbour(ByVal eSide As enumSide, _
  ByRef N As CardNode)
  Set m_Neighbour(eSide) = N
End Property

Public Property Get IsEmpty() As Boolean
  IsEmpty = m_Card.IsEmpty
End Property

Public Function MatchCount(ByVal N As CardNode, _
  ByVal eSide As enumSide) As Byte
  MatchCount = m_Card.MatchCount(N.Card, eSide)
End Function

Public Sub Draw()
  m_Card.Draw
End Sub

Private Sub m_Card_Activate()
  CreateNeighbours
End Sub

Public Sub RotateRight()
  m_Card.RotateRight
End Sub

Public Sub RotateLeft()
  m_Card.RotateLeft
End Sub

Public Function FindNeighbour(ByVal eSide As enumSide) As CardNode
  Dim N As CardNode
 
  ' Try on left side
  Set N = m_Neighbour((eSide + c_RotLeft) Mod 4)
  If Not N Is Nothing Then Set N = _
    N.Neighbour(eSide)
  If Not N Is Nothing Then Set N = _
    N.Neighbour((eSide + c_RotRight) Mod 4)
 
  If N Is Nothing Then
  ' No neighbour found, so try on right side
    Set N = m_Neighbour((eSide + c_RotRight) Mod 4)
    If Not N Is Nothing Then Set N = _
      N.Neighbour(eSide)
    If Not N Is Nothing Then Set N = _
      N.Neighbour((eSide + c_RotLeft) Mod 4)
  End If
 
  Set FindNeighbour = N
End Function

Public Property Get X() As Integer
  X = m_X
End Property

Public Property Let X(ByVal iX As Integer)
  m_X = iX
End Property

Public Property Get Y() As Integer
  Y = m_Y
End Property

Public Property Let Y(ByVal iY As Integer)
  m_Y = iY
End Property