frmshuffle.frm

随机性发生器、冒泡分类和混洗一组12张牌的演示程序。 Demonstrates the use of a randomizer, bubble-sort and an array to "shuff

VERSION 5.00
Begin VB.Form frmShuffle 
   BackColor       =   &H0000C0C0&
   Caption         =   "Shuffle with Arrays"
   ClientHeight    =   4215
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4245
   Icon            =   "frmShuffle.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4215
   ScaleWidth      =   4245
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   120
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   17
      Text            =   "frmShuffle.frx":000C
      Top             =   3600
      Width           =   3975
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H0000C0C0&
      Caption         =   "Dealer Area"
      Height          =   975
      Left            =   1560
      TabIndex        =   14
      Top             =   2280
      Width           =   2535
      Begin VB.CommandButton cmdDeal 
         Caption         =   "Deal"
         Height          =   375
         Left            =   1080
         TabIndex        =   16
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label13 
         Height          =   375
         Left            =   240
         TabIndex        =   15
         Top             =   360
         Width           =   615
      End
   End
   Begin VB.CommandButton cmdShuffle 
      Caption         =   "Shuffle"
      Height          =   375
      Left            =   120
      TabIndex        =   13
      Top             =   2640
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H0000C0C0&
      Caption         =   "Array Window"
      Height          =   1935
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3975
      Begin VB.Label Label12 
         Height          =   375
         Left            =   3120
         TabIndex        =   12
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label11 
         Height          =   375
         Left            =   3120
         TabIndex        =   11
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label10 
         Height          =   375
         Left            =   3120
         TabIndex        =   10
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label9 
         Height          =   375
         Left            =   2160
         TabIndex        =   9
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label8 
         Height          =   375
         Left            =   2160
         TabIndex        =   8
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label7 
         Height          =   375
         Left            =   2160
         TabIndex        =   7
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label6 
         Height          =   375
         Left            =   1200
         TabIndex        =   6
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label5 
         Height          =   375
         Left            =   1200
         TabIndex        =   5
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label4 
         Height          =   375
         Left            =   1200
         TabIndex        =   4
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label3 
         Height          =   375
         Left            =   240
         TabIndex        =   3
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label2 
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label1 
         Height          =   375
         Left            =   240
         TabIndex        =   1
         Top             =   240
         Width           =   615
      End
   End
End
Attribute VB_Name = "frmShuffle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Shuffle - How to shuffle numbers 1-12 without having duplicates
'Copyright 1999 by r.d. pope - Released into the Public Domain
'r.d. pope is the TradeMark of Roy D. Pope, Jr.
'[e-mail]
'http://www.codearchive.com/home/roy/index.html
Dim Cards(11) As Integer 'Cards is an array of 12 numbers 0-11
Dim CardValue, X, Deal As Integer

Private Sub cmdDeal_Click()
If Deal = X Then
    Exit Sub
End If
Label13.Caption = Cards(Deal)
Deal = Deal + 1
End Sub

Private Sub cmdShuffle_Click()
ResetAll
X = 0
Erase Cards
'This is where the random shuffle is made.
'First, we initialize the randomizer.
Randomize
'Cardvalue is then set as a random number from 1 to 12,
CardValue = Int((12 * Rnd) + 1)
'and the value of the first element of the array is set.
Cards(0) = CardValue
'We must repeat the last three steps for the next 11 cards, using the
'IsInArray function to check for duplicates.
For X = 1 To 11
    Do While IsInArray = True
    'If IsInArray is true, we keep looping until a non-duplicate number
    'is generated by the randomizer.
        Randomize
        CardValue = Int((12 * Rnd) + 1)
        IsInArray
    Loop
Cards(X) = CardValue
Next X

'These assignments of label captions just displays the values of
'the card values as they are in random order within the array.
Label1.Caption = Cards(0)
Label2.Caption = Cards(1)
Label3.Caption = Cards(2)
Label4.Caption = Cards(3)
Label5.Caption = Cards(4)
Label6.Caption = Cards(5)
Label7.Caption = Cards(6)
Label8.Caption = Cards(7)
Label9.Caption = Cards(8)
Label10.Caption = Cards(9)
Label11.Caption = Cards(10)
Label12.Caption = Cards(11)

End Sub

Public Function IsInArray() As Boolean
'This function checks for duplicate numbers in the array.
Dim Y As Integer
For Y = 0 To X
    If CardValue = Cards(Y) Then
        IsInArray = True
        Exit Function
    End If
Next Y
IsInArray = False
End Function

Private Sub ResetAll()
'This sub just resets all captions to 0, to prepare for the next shuffle.
Deal = 0
Label1.Caption = 0
Label2.Caption = 0
Label3.Caption = 0
Label4.Caption = 0
Label5.Caption = 0
Label6.Caption = 0
Label7.Caption = 0
Label8.Caption = 0
Label9.Caption = 0
Label10.Caption = 0
Label11.Caption = 0
Label12.Caption = 0
End Sub


Private Sub Form_Load()
Deal = 0
'ADVERTISEMENT
Text1.Text = "Get this and other code, and shareware at http://www.codearchive.com/home/roy/index.html"
End Sub