📄 frmmain.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "机房管理系统"
ClientHeight = 6330
ClientLeft = 45
ClientTop = 330
ClientWidth = 6165
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 422
ScaleMode = 3 'Pixel
ScaleWidth = 411
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdExit
Caption = "退 出"
Height = 390
Left = 4200
TabIndex = 16
Top = 5640
Width = 1710
End
Begin VB.Frame Frame1
Height = 2220
Left = 4035
TabIndex = 5
Top = 795
Width = 2055
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "学 号:"
Height = 255
Left = 102
TabIndex = 15
Top = 285
Width = 840
End
Begin VB.Label lblStudentID
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 240
Left = 930
TabIndex = 14
Top = 285
Width = 1035
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "计算机号:"
Height = 255
Left = 105
TabIndex = 13
Top = 630
Width = 825
End
Begin VB.Label lblComputerID
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 285
Left = 930
TabIndex = 12
Top = 630
Width = 855
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "开始时刻:"
Height = 255
Left = 94
TabIndex = 11
Top = 1020
Width = 840
End
Begin VB.Label lblStart
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 330
Left = 930
TabIndex = 10
Top = 1020
Width = 1005
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "结束时刻:"
Height = 255
Left = 98
TabIndex = 9
Top = 1485
Width = 840
End
Begin VB.Label lblEnd
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 405
Left = 930
TabIndex = 8
Top = 1485
Width = 1005
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "使用时间:"
Height = 300
Left = 105
TabIndex = 7
Top = 1890
Width = 855
End
Begin VB.Label lblTime
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
ForeColor = &H80000008&
Height = 240
Left = 930
TabIndex = 6
Top = 1890
Width = 1125
End
End
Begin VB.CommandButton Command2
Caption = "按计算机号查询"
Height = 390
Left = 4200
TabIndex = 4
Top = 5160
Width = 1710
End
Begin VB.CommandButton Command1
Caption = "按学生学号查询"
Height = 375
Left = 4185
TabIndex = 3
Top = 4680
Width = 1725
End
Begin VB.TextBox txtStudentID
Height = 345
Left = 4545
MaxLength = 10
TabIndex = 1
Top = 285
Width = 1320
End
Begin VB.PictureBox picRoom
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 6135
Left = 120
ScaleHeight = 405
ScaleMode = 3 'Pixel
ScaleWidth = 249
TabIndex = 0
Top = 105
Width = 3795
Begin VB.Image imgComputer
Height = 330
Index = 0
Left = 150
MouseIcon = "frmMain.frx":0442
MousePointer = 99 'Custom
Top = 150
Width = 330
End
End
Begin VB.Label Label1
Caption = "学号"
Height = 240
Left = 4080
TabIndex = 2
Top = 345
Width = 480
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Command1_Click()
frmQuery.mode = False '按学生学号查询
frmQuery.Show 1
End Sub
Private Sub Command2_Click()
frmQuery.mode = True '按计算机号查询
frmQuery.Show 1
End Sub
Private Sub Form_Load()
Dim i As Integer, j As Integer
Dim info1 As Info
If Dir(App.Path & "\now.dat") <> "" Then
intUsed = FileLen(App.Path & "\now.dat") \ Len(info1)
If intUsed >= 1 Then
ReDim status(0 To intUsed - 1)
Open App.Path & "\now.dat" For Random As 1 Len = Len(status(1))
For i = 0 To intUsed - 1
Get #1, i + 1, status(i)
IsUsed(status(i).ComputerID) = True
Next
Close
End If
End If
For i = 1 To 79
Load imgComputer(i) '加载新的控件数组元素
Next
For i = 0 To 79
If IsUsed(i) Then
imgComputer(i).Picture = LoadPicture(App.Path & "\on.bmp")
Else
imgComputer(i).Picture = LoadPicture(App.Path & "\off.bmp")
End If
imgComputer(i).Left = (i Mod 8) * 30 + 10
imgComputer(i).Top = (i \ 8) * 38 + 10
imgComputer(i).Visible = True
picRoom.CurrentX = (i Mod 8) * 30 + 15: picRoom.CurrentY = (i \ 8) * 38 + 32
picRoom.Print Format(i + 1, "00")
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer, j As Integer
If Dir(App.Path & "\now.dat") <> "" Then
Kill App.Path & "\now.dat"
End If
Open App.Path & "\now.dat" For Random As 1 Len = Len(status(1)) '退出时，将当前正在使用的计算机信息保存在文件中
For i = 0 To intUsed - 1
Put #1, i + 1, status(i)
Next
Close
End Sub
Private Sub imgComputer_Click(Index As Integer)
Dim i As Integer
If Not IsUsed(Index) Then
lblStudentID.Caption = "(未使用)"
lblComputerID.Caption = Format(Index + 1, "00")
lblStart.Caption = "(未使用)"
lblEnd.Caption = "(未使用)"
lblTime.Caption = "(未使用)"
Else
For i = 0 To intUsed - 1
If status(i).ComputerID = Index Then
lblStudentID.Caption = status(i).StudentID
lblComputerID.Caption = Format(status(i).ComputerID + 1, "00")
lblStart.Caption = status(i).Start
lblEnd.Caption = "(正在上机)"
lblTime.Caption = "(正在上机)"
Exit For
End If
Next
End If
End Sub
Private Sub picRoom_Click()
txtStudentID.SetFocus
End Sub
Private Sub txtStudentID_KeyPress(KeyAscii As Integer)
Dim i As Integer: Dim j As Integer
If KeyAscii = 13 Then
If Len(Trim(txtStudentID.Text)) <> 10 Then
MsgBox ("学号应该是10位。")
Else
For i = 0 To intUsed - 1
If Trim(txtStudentID.Text) = status(i).StudentID Then Exit For
Next
If i > intUsed - 1 Then '如果现在没使用,则为新来的上机者
frmChoice.Show 1
Else '离开者,结束上机，记录上机信息到历史记录文件中
imgComputer(status(i).ComputerID).Picture = LoadPicture(App.Path & "\off.bmp") '改为未使用时的图片
status(i).End = Now()
lblStudentID.Caption = status(i).StudentID
lblComputerID.Caption = Format(status(i).ComputerID + 1, "00")
lblStart.Caption = status(i).Start
lblEnd.Caption = status(i).End
lblTime.Caption = Format((status(i).End - status(i).Start) * 24, "0.00") & "小时"
If Dir(App.Path & "\his.dat") <> "" Then '记录下机者的信息入历史文件中
j = FileLen(App.Path & "\his.dat") / Len(status(i))
Else
j = 0
End If
Open App.Path & "\his.dat" For Random As 1 Len = Len(status(i))
Put #1, j + 1, status(i)
Close 1
IsUsed(i) = False
For j = i To intUsed - 2
status(j) = status(j + 1)
Next
intUsed = intUsed - 1
If intUsed > 0 Then
ReDim Preserve status(0 To intUsed - 1)
Else
Erase status
End If
End If
End If
txtStudentID = ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -