frmaccident.frm
来自「车辆管理系统是一个协助各单位进行全面的车辆管理的系统。包括车辆档案管理；驾驶员档」· FRM 代码 · 共 417 行
FRM
417 行
VERSION 5.00
Begin VB.Form frmaccident
BorderStyle = 1 'Fixed Single
Caption = "事故信息"
ClientHeight = 6525
ClientLeft = 3465
ClientTop = 1650
ClientWidth = 8415
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 6525
ScaleWidth = 8415
Begin VB.CommandButton cmdcancel
Caption = "取 消"
Height = 375
Left = 6000
TabIndex = 23
Top = 6000
Width = 1335
End
Begin VB.CommandButton cmdok
Caption = "确 定"
Height = 375
Left = 4080
TabIndex = 22
Top = 6000
Width = 1455
End
Begin VB.Frame Frame3
Caption = "备注信息"
Height = 1215
Left = 120
TabIndex = 20
Top = 4560
Width = 8175
Begin VB.TextBox txtitem
Height = 855
Index = 7
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 21
Top = 240
Width = 7695
End
End
Begin VB.Frame Frame2
Caption = "其他信息"
Height = 4215
Left = 4200
TabIndex = 1
Top = 240
Width = 4095
Begin VB.TextBox txtitem
Height = 375
Index = 6
Left = 1320
TabIndex = 19
Top = 3600
Width = 2415
End
Begin VB.TextBox txtitem
Height = 1215
Index = 5
Left = 1320
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 18
Top = 2160
Width = 2415
End
Begin VB.TextBox txtitem
Height = 855
Index = 3
Left = 1320
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 17
Top = 960
Width = 2415
End
Begin VB.TextBox txtitem
Height = 375
Index = 4
Left = 1320
TabIndex = 16
Top = 360
Width = 2415
End
Begin VB.Label Label9
Caption = "处理金额："
Height = 375
Left = 240
TabIndex = 15
Top = 3600
Width = 975
End
Begin VB.Label Label8
Caption = "处理意见："
Height = 375
Left = 240
TabIndex = 14
Top = 2160
Width = 1095
End
Begin VB.Label Label7
Caption = "对方单位："
Height = 375
Left = 240
TabIndex = 13
Top = 960
Width = 1095
End
Begin VB.Label Label6
Caption = "对方牌照："
Height = 375
Left = 240
TabIndex = 12
Top = 360
Width = 975
End
End
Begin VB.Frame Frame1
Caption = "事故车辆信息"
Height = 4215
Left = 120
TabIndex = 0
Top = 240
Width = 3975
Begin VB.TextBox txtitem
Height = 975
Index = 2
Left = 1200
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 11
Top = 3000
Width = 2295
End
Begin VB.TextBox txtitem
Height = 855
Index = 1
Left = 1200
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 10
Top = 1920
Width = 2295
End
Begin VB.TextBox txtitem
Height = 375
Index = 0
Left = 1200
TabIndex = 9
Top = 1200
Width = 2295
End
Begin VB.ComboBox cboitem
Height = 300
Index = 1
Left = 1200
TabIndex = 8
Top = 840
Width = 2295
End
Begin VB.ComboBox cboitem
Height = 300
Index = 0
Left = 1200
TabIndex = 7
Top = 360
Width = 2295
End
Begin VB.Label Label5
Caption = "事故原因："
Height = 375
Left = 120
TabIndex = 6
Top = 3000
Width = 975
End
Begin VB.Label Label4
Caption = "事故地点："
Height = 375
Left = 120
TabIndex = 5
Top = 1920
Width = 1095
End
Begin VB.Label Label3
Caption = "事故时间："
Height = 375
Left = 120
TabIndex = 4
Top = 1320
Width = 1095
End
Begin VB.Label Label2
Caption = "司机："
Height = 255
Left = 360
TabIndex = 3
Top = 840
Width = 735
End
Begin VB.Label Label1
Caption = "牌照："
Height = 255
Left = 360
TabIndex = 2
Top = 360
Width = 735
End
End
End
Attribute VB_Name = "frmaccident"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim txtchange As Boolean
Dim mrc As ADODB.Recordset
Public txtsql As String
Private Sub cboitem_Change(Index As Integer)
txtchange = True
End Sub
Private Sub cmdcancel_Click()
If gintaMode = 2 Then
If txtchange And CmdOK.Enabled Then
If MsgBox("数据已经修改，是否保存？", vbOKCancel + vbExclamation, "警告") = vbOK Then
Call cmdok_Click
End If
End If
End If
Unload Me
End Sub
Private Sub cmdok_Click()
Dim txtcount As Integer
Dim tmsg As String
Dim msgtext As String
If cboitem(0).Text = "" Then
MsgBox "车辆牌照不能为空，请选择车辆牌照", vbOKOnly + vbExclamation, "警告"
cboitem(0).SetFocus
Exit Sub
End If
'For txtcount = 0 To 1
If Trim(txtitem(0) & "") = "" Then
'Select Case txtcount
' Case 0
MsgBox "事故时间不能为空，请输入时间", vbOKOnly + vbExclamation, "警告"
txtitem(0).SetFocus
Exit Sub
Else
If Not IsDate(Trim(txtitem(0))) Then
MsgBox "请输入时间，格式yyyy-mm-dd", vbOKOnly + vbExclamation, "警告"
txtitem(0).SetFocus
Exit Sub
Else
txtitem(0) = Format(txtitem(0), "yyyy-mm-dd")
End If
End If
If Trim(txtitem(1) & "") = "" Then
' Case 1
MsgBox "事故地点不能为空，请输入事故地点", vbOKOnly + vbExclamation, "警告"
txtitem(txtcount).SetFocus
Exit Sub
' End Select
End If
' Next txtcount
If Trim(txtitem(6) & "") = "" Then
txtitem(6) = "0"
Else
If Not IsNumeric(Trim(txtitem(6))) Then
MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
txtitem(6).SetFocus
Exit Sub
End If
End If
If gintaMode = 1 Then
txtsql = "select * from accident"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.AddNew
For txtcount = 0 To 1
mrc.Fields(txtcount) = Trim(cboitem(txtcount).Text)
Next txtcount
For txtcount = 0 To 7
mrc.Fields(txtcount + 2) = Trim(txtitem(txtcount))
Next txtcount
' mrc.Fields(8) = CDbl(Trim(txtitem(6)))
' mrc.Fields(9) = Trim(txtitem(7))
mrc.Update
mrc.Close
MsgBox "添加信息成功!", vbOKOnly + vbExclamation, "添加"
End If
If gintaMode = 2 Then
txtsql = "delete from accident where sg_id='" & Trim(frmaccidentlist.msglist.TextMatrix(frmaccidentlist.msglist.Row, 1)) & "'and sg_date='" & frmaccidentlist.msglist.TextMatrix(frmaccidentlist.msglist.Row, 3) & "'"
ExecuteSQL txtsql, msgtext
txtsql = "select * from accident"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.AddNew
For txtcount = 0 To 1
mrc.Fields(txtcount) = Trim(cboitem(txtcount).Text)
Next txtcount
For txtcount = 0 To 7
mrc.Fields(txtcount + 2) = Trim(txtitem(txtcount))
Next txtcount
mrc.Update
mrc.Close
MsgBox "修改信息成功!", vbOKOnly + vbExclamation, "修改"
End If
If gintaMode = 1 Then
For txtcount = 0 To 1
cboitem(txtcount) = ""
Next txtcount
For txtcount = 0 To 7
txtitem(txtcount) = ""
Next txtcount
End If
If gintaMode = 2 Then
Unload Me
If flagaEdit Then
Unload frmaccidentlist
End If
frmaccidentlist.txtsql = ""
frmaccidentlist.Show
End If
End Sub
Private Sub Form_Load()
Dim txtcount As Integer
Dim msgtext As String
frmaccident.Left = 3420
frmaccident.Top = 1320
If gintaMode = 1 Then
Me.Caption = Me.Caption & "添加"
txtsql = "select distinct cl_id from vehicle"
Set mrc = ExecuteSQL(txtsql, msgtext)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboitem(0).AddItem (mrc!cl_id)
mrc.MoveNext
Loop
End If
txtsql = "select DISTINCT sj_name from driver"
Set mrc = ExecuteSQL(txtsql, msgtext)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboitem(1).AddItem Trim(mrc!sj_name)
'Cobdriver.AddItem Trim(mrc!yy_driver)
mrc.MoveNext
Loop
End If
mrc.Close
End If
'End Sub
If gintaMode = 2 Then
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = False Then
With mrc
For txtcount = 0 To 1
If (.Fields(txtcount) & "") <> "" Then
cboitem(txtcount).Text = .Fields(txtcount)
End If
Next txtcount
For txtcount = 0 To 7
If (.Fields(txtcount + 2) & "") <> "" Then
txtitem(txtcount).Text = .Fields(txtcount + 2)
End If
Next txtcount
' End If
End With
' End If
End If
mrc.Close
Me.Caption = Me.Caption & "修改"
cboitem(0).Enabled = False
txtsql = "select DISTINCT sj_name from driver"
Set mrc = ExecuteSQL(txtsql, msgtext)
If Not mrc.EOF Then
Do While Not mrc.EOF
cboitem(1).AddItem Trim(mrc!sj_name)
'Cobdriver.AddItem Trim(mrc!yy_driver)
mrc.MoveNext
Loop
End If
mrc.Close
txtchange = False
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
txtchange = True
End Sub
Private Sub txtitem_Change(Index As Integer)
txtchange = True
End Sub
Private Sub txtitem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
EnterToTab KeyCode
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?