📄 form4.frm
字号:
EndProperty
Height = 240
Index = 4
Left = 150
TabIndex = 14
Top = 2400
Width = 2670
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "ID 卡 号:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 150
TabIndex = 13
Top = 120
Width = 1185
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "教 练 员:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 150
TabIndex = 12
Top = 690
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "车 牌 号:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 2
Left = 150
TabIndex = 11
Top = 1260
Width = 1170
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "级 别:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 3
Left = 150
TabIndex = 10
Top = 1830
Width = 1185
End
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1
Height = 5835
Left = 30
TabIndex = 28
Top = 1080
Width = 8235
_ExtentX = 14526
_ExtentY = 10292
_Version = 393216
BackColor = -2147483633
ForeColor = 0
ForeColorFixed = 0
ForeColorSel = 255
GridColorFixed = 255
GridColorUnpopulated= 255
AllowUserResizing= 1
Appearance = 0
RowSizingMode = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "当前记录 0 条 "
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 600
TabIndex = 29
Top = 6960
Width = 7065
End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rs As New ADODB.Recordset
Dim Sql As String
Private Sub Command1_Click()
' On Error Resume Next
Dim Rrs As New ADODB.Recordset
Rrs.CursorLocation = adUseClient
Rrs.Open "select * from idyh where kh='" & Text1(0).Text & "'", Cn, 1, 3
If Not Rrs.EOF Then
MsgBox Text1(0).Text & " 已经存在", 0 + vbCritical, "系统提示"
Rrs.Close
Else
Rrs.AddNew
Rrs("kh") = Trim(Text1(0).Text)
Rrs("xm") = Trim(Text1(1).Text)
Rrs("CPH") = Trim(Text1(2).Text)
Rrs("jb") = Trim(Combo1.Text)
Rrs("ye") = Trim(Text1(3).Text)
Rrs("zt") = Check1.Value
Rrs("jx") = "特殊"
Rrs("zh") = "99999999"
Rrs("sj") = format(Date, "yyyy-mm-dd")
Rrs.Update
Rrs.Close
Command4_Click
End If
End Sub
Private Sub Command2_Click()
Picture1.Visible = False
End Sub
Private Sub Command3_Click()
Rs.CursorLocation = adUseClient
Rs.Open "select * from idyh where kh='" & Text1(0).Text & "'", Cn, 1, 3
Rs("xm") = Trim(Text1(1).Text)
Rs("CPH") = Trim(Text1(2).Text)
Rs("jb") = Trim(Combo1.Text)
Rs("ye") = Trim(Text1(3).Text)
Rs("zt") = Check1.Value
Rs.Update
Rs.Close
Command4_Click
End Sub
Private Sub Command4_Click()
Dim i As Integer, j As Integer
Sql = ""
ProgressBar1.Value = 0
ProgressBar1.Visible = True
For i = 0 To 2
If Check2(i).Value Then Sql = Sql & " and " & Check2(i).Tag & "='" & Trim(Text2(i).Text) & "'"
Next i
If Check2(3).Value Then Sql = Sql & " and " & Check2(i).Tag & "='" & Trim(Combo2.Text) & "'"
If Sql <> "" Then Sql = " where " & Mid(Sql, 5)
Rs.CursorLocation = adUseClient
Rs.Open "select * from idyh" & Sql, Cn, 1, 3
If Not Rs.EOF Then
Msh (Rs.RecordCount + 1)
ProgressBar1.Max = Rs.RecordCount + 1
Label2.Caption = "当前记录 " & Rs.RecordCount & " 条"
Else
Msh (Rs.RecordCount + 1)
Label2.Caption = "当前记录 0 条"
End If
i = 0
Do While Not Rs.EOF
i = i + 1
ProgressBar1.Value = ProgressBar1.Value + 1
MSHFlexGrid1.Row = i
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Text = Rs("kh")
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = Rs("xm")
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = Rs("cph")
MSHFlexGrid1.Col = 3
MSHFlexGrid1.Text = Rs("jb")
MSHFlexGrid1.Col = 4
MSHFlexGrid1.Text = Rs("ye")
MSHFlexGrid1.Col = 5
MSHFlexGrid1.Text = Rs("zt")
For j = 6 To 15
MSHFlexGrid1.Col = j
MSHFlexGrid1.Text = Rs("xy" & j - 5) & ""
Next
Rs.MoveNext
Loop
Rs.Close
MSHFlexGrid1.Refresh
ProgressBar1.Visible = False
End Sub
Private Sub Command5_Click()
Dim Tj As String
Tj = "delete from idyh" & Sql
If MsgBox("确实删除", 1 + 32, "系统提示") = vbOK Then
Cn.Execute "INSERT RZ VALUES('" & Replace(Tj, "'", "") & "','" & Yh & "','" & format(Date, "YYYY-MM-DD") & " " & format(Time, "hh:nn:ss") & "')"
Cn.Execute "delete from idyh" & Sql
Command4_Click
End If
End Sub
Private Sub Command6_Click()
Dim i As Integer
Command1.Visible = True
Command3.Visible = False
For i = 0 To 3
Text1(i).Text = ""
Next i
Picture1.Visible = True
End Sub
Private Sub Command7_Click()
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
Err.Clear
Me.Left = (MDIForm1.Width - Me.Width) / 2
Me.Top = (MDIForm1.Height - Me.Height) / 2 - 1000
Me.Show
MSComm1.CommPort = Yj(5) '串口号，
MSComm1.Settings = "9600,N,8,1" '串口的属性
MSComm1.InputLen = 0 '接收缓冲区的大小
MSComm1.InputMode = comInputModeBinary '二进制接受方式
MSComm1.RThreshold = 7 '每7个字节响应消息
MSComm1.PortOpen = True '打开通信串口
If Err.Number Then
MsgBox "对不起，COM口正在使用，请关闭已打开的界面", 0 + vbExclamation, "系统提示"
Unload Me
Exit Sub
End If
Rs.CursorLocation = adUseClient
Rs.Open "select jb from jb", Cn, 1, 3
Do While Not Rs.EOF
Combo1.AddItem Rs(0)
Combo2.AddItem Rs(0)
Rs.MoveNext
Loop
Rs.Close
Combo1.Text = Combo1.List(0)
Msh (2)
End Sub
Public Sub Msh(i As Integer)
Dim j As Integer
MSHFlexGrid1.Cols = 16
MSHFlexGrid1.Rows = i
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Text = "ID 卡 号"
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = "教 练 员"
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = "车牌号"
MSHFlexGrid1.Col = 3
MSHFlexGrid1.Text = "级 别"
MSHFlexGrid1.Col = 4
MSHFlexGrid1.Text = "余 时"
MSHFlexGrid1.Col = 5
MSHFlexGrid1.Text = "状 态"
For j = 6 To 15
MSHFlexGrid1.Col = j
MSHFlexGrid1.Text = "学 员"
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MSComm1.PortOpen = False
End Sub
Private Sub MSComm1_OnComm()
Dim Buffer As Variant '存储数据的缓冲区
Dim CardNumber As Long '卡号
Select Case MSComm1.CommEvent '串口事件
Case comEvReceive '接收到数据
Buffer = MSComm1.Input '清理接收缓冲区，此时，接收的字节数已经为0
CardNumber = CDec(Buffer(4)) * 2 ^ 16 + (Buffer(5) * 2 ^ 8) + Buffer(6) '单个字节数据左移
If Command3.Visible = False Then Text1(0).Text = CardNumber
Text2(0).Text = CardNumber
End Select
End Sub
Private Sub MSHFlexGrid1_DblClick()
If MSHFlexGrid1.Row < 1 Or Picture1.Visible Then Exit Sub
Command3.Visible = True
Command1.Visible = False
Picture1.Visible = True
MSHFlexGrid1.Col = 0
Text1(0).Text = MSHFlexGrid1.Text
MSHFlexGrid1.Col = 1
Text1(1).Text = MSHFlexGrid1.Text
MSHFlexGrid1.Col = 2
Text1(2).Text = MSHFlexGrid1.Text
MSHFlexGrid1.Col = 3
Combo1.Text = MSHFlexGrid1.Text
MSHFlexGrid1.Col = 4
Text1(3).Text = MSHFlexGrid1.Text
MSHFlexGrid1.Col = 5
Check1.Value = MSHFlexGrid1.Text
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -