📄 frmcost.frm
字号:
VERSION 5.00
Begin VB.Form frmcost
BorderStyle = 1 'Fixed Single
Caption = "费用信息"
ClientHeight = 2820
ClientLeft = 5925
ClientTop = 1845
ClientWidth = 3690
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2820
ScaleWidth = 3690
Begin VB.CommandButton cmdcancel
Caption = "取 消"
Height = 375
Left = 2160
TabIndex = 9
Top = 2280
Width = 1095
End
Begin VB.CommandButton cmdok
Caption = "确 定"
Height = 375
Left = 960
TabIndex = 8
Top = 2280
Width = 975
End
Begin VB.TextBox txtitem
Height = 615
Index = 2
Left = 1200
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 1560
Width = 2295
End
Begin VB.TextBox txtitem
Height = 375
Index = 1
Left = 1200
TabIndex = 6
Top = 1080
Width = 2295
End
Begin VB.TextBox txtitem
Height = 375
Index = 0
Left = 1200
TabIndex = 5
Top = 600
Width = 2295
End
Begin VB.ComboBox cboitem
Height = 300
Left = 1200
TabIndex = 4
Top = 240
Width = 2295
End
Begin VB.Label Label4
Caption = "费用说明:"
Height = 375
Left = 120
TabIndex = 3
Top = 1560
Width = 975
End
Begin VB.Label Label3
Caption = "耗费(元):"
Height = 375
Left = 120
TabIndex = 2
Top = 1080
Width = 1095
End
Begin VB.Label Label2
Caption = "费用日期:"
Height = 375
Left = 120
TabIndex = 1
Top = 600
Width = 975
End
Begin VB.Label Label1
Caption = "车辆牌照:"
Height = 375
Left = 120
TabIndex = 0
Top = 240
Width = 1095
End
End
Attribute VB_Name = "frmcost"
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()
txtchange = True
End Sub
Private Sub cmdcancel_Click()
If gintcMode = 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.Text = "" Then
MsgBox "车辆牌照不能为空,请选择车辆牌照", vbOKOnly + vbExclamation, "警告"
cboitem.SetFocus
Exit Sub
End If
For txtcount = 0 To 2
If Trim(txtitem(txtcount)) = "" Then
Select Case txtcount
Case 0
tmsg = "费用日期"
Case 1
tmsg = "耗费"
Case 2
tmsg = "费用说明"
End Select
MsgBox tmsg & "不能为空!", vbOKOnly + vbExclamation, "警告"
txtitem(txtcount).SetFocus
Exit Sub
End If
Next txtcount
If Not IsDate(Trim(txtitem(0))) Then
MsgBox "请输入时间格式,yyyy-mm-dd!", vbOKOnly + vbExclamation, "警告"
txtitem(0).SetFocus
Exit Sub
End If
If Not IsNumeric(Trim(txtitem(1))) Then
MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
txtitem(1).SetFocus
Exit Sub
End If
If gintcMode = 1 Then
txtsql = "select * from cost"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.AddNew
mrc.Fields(0) = Trim(cboitem.Text)
For txtcount = 0 To 2
mrc.Fields(txtcount + 1) = Trim(txtitem(txtcount))
Next txtcount
mrc.Update
mrc.Close
MsgBox "添加信息成功,按确定继续添加!", vbOKOnly + vbExclamation, "添加"
End If
If gintcMode = 2 Then
txtsql = "delete from cost where fy_id='" & Trim(frmcostlist.msglist.TextMatrix(frmcostlist.msglist.Row, 1)) & "' and fy_date='" & Trim(frmcostlist.msglist.TextMatrix(frmcostlist.msglist.Row, 2)) & "'"
ExecuteSQL txtsql, msgtext
txtsql = "select * from cost"
Set mrc = ExecuteSQL(txtsql, msgtext)
mrc.AddNew
mrc.Fields(0) = Trim(cboitem.Text)
For txtcount = 0 To 2
mrc.Fields(txtcount + 1) = Trim(txtitem(txtcount))
Next txtcount
mrc.Update
mrc.Close
MsgBox "修改信息成功!", vbOKOnly + vbExclamation, "修改"
flagcEdit = True
End If
If gintcMode = 1 Then
cboitem.Text = ""
For txtcount = 0 To 2
txtitem(txtcount) = ""
Next txtcount
End If
If gintcMode = 2 Then
Unload Me
If flagcEdit Then
Unload frmcostlist
End If
frmcostlist.txtsql = ""
frmcostlist.Show
End If
End Sub
Private Sub Form_Load()
Dim txtcount As Integer
Dim msgtext As String
Me.Left = 5880
Me.Top = 1515
If gintcMode = 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.AddItem (mrc!cl_id)
mrc.MoveNext
Loop
End If
End If
If gintcMode = 2 Then
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = False Then
With mrc
If (.Fields(0) & "") <> "" Then
cboitem.Text = .Fields(0)
End If
For txtcount = 0 To 2
If (.Fields(txtcount + 1) & "") <> "" Then
txtitem(txtcount) = .Fields(txtcount + 1)
End If
Next txtcount
End With
End If
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.AddItem (mrc!cl_id)
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 + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -