📄 frmks.frm
字号:
Width = 435
End
Begin VB.Label lblLine
Alignment = 2 'Center
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Caption = "二线"
Height = 240
Index = 1
Left = 728
TabIndex = 20
Top = 120
Width = 435
End
End
Begin VB.Image Image照片
Height = 255
Left = -71400
Picture = "frmks.frx":35C0
Stretch = -1 'True
Top = 0
Visible = 0 'False
Width = 315
End
End
Begin VB.Label lblPrompt
BackStyle = 0 'Transparent
Caption = "按“开始”键，开始桩考····"
BeginProperty Font
Name = "楷体_GB2312"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 360
TabIndex = 59
Top = 0
Width = 7995
End
Begin VB.Label lblTime
Alignment = 2 'Center
BackColor = &H00FF80FF&
BackStyle = 0 'Transparent
BeginProperty Font
Name = "Times New Roman"
Size = 15
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 8760
TabIndex = 3
Top = 0
Width = 1635
End
End
Begin VB.PictureBox PicTop
BackColor = &H00808080&
BorderStyle = 0 'None
Height = 450
Left = 0
ScaleHeight = 30
ScaleMode = 3 'Pixel
ScaleWidth = 716
TabIndex = 1
TabStop = 0 'False
Top = 0
Width = 10740
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "桩考考试"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 210
Left = 480
TabIndex = 2
Top = 120
Width = 900
End
Begin VB.Image imgIcon
Height = 240
Left = 0
Picture = "frmks.frx":38CA
Top = 120
Width = 240
End
End
Begin MSCommLib.MSComm ledcom
Left = 7320
Top = -120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin vbpPreview.Preview pre
Left = 9120
Top = 0
_ExtentX = 741
_ExtentY = 741
Caption = "打印预览"
End
Begin MCI.MMControl MMControl1
Height = 330
Left = 4080
TabIndex = 0
Top = 6600
Visible = 0 'False
Width = 4140
_ExtentX = 7303
_ExtentY = 582
_Version = 393216
Enabled = 0 'False
DeviceType = ""
FileName = ""
End
Begin MSCommLib.MSComm com1
Left = 8520
Top = -120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
End
Begin MSCommLib.MSComm MSComm2
Left = 7920
Top = -120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 3
DTREnable = -1 'True
End
End
Attribute VB_Name = "frmks"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim carStatus(3) As String
Dim NoPoleOrLine As Integer
Dim NoLineCar As Integer
Dim nowcarline As Integer
Dim NumberCarStop(0 To 1) As Integer
Dim Car档过5线 As Boolean
Dim Flag_TC As Integer
Dim NoStep As Integer, NoStepMax(0 To nCarLine) As Integer
Dim nline(0 To 5) As Integer, NPole(0 To 5) As Integer
Dim ksCS As String
Dim numLine As Integer
Dim line5time As Integer
Function zkpd() As Integer
If lblsfzh = "" Or lblkszh.Caption = "" Or lblcx.Caption = "" Then
MsgBox "请输入完整的考生信息后再进入考试", vbOKOnly, "提示"
zkpd = 0
Else
If lblyc = "合格" Or lblec = "合格" Then
zkpd = 0
MsgBox "该考生成绩已经考试合格，无需再考", vbOKOnly, "提示"
Exit Function
End If
Set Res = New ADODB.Recordset
Sstr = "select * from person where sfzh='" & lblsfzh & "' and kszh='" & lblkszh & "'"
Res.Open Sstr, Conn
If Res.EOF = True And Res.BOF = True Then
MsgBox "数据库中没有输入该考生信息，请先添加考生信息", vbOKCancel, "提示"
zkpd = 0
Else
Set Res = New ADODB.Recordset
Sstr = "select kscj1,kscj2,ksdate1,ksdate2,kscs,ksjg from kscj where sfzh='" & lblsfzh & "' and kszh='" & lblkszh & "' order by val(kscs) desc"
Res.Open Sstr, Conn
If Res.EOF And Res.BOF Then
lblyc.Caption = ""
lblec.Caption = ""
zkpd = 1
ksCS = 1
Else
Res.MoveFirst
lblyc.Caption = IIf(IsNull(Res!kscj1), "", Res!kscj1)
lblec.Caption = IIf(IsNull(Res!kscj2), "", Res!kscj2)
If lblec = "" Then
ksCS = Res!ksCS
zkpd = 1
Else
a = CDate(Res!ksdate1) + 20
If Format(Date, "yyyy-mm-dd") > Format(CDate(Res!ksdate1) + 20, "yyyy-mm-dd") Or Format(Date, "yyyy-mm-dd") > Format(CDate(Res!ksdate2) + 20, "yyyy-mm-dd") Then
lblyc.Caption = ""
lblec.Caption = ""
zkpd = 1
ksCS = Res!ksCS + 1
Else
MsgBox "该考生距上次考试时间不足20天，不能继续考试", vbOKOnly, "提示"
zkpd = 0
End If
End If
End If
End If
End If
End Function
Private Sub cmdprint_Click()
Dim numPL As String
If NoLineCar = 200 Then
numPL = "P" & str(NoPoleOrLine)
ElseIf NoLineCar = 300 Then
numPL = "L" & str(NoPoleOrLine)
Else
numPL = "F"
End If
Call Kscjlxb(pre, numLine, numPL)
End Sub
Private Sub cmdStart_Click()
gjline.Visible = False
zttime = 0 '中停时间清0
Dim Answer As String
For i = 0 To 19
LineCar(i).BorderStyle = 1
LineCar(i).Visible = False
Next i
Time开始桩考 = Timer
If cmdStart.Caption = "开始桩考" Then
Call kcjc
For i = 0 To 5
If lblLine(i).BackColor = vbRed Or lblPole(i).BackColor = vbRed Then
MsgBox "请检查场地信号", 48, "提示"
Exit Sub
End If
Next i
Timer2.Interval = 0
If zkpd <> 1 Then Exit Sub
Call quanli1
txtLEDInfo.Text = ""
Call sendLed("开始考试", 15)
Call SoundSend("WavStarta1.WAV") '
For i = 0 To nCarLine
NoStepMax(i) = 1000 / 200 * 快慢调节
Next i
SSTab1.Tab = 0
lblPrompt.Caption = "开始桩考，等待考车倒退信号..."
cmdStart.Caption = "停止桩考": InformationOk = False: F未报中停 = True
For i = 0 To 3: carStatus(i) = "开始": Next i
nowcarline = -1: NumberCarStop(0) = 0: NumberCarStop(1) = 0: NoPoleOrLine = 0
ImageCar.Move LineCar(0).X1 - ImageCar.Width / 2, LineCar(0).Y1 - ImageCar.Height / 2
Ico文件名(0) = App.Path & "\audio\l.ico": Ico文件名(1) = App.Path & "\audio\l.ico"
ImageCar.Picture = LoadPicture(Ico文件名(0))
Line犯规.Visible = False
TimerCar.Interval = 50
Else
Answer = MsgBox("是否放弃本次桩考？", vbOKCancel)
If Answer = vbOK Then
Call quanli2
Timer2.Interval = 100
Call sendLed("停止考试", 15)
' lblPrompt.Caption = "按“开始”键，开始桩考...": Beep
cmdStart.Caption = "开始桩考"
SSTab1.Tab = 0
For i = 0 To 3: carStatus(i) = "开始": Next i
nowcarline = -1: NumberCarStop(0) = 0: NumberCarStop(1) = 0
' ImageCar.Move LineCar(0).X1 - ImageCar.Width / 2, LineCar(0).Y1 - ImageCar.Height / 2
' For i = 0 To LineCar.Count - 1 '清显示行车路线
' LineCar(i).Visible = False
' LineCar(i).BorderStyle = vbSolid
' Next i
' Line犯规.Visible = False
' Else
' NoLineCar = 700
End If
End If
End Sub
Private Sub cmd查询_Click()
Frmzkload = True
Frmxxcx.Show 1
End Sub
Private Sub com1_OnComm()
GetData = com1.Input
End Sub
Private Sub ComZenj_Click()
Frmzkload = True
Frmzkadd = True
Frmxxlr.Show 1
End Sub
Private Sub Form_Activate()
lblTime.Caption = VBA.Time
Dim nFileHandle, DataLine As String
Dim FileName As String
If Frmzkload = True Then
Call tc_ksdl
Exit Sub
End If
MMControl1.Notify = False
MMControl1.Wait = False
MMControl1.Shareable = False
MMControl1.DeviceType = "WaveAudio"
TimeDelay (100)
Call SoundSend("WavWelcome.wav")
'----------------------------------- 考车状态
With MSComm2
If .PortOpen Then
.PortOpen = False
End If
.RThreshold = 3
.InputLen = 0
.InBufferSize = 8096
.InputMode = comInputModeBinary
.OutBufferSize = 1024
.Settings = "9600,N,8,1"
.CommPort = 1
.PortOpen = True
End With
'---------------------------------------I/O卡
hp⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -