home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 25: Programming / pc_actual_25.iso / Basic / GridOne / setup.EXE / BOARD.CLS < prev    next >
Encoding:
Visual Basic class definition  |  2001-09-09  |  4.0 KB  |  167 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CBoard"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. '-----------------------------------------------------------------------------
  17. ' This is a part of the BeeGrid ActiveX control.
  18. ' Copyright ⌐ 2000 Stinga
  19. ' All rights reserved.
  20. '
  21. ' You have a right to use and distribute the BeeGrid sample files in original
  22. ' form or modified, provided that you agree that Stinga has no warranty,
  23. ' obligations, or liability for any sample application files.
  24. '-----------------------------------------------------------------------------
  25. Option Explicit
  26.  
  27. Private mariCards(51) As Integer
  28.  
  29. Public Board As Long
  30. Public Dealer As String
  31. Public Vulnerability As String
  32.  
  33. Public North As CBridgePlayer
  34. Public South As CBridgePlayer
  35. Public West As CBridgePlayer
  36. Public East As CBridgePlayer
  37.  
  38.  
  39.  
  40. Private Sub SetCards(iFirstCard As Integer, Player As CBridgePlayer)
  41.    Dim i%
  42.    Dim ariTmp(12) As Integer
  43.    
  44.    For i = 0 To 12
  45.       ariTmp(i) = mariCards(i + iFirstCard)
  46.    Next
  47.    
  48.    Call Sort(ariTmp())
  49.    
  50.    Set Player = New CBridgePlayer
  51.    
  52.    For i = 12 To 0 Step -1
  53.       Select Case ariTmp(i)
  54.          Case Is < 14      'clubs
  55.             Player.Clubs = Player.Clubs & CardSign(ariTmp(i))
  56.          Case 14 To 26     'diamonds
  57.             Player.Diamonds = Player.Diamonds & CardSign(ariTmp(i) - 13)
  58.          Case 27 To 39     'hearts
  59.             Player.Hearts = Player.Hearts & CardSign(ariTmp(i) - 26)
  60.          Case Else         'spades
  61.             Player.Spades = Player.Spades & CardSign(ariTmp(i) - 39)
  62.       End Select
  63.    Next
  64. End Sub
  65. Private Function CardSign(iValue As Integer) As String
  66.    
  67.    Select Case iValue
  68.       Case Is < 9
  69.          CardSign = Trim(iValue + 1)
  70.       Case 9: CardSign = "T"
  71.       Case 10: CardSign = "J"
  72.       Case 11: CardSign = "Q"
  73.       Case 12: CardSign = "K"
  74.       Case 13: CardSign = "A"
  75.    End Select
  76. End Function
  77.  
  78.  
  79.  
  80.  
  81.  
  82. Private Sub Sort(arVal() As Integer)
  83.    On Error GoTo SortErr
  84.  
  85.    Dim iRowMin As Integer, iRowNext As Integer, iRow As Integer, iFrom As Integer, iTo As Integer
  86.     
  87.    iFrom = LBound(arVal)
  88.    iTo = UBound(arVal)
  89.    
  90.    For iRow = iFrom To iTo
  91.       iRowMin = iRow
  92.       For iRowNext = iRow To iTo
  93.          If arVal(iRowNext) < arVal(iRowMin) Then iRowMin = iRowNext
  94.       Next
  95.  
  96.       If iRowMin > iRow Then Call Swap(arVal(iRow), arVal(iRowMin))
  97.    Next
  98.    Exit Sub
  99.  
  100. SortErr:
  101.    MsgBox Error
  102.    Exit Sub
  103. End Sub
  104.  
  105. Private Sub Shuffle(ai() As Integer)
  106.     Dim iFirst As Long, iLast As Long
  107.     
  108.     iFirst = LBound(ai): iLast = UBound(ai)
  109.     ' Randomize array
  110.     Dim i As Long, iRnd As Long
  111.     
  112.     For i = iLast To iFirst + 1 Step -1
  113.         ' Swap random element with last element
  114.         iRnd = CInt(Rnd * 51)
  115.         Swap ai(i), ai(iRnd)
  116.     Next
  117. End Sub
  118.  
  119. Public Sub Deal()
  120.    Dim i As Integer, j As Integer
  121.    Dim lTmpVul As Long, arVul As Variant
  122.    'set board info
  123.    Dealer = Choose((Board Mod 4) + 1, "N", "E", "S", "W")
  124.    arVul = Array("-", "N-S", "E-W", "All")
  125.    lTmpVul = ((Board Mod 4) + ((Board Mod 16) \ 4)) Mod 4
  126.    Vulnerability = arVul(lTmpVul)
  127.    Board = Board + 1
  128.    'shuffle cards
  129.    For i = 0 To 30
  130.       Shuffle mariCards
  131.    Next
  132.    
  133.    SetCards 0, North
  134.    SetCards 13, South
  135.    SetCards 26, West
  136.    SetCards 39, East
  137. End Sub
  138.  
  139.  
  140. Private Sub Swap(i1 As Integer, i2 As Integer)
  141.    Dim i As Integer
  142.  
  143.    i = i2
  144.    i2 = i1
  145.    i1 = i
  146. End Sub
  147.  
  148.  
  149. Private Sub Class_Initialize()
  150.    Dim i%
  151.    
  152.    For i = 0 To 51
  153.       mariCards(i) = i + 1
  154.    Next i
  155.  
  156. End Sub
  157.  
  158.  
  159. Private Sub Class_Terminate()
  160.    Set North = Nothing
  161.    Set South = Nothing
  162.    Set West = Nothing
  163.    Set East = Nothing
  164. End Sub
  165.  
  166.  
  167.