form1.frm

vb实现银行事件模拟

      Alignment       =   2  'Center
      BackColor       =   &H8000000B&
      BorderStyle     =   1  'Fixed Single
      DragMode        =   1  'Automatic
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   22
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim StartTime As Date
Dim TotalPersonNum As Integer
Dim Queue(3) As Queue '定义三个队列和三个队列各自的人数
Dim Events() As Events

Private Sub Command1_Click()
 Dim StartPersonNum As Integer, Hour As Integer, Min As Integer, Second As Integer, i As Integer
    Command1.Caption = "刷新"
    Frame2.Visible = False
    '初始化队列人数
    For i = 0 To 2
        ReDim Queue(i).Person(1)
        Queue(i).QueueLength = 0
    Next i
    '初始化事件表
    ReDim Events(1)
    TotalPersonNum = 1
    '随机产生初始时间，范围8-12点
    Hour = Int(Rnd * (11 - 8 + 1)) + 8
    Min = Int(Rnd * 60) + 1
    Randomize
    Second = Int(Rnd * 60) + 1
    StartTime = TimeSerial(Hour, Min, Second)
    Label5.Caption = StartTime
    Timer1.Enabled = True
    '随机产生初始人数
    StartPersonNum = Int(Rnd * (7 + 1)) + 3
    AddPerson (StartPersonNum)
    
    
    End Sub
    
Private Sub Command2_Click()
Unload Form1
End Sub

Private Sub Timer1_Timer()
    Dim i, m, s, j As Integer
   StartTime = DateAdd("s", 1, StartTime)
    Label5.Caption = StartTime
    '到达12点终止程序
    If Hour(StartTime) > 11 Then
    Timer1.Enabled = False
    Frame2.Visible = True
    End If
    '给每个队列中的第一个客户的剩余时间减1秒，如减为零则从队列中删除该客户
    For i = 0 To 2
            m = Minute(Queue(i).Person(0).LeftTime)
            s = Second(Queue(i).Person(0).LeftTime)
            If m = 0 And s = 1 Then
                For j = 0 To UBound(Queue(i).Person) - 2
                    Queue(i).Person(j).LeftTime = Queue(i).Person(j + 1).LeftTime
                    Queue(i).Person(j).MoneyType = Queue(i).Person(j + 1).MoneyType
                    Queue(i).Person(j).PersonSN = Queue(i).Person(j + 1).PersonSN
                Next j
                If UBound(Queue(i).Person) >= 1 Then
                    ReDim Preserve Queue(i).Person(UBound(Queue(i).Person) - 1)
                    Queue(i).QueueLength = Queue(i).QueueLength - 1
                Else
                  '如队列为空，则在该队列的窗口中显示空闲
                    LabelType(i).Caption = "空闲"
                    LabelTime(i).Caption = "0:00:00"
                End If
                RefreshQueue
            Else
                Queue(i).Person(0).LeftTime = DateAdd("s", -1, Queue(i).Person(0).LeftTime)
            End If
    Next i
    '产生下一个将到客户信息
    NewPerson
    '处理消息队列中的第一个将到客户信息，如剩余时间为零则选择一个当前人数最少的队列插入
    m = Minute(Events(0).ComeTime)
    s = Second(Events(0).ComeTime)
    If m = 0 And s = 1 Then
        If Queue(0).QueueLength < Queue(1).QueueLength Then
            If Queue(0).QueueLength < Queue(2).QueueLength Then
                With Queue(0).Person(Queue(0).QueueLength)
                    .PersonSN = TotalPersonNum
                    .LeftTime = Events(0).LeftTime
                    .MoneyType = Events(0).MoneyType
                End With
                Queue(0).QueueLength = Queue(0).QueueLength + 1
                ReDim Preserve Queue(0).Person(Queue(0).QueueLength)
            Else
                With Queue(2).Person(Queue(2).QueueLength)
                    .PersonSN = TotalPersonNum
                    .LeftTime = Events(0).LeftTime
                    .MoneyType = Events(0).MoneyType
                End With
                Queue(2).QueueLength = Queue(2).QueueLength + 1
                ReDim Preserve Queue(2).Person(Queue(2).QueueLength)
            End If
        Else
            With Queue(1).Person(Queue(1).QueueLength)
                .PersonSN = TotalPersonNum
                .LeftTime = Events(0).LeftTime
                .MoneyType = Events(0).MoneyType
            End With
            Queue(1).QueueLength = Queue(1).QueueLength + 1
            ReDim Preserve Queue(1).Person(Queue(1).QueueLength)
        End If
        TotalPersonNum = TotalPersonNum + 1
        For j = 0 To UBound(Events) - 2
            Events(j).ComeTime = Events(j + 1).ComeTime
            Events(j).LeftTime = Events(j + 1).LeftTime
            Events(j).MoneyType = Events(j + 1).MoneyType
        Next j
        If UBound(Events) > 0 Then
            ReDim Preserve Events(UBound(Events) - 1)
        End If
    Else
        Events(0).ComeTime = DateAdd("s", -1, Events(0).ComeTime)
    End If
    RefreshQueue
