📄 frmbk.frm
字号:
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 120
TabIndex = 9
Top = 480
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "型 号："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 120
TabIndex = 8
Top = 960
Width = 1095
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "车 长："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 120
TabIndex = 7
Top = 1440
Width = 1095
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "车 宽："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 2640
TabIndex = 6
Top = 1440
Width = 1095
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
Caption = "类 型："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 2640
TabIndex = 5
Top = 480
Width = 1095
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
Caption = "前 驱："
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 2640
TabIndex = 4
Top = 960
Width = 1095
End
Begin VB.Label Label11
BackStyle = 0 'Transparent
Caption = "CM"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 1920
TabIndex = 3
Top = 1440
Width = 255
End
Begin VB.Label Label12
BackStyle = 0 'Transparent
Caption = "CM"
BeginProperty Font
Name = "仿宋_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 4440
TabIndex = 2
Top = 1440
Width = 255
End
End
Begin VB.PictureBox PicTop
BackColor = &H00808080&
BorderStyle = 0 'None
Height = 450
Left = 45
ScaleHeight = 30
ScaleMode = 3 'Pixel
ScaleWidth = 788
TabIndex = 0
TabStop = 0 'False
Top = 0
Width = 11820
Begin VB.Label Label28
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 = 600
TabIndex = 1
Top = 120
Width = 900
End
Begin VB.Image imgIcon
Height = 240
Left = 60
Picture = "frmBk.frx":0000
Top = 120
Width = 240
End
End
End
Attribute VB_Name = "frmBk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmbcm_Click()
If cmbxh.Text <> "" Then
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where cm='" & cmbcm.Text & "' and xh='" & cmbxh.Text & "'"
Res.Open Sstr, Conn
If Res.EOF Then
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where cm='" & cmbcm.Text & "'"
Res.Open Sstr, Conn
End If
Else
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where cm='" & cmbcm.Text & "'"
Res.Open Sstr, Conn
End If
If Res.EOF = False Then
txtcc.Text = Res!cc
cmblx.Text = Res!lx
cmbxh.Text = Res!xh
cmbqq.Text = Res!qq
txtck.Text = Res!ck
Else
MsgBox "没有找到记录！", vbOKOnly, "提示"
cmbxh = ""
txtcc = ""
txtck = ""
End If
End Sub
Private Sub cmblx_Click()
Call txtck_Change
End Sub
Private Sub cmblx_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub cmbqq_Click()
Call txtcc_Change
End Sub
Private Sub cmbqq_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub cmbxh_Click()
If cmbcm.Text <> "" Then
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where cm='" & cmbcm.Text & "' and xh='" & cmbxh.Text & "'"
Res.Open Sstr, Conn
If Res.EOF Then
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where xh='" & cmbxh.Text & "'"
Res.Open Sstr, Conn
End If
Else
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where xh='" & cmbxh.Text & "'"
Res.Open Sstr, Conn
End If
If Res.EOF = False Then
txtcc.Text = Res!cc
cmblx.Text = Res!lx
cmbcm.Text = Res!cm
cmbqq.Text = Res!qq
txtck.Text = Res!ck
Else
MsgBox "没有找到记录！", vbOKOnly, "提示"
cmbcm = ""
txtcc = ""
txtck = ""
End If
End Sub
Private Sub Command1_Click()
Call kczl_add_update
End Sub
Private Sub kczl_add_update()
Dim cx_flag As Boolean
Set Res = New ADODB.Recordset
Sstr = "select * from kczl where cm='" & cmbcm.Text & "' and xh='" & cmbxh.Text & "'"
Res.Open Sstr, Conn
If Res.EOF And Res.BOF Then
Sstr = "insert into kczl(cm,lx,xh,qq,cc,ck) values('" & cmbcm.Text & "','" & cmblx.Text & "','" & cmbxh.Text & "','" & cmbqq.Text & "','" & txtcc.Text & "','" & txtck & "')"
Conn.Execute Sstr
cx_flag = False
For i = 0 To cmbcm.ListCount - 1
If cmbcm.List(i) = cmbcm Then cx_flag = True
Next i
If cx_flag = False Then cmbcm.AddItem cmbcm.Text
cx_flag = False
For i = 0 To cmbxh.ListCount - 1
If cmbxh.List(i) = cmbxh Then cx_flag = True
Next i
If cx_flag = False Then cmbxh.AddItem cmbxh.Text
Else
Sstr = "update kczl set lx='" & cmblx.Text & "',qq='" & cmbqq.Text & "',cc='" & txtcc.Text & "',ck='" & txtck.Text & "' where cm='" & cmbcm.Text & "' and xh='" & cmbxh.Text & "' "
Conn.Execute Sstr
End If
End Sub
Private Sub Command10_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Call kczl_add_update
End Sub
Private Sub Command4_Click()
If MsgBox("确定要删除当前考车信息吗？", vbOKCancel, "删除信息提示") = vbOK Then
Sstr = "delete * from kczl where cm='" & cmbcm.Text & "' and xh='" & cmbxh.Text & "'"
Conn.Execute Sstr
cmbcm = ""
cmbxh = ""
txtcc = ""
txtck = ""
End If
End Sub
Private Sub Command7_Click()
For i = 0 To 3
If txtzero(i) = "" Then
MsgBox "请设置场地零位与电机周长！"
Exit Sub
End If
Next i
If txtlk.Text = "" Or txtzc.Text = "" Or txtzk.Text = "" Then
MsgBox "请输入正确的车长和车宽", 36
Exit Sub
End If
j = Val(txtzero(3))
i = Val(txtlk) - Val(txtzero(0)) '路宽 设一线
Txtzd(0) = (i - txtStr(4)) / j
Txtzd(1) = (i - txtStr(5)) / j
i = txtzc - txtzero(2) '桩长 设三线
Txtzd(2) = (i - txtStr(6)) / j
Txtzd(3) = (i - txtStr(7)) / j
i = txtzk - txtzero(1) '库宽 设四、六线
Txtzd(4) = (i - txtStr(4)) / j
Txtzd(5) = (i - txtStr(5)) / j
Txtzd(6) = (i - txtStr(6)) / j
Txtzd(7) = (i - txtStr(7)) / j
End Sub
Private Sub Command8_Click()
For i = 0 To 8
Txtzd(i) = 0
Next i
End Sub
Private Sub Command9_Click()
FrmBKkl.Show 1
End Sub
Private Sub Form_Load()
Me.WindowState = 2
SetSB 2, "桩考变库（设置考场）"
RFcar (App.Path & "\bk.txt")
For i = 0 To 3
txtzero(i).Text = txtStr(i)
Next i
Set Res = New ADODB.Recordset
Sstr = "select cm from kczl group by cm"
Res.Open Sstr, Conn
Do Until Res.EOF
cmbcm.AddItem Res!cm
Res.MoveNext
Loop
Set Res = New ADODB.Recordset
Sstr = "select xh from kczl group by xh"
Res.Open Sstr, Conn
Do Until Res.EOF
cmbxh.AddItem Res!xh
Res.MoveNext
Loop
End Sub
Private Sub Form_Resize()
PicTop.Width = Width / 15 - 12
Cls
Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then
KeyAscii = 0
End If
End Sub
Private Sub txtcc_Change()
If Trim(txtcc.Text) <> "" Then
If cmbqq.Text = "是" Then
i = 50
Else
i = 0
End If
txtzc = Val(txtcc.Text) * 2 + i
txtlk = Val(txtcc.Text) * 1.5
txtqd = txtlk + Val(txtzk)
End If
End Sub
Private Sub txtcc_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then
KeyAscii = 0
End If
End Sub
Private Sub txtck_Change()
If InStr(cmblx.Text, "B") > 0 Or InStr(cmblx.Text, "A") Then
i = 70
Else
i = 60
End If
txtzk = Val(txtck.Text) + i
txtqd = txtzk + 1.5 * Val(txtcc.Text)
End Sub
Private Sub txtck_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 And KeyAscii <> 46 Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -