frmmain.frm

针对银行排队

VERSION 5.00
Object = "{A964BDA3-3E93-11CF-9A0F-9E6261DACD1C}#3.0#0"; "resize32.ocx"
Begin VB.Form FrmMain 
   BorderStyle     =   0  'None
   ClientHeight    =   8610
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   11250
   BeginProperty Font 
      Name            =   "@宋体"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   ScaleHeight     =   8610
   ScaleWidth      =   11250
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VB.CommandButton CmdPrintHT 
      BackColor       =   &H00FF8080&
      Caption         =   "打印号条"
      BeginProperty Font 
         Name            =   "@华文隶书"
         Size            =   36
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1905
      Left            =   3840
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   3330
      Width           =   3555
   End
   Begin VB.Timer Timer1 
      Left            =   600
      Top             =   8160
   End
   Begin ResizeLibCtl.ReSize ReSize1 
      Left            =   0
      Top             =   8160
      _Version        =   196608
      _ExtentX        =   741
      _ExtentY        =   741
      _StockProps     =   64
      Enabled         =   -1  'True
      Enabled         =   -1  'True
      FormMinWidth    =   0
      FormMinHeight   =   0
      FormDesignHeight=   8610
      FormDesignWidth =   11250
   End
   Begin VB.Image ImgBottom 
      BorderStyle     =   1  'Fixed Single
      Height          =   8055
      Left            =   0
      Picture         =   "FrmMain.frx":0000
      Stretch         =   -1  'True
      Top             =   0
      Width           =   10695
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdPrintHT_Click()
    Dim strTemp As String
    
    '找出当前队列记录中的最大序号
    strTemp = GetMaxSerialNum()
    
    '将该条记录添加到当前队列
    gstrQueue = gstrQueue & "#" & strTemp & "#1#" & GetTimeMark()
    
    '重写队列文件
    RewriteQueueFile gstrQueue
    
    '打印号条
    If printHT(CLng(strTemp)) <> 0 Then
        MsgBox "产生打印故障，请联系工作人员", vbOKOnly, "故障报警"
    End If
    
End Sub

'打印号条
Public Function printHT(intS As Long) As Integer
    
End Function

'找出当前队列记录中的最大序号
Public Function GetMaxSerialNum() As String
    Dim strTmp As String
    Dim intTmp As Integer
    Dim intS As Long
    Dim strRecordTmp As String
    
    intTmp = GetRecordNum()
    If intTmp > 0 Then
        '取得最后一条记录
        strRecordTmp = GetQueueRecord(intTmp)
        strTmp = GetRecordStrSerialNum(strRecordTmp)
        intS = CLng(strTmp)
        If intS < 9 Then
            strTmp = "0000" & CStr(intS + 1)
        ElseIf 10 < intS < 99 Then
            strTmp = "000" & CStr(intS + 1)
        ElseIf 100 < intS < 999 Then
            strTmp = "00" & CStr(intS + 1)
        ElseIf 1000 < intS < 9999 Then
            strTmp = "0" & CStr(intS + 1)
        ElseIf 10000 < intS < 99999 Then
            strTmp = CStr(intS + 1)
        ElseIf CStr(intS) = "9" Then
            strTmp = "00010"
        ElseIf CStr(intS) = "99" Then
            strTmp = "00100"
        ElseIf CStr(intS) = "999" Then
            strTmp = "01000"
        ElseIf CStr(intS) = "9999" Then
            strTmp = "10000"
        End If
    Else
        strTmp = "00001"
    End If
    
    GetMaxSerialNum = strTmp
End Function


Private Sub Form_Load()
    
    Dim i As Integer
    
    Timer1.Enabled = False
    
    '设置程序界面
    SetInterface
    
    
    '取初始运行参数
    GetIniParameter
    
    '初始将所有护士工作站设为闲
    ReDim gNurseStatus(gNurseNum) As Integer
    For i = 1 To gNurseNum
        gNurseStatus(i) = 0
    Next
    
    '读取队列文件，如不为空，说明是断电重启，则重新叫号，如文件不存在，则创建空文件，如存在空文件，不做任何处理
    gQueueFileName = Mid(App.Path & QueueFile, 1, Len(App.Path & QueueFile) - 4) & NeatenDate() & ".dat"
    
    '启动定时器
    Timer1.Interval = gintTimerInterval
    Timer1.Enabled = True
    
    '进入处理
    InitFile
End Sub

Private Sub Timer1_Timer()
    Dim i As Integer
    Dim j As Integer
    Dim intTmp As Integer
    Dim strRecordTmp As String
    
    '删除排队记录中超时的记录
    gstrQueue = DeleteTimeoutRecord()
    
    '查找是否有空闲的护士台且排队队列中是否有待叫记录，如有则呼叫
    
    intTmp = GetRecordNum()
    If intTmp > 0 Then
        For i = 1 To gNurseNum
            If gNurseStatus(i) = 0 Then
                '如果该护士台状态为空闲
                '查找第一个可叫的记录，并叫号
                For j = 1 To intTmp
                    strRecordTmp = GetQueueRecord(j)
                    If GetRecordStatus(strRecordTmp) = 1 Then
                        '当前记录未叫号，则叫号
                        SpeakRecord j, i
                        
                        '改写时间戳
                        strRecordTmp = WriteTimeMark(strRecordTmp)
                        '改写该条记录的状态
                        strRecordTmp = Mid(strRecordTmp, 1, 1 + intSerialNumLen + 1) & _
                                       "2" & _
                                       Mid(strRecordTmp, 1 + intSerialNumLen + 1 + intStatusLen + 1)
                        
                        '将记录了时间戳和状态的记录写回队列字符串
                        gstrQueue = RewriteQueue(gstrQueue, strRecordTmp, j)
                        
                        '重写队列文件
                        RewriteQueueFile gstrQueue
                        
                        Exit Sub
                    End If
                Next j
            End If
        Next i
    End If
End Sub