End Sub


Public Function AddPerson(ByVal PersonNum As Integer)
    '添加新的客户，PersonNum指定需要添加的人数，LeftTime表示剩余时间
    'MoneyType表示客户的业务类型，1表示存款，2表示取款
    Dim MoneyType As Integer, LeftTime As Date, PersonSN As Integer, i As Integer, Min As Integer, Second As Integer
    For i = 1 To PersonNum
        '随机生成业务类型
        Randomize
        MoneyType = Int(Rnd * 2) + 1
        '随机生成办理业务所需时间
        Min = Int(Rnd * (4 - 3 + 1)) + 1
        Second = Int(Rnd * 60) + 1
        LeftTime = TimeSerial(0, Min, Second)
        '选择队列人数较少的插入
        If Queue(0).QueueLength < Queue(1).QueueLength Then
            If Queue(0).QueueLength < Queue(2).QueueLength Then
                With Queue(0).Person(Queue(0).QueueLength)
                    .PersonSN = TotalPersonNum
                    .LeftTime = LeftTime
                    .MoneyType = MoneyType
                End With
                Queue(0).QueueLength = Queue(0).QueueLength + 1
                ReDim Preserve Queue(0).Person(Queue(0).QueueLength)
            Else
                With Queue(2).Person(Queue(2).QueueLength)
                    .PersonSN = TotalPersonNum
                    .LeftTime = LeftTime
                    .MoneyType = MoneyType
                End With
                Queue(2).QueueLength = Queue(2).QueueLength + 1
                ReDim Preserve Queue(2).Person(Queue(2).QueueLength)
            End If
        Else
                With Queue(1).Person(Queue(1).QueueLength)
                    .PersonSN = TotalPersonNum
                    .LeftTime = LeftTime
                    .MoneyType = MoneyType
                End With
                Queue(1).QueueLength = Queue(1).QueueLength + 1
                ReDim Preserve Queue(1).Person(Queue(1).QueueLength)
        End If
        TotalPersonNum = TotalPersonNum + 1
    Next i
    RefreshQueue
End Function

Public Function RefreshQueue()
    '刷新队列
    Dim i As Integer
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    For i = 0 To UBound(Queue(0).Person) - 1
        Text1.Text = Text1.Text & "[" & Queue(0).Person(i).PersonSN & "]"
    Next i
    
    For i = 0 To UBound(Queue(1).Person) - 1
        Text2.Text = Text2.Text & "[" & Queue(1).Person(i).PersonSN & "]"
    Next i
    
    For i = 0 To UBound(Queue(2).Person) - 1
        Text3.Text = Text3.Text & "[" & Queue(2).Person(i).PersonSN & "]"
    Next i
    '刷新业务类型
    For i = 0 To 2
        If UBound(Queue(i).Person) > 0 Then
        LabelType(i) = Replace(Replace(Queue(i).Person(0).MoneyType, "1", "存款"), "2", "取款")
        LabelTime(i) = Queue(i).Person(0).LeftTime
        End If
    Next i
End Function
Public Sub NewPerson()
    Dim MoneyType As Integer, LeftTime As Date, ComeTime As Date, i As Integer, Min As Integer, Second As Integer
    '随机生成业务类型
    Randomize
    MoneyType = Int(Rnd * 2) + 1
    '随机生成办理业务所需时间，范围3-5分钟
    Min = Int(Rnd * (4 - 3 + 1)) + 1
    Second = Int(Rnd * 60) + 1
    LeftTime = TimeSerial(0, Min, Second)
    '随机生成将到时间，范围0-1分钟
    Min = 0
    Second = Int(Rnd * 60) + 1
    ComeTime = TimeSerial(0, Min, Second)
    '将信息插入事件表
    With Events(UBound(Events) - 1)
        .ComeTime = ComeTime
        .LeftTime = LeftTime
        .MoneyType = MoneyType
    End With
    ReDim Preserve Events(UBound(Events) + 1)
End Sub