📄 form8.frm
字号:
VERSION 5.00
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Begin VB.Form Form8
BorderStyle = 1 'Fixed Single
Caption = "加 油"
ClientHeight = 7770
ClientLeft = 45
ClientTop = 375
ClientWidth = 11670
LinkTopic = "Form8"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 7770
ScaleWidth = 11670
Begin FlexCell.Grid Grid1
Height = 6735
Left = 120
TabIndex = 0
Top = 240
Width = 11535
_ExtentX = 20346
_ExtentY = 11880
Cols = 5
Rows = 30
End
Begin StoneXP.XPButton XPButton5
Height = 375
Left = 7560
TabIndex = 1
Top = 7200
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "退 出"
MouseIcon = "Form8.frx":0000
MousePointer = 99
End
Begin StoneXP.XPButton XPButton2
Height = 375
Left = 5640
TabIndex = 2
Top = 7200
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "保 存"
MouseIcon = "Form8.frx":031A
MousePointer = 99
End
Begin StoneXP.XPButton XPButton1
Height = 375
Left = 3720
TabIndex = 3
Top = 7200
Width = 975
_ExtentX = 1720
_ExtentY = 661
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "加 油"
MouseIcon = "Form8.frx":0634
MousePointer = 99
End
End
Attribute VB_Name = "Form8"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim gridsave As Boolean
Dim gridedit As Boolean
Dim griddelete As Boolean
Dim str As String
Private Sub Form_Load()
mdi = False
'On Error GoTo finish
Set mdbrs1 = mdbconn.Execute("select * from 加油信息")
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
With Grid1
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.Cols = 8
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.BackColorFixed = RGB(90, 158, 214)
.BackColorFixedSel = RGB(110, 180, 230)
.BackColorBkg = RGB(90, 158, 214)
.BackColorScrollBar = RGB(231, 235, 247)
.BackColor1 = RGB(231, 235, 247)
.BackColor2 = RGB(239, 243, 255)
.GridColor = RGB(148, 190, 231)
.AllowUserResizing = True
.DisplayFocusRect = False
.ExtendLastCol = True
.Appearance = Flat
.FixedRowColStyle = Flat
.ScrollBarStyle = Flat
.GridColor = RGB(148, 190, 231)
.DefaultFont.Name = "Tahoma"
.DefaultFont.Size = 8
.Column(0).Width = 0
.Column(1).Width = 100
.Column(2).Width = 220
.Column(3).Width = 80
.Column(4).Width = 80
.Column(5).Width = 70
.Column(6).Width = 100
.Column(7).Width = 50
.Column(7).CellType = cellComboBox
.ComboBox(7).Clear
End With
For i = 1 To 12
Grid1.ComboBox(7).AddItem i
Next
Set mdbrs = mdbconn.Execute("select * from 加油信息")
Grid1.Rows = 1
i = 7
Grid1.Cols = i + 1
For i = 0 To 6
If i = 3 Then
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name & "(元/升)"
Else
If i = 4 Then
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name & "(升)"
Else
If i = 5 Then
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name & "(元)"
Else
Grid1.Cell(0, i + 1).Text = mdbrs.Fields(i).Name
End If
End If
End If
Next
Grid1.Column(2).CellType = cellComboBox
Grid1.ComboBox(2).Clear
Set mdbrs2 = mdbconn.Execute("select * from 车辆表")
Do While Not mdbrs2.EOF
Grid1.ComboBox(2).AddItem mdbrs2.Fields(1).Value & "~" & mdbrs2.Fields(2).Value & "~" & mdbrs2.Fields(3).Value
mdbrs2.MoveNext
Loop
Call XPButton1_Click
Grid1.Column(1).Locked = True
gridsave = False
gridedit = True
griddelete = True
mdi = False
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
mdi = True
End Sub
Private Sub XPButton1_Click()
On Error GoTo finish
gridsave = True
gridedit = False
griddelete = False
Set mdbrs = mdbconn.Execute("select * from 加油信息")
Grid1.Rows = 1
Grid1.Rows = 2
Grid1.Column(2).Locked = False
Grid1.Column(5).Locked = False
Grid1.Column(7).Locked = False
Grid1.Column(1).Locked = True
Grid1.Column(3).Locked = True
Grid1.Column(4).Locked = True
Grid1.Column(6).Locked = True
Grid1.Cell(1, 2).SetFocus
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton2_Click()
On Error GoTo finish
Dim sr, sr1 As String
Dim ye1, ye2, ye3 As Double
sr = "select 单位名称,预存款余额 from 客户信息 where 单位名称='" & Grid1.Cell(1, 1).Text & "'"
Set mdbrs1 = mdbconn.Execute(sr)
Set mdbrs2 = mdbconn.Execute("select sum(单次加油金额) from 加油信息 where 单位名称='" & Grid1.Cell(1, 1).Text & "'")
If mdbrs1.EOF = True Then
MsgBox "此单位不存在!!"
Else
If Grid1.Cell(1, 1).Text <> "" And Grid1.Cell(1, 2).Text <> "" And Grid1.Cell(1, 3).Text <> "" And Grid1.Cell(1, 4).Text <> "" And Grid1.Cell(1, 5).Text <> "" And Grid1.Cell(1, 6).Text <> "" And Grid1.Cell(1, 7).Text <> "" Then
Else
MsgBox "都不可以是空格！", vbInformation, "错误提示"
Exit Sub
End If
ye1 = mdbrs1.Fields(1)
ye2 = Val(Grid1.Cell(1, 6).Text)
ye3 = mdbrs2.Fields(0)
ye1 = ye1 - ye2 - ye3
sr1 = Grid1.Cell(1, 1).Text
MsgBox "你当前的余额为:" & Int(ye1)
If ye1 < 200 And ye1 > 0 Then
MsgBox "你的帐户余额不足200元,请及时预交！！", vbInformation, "错误提示"
End If
If ye1 < 0 Then
MsgBox "你的帐户已透支,请及时预交！！", vbInformation, "错误提示"
'Exit Sub
End If
' If mdbrs1.Fields(1) > 200 Then
' If ye1 > 0 Then
If Grid1.Cell(1, 1).Text <> "" And Grid1.Cell(1, 2).Text <> "" And Grid1.Cell(1, 3).Text <> "" And Grid1.Cell(1, 4).Text <> "" And Grid1.Cell(1, 5).Text <> "" And Grid1.Cell(1, 6).Text <> "" And Grid1.Cell(1, 7).Text <> "" Then
'Set mdbrs1 = mdbconn.Execute("update 客户信息 set 预存款余额=ye1 where 单位名称='" & sr1 & "'")
Set mdbrs = mdbconn.Execute("insert into 加油信息 values('" & Grid1.Cell(1, 1).Text & "','" & str & "','" & Grid1.Cell(1, 3).Text & "',val('" & Grid1.Cell(1, 4).Text & "'),val('" & Grid1.Cell(1, 5).Text & "'),val('" & Grid1.Cell(1, 6).Text & "'),'" & Grid1.Cell(1, 7).Text & "')")
MsgBox "提交成功！", vbInformation, "提示"
Call XPButton1_Click
Else
MsgBox "都不可以是空格！", vbInformation, "错误提示"
End If
'Else
'MsgBox "你的帐户余额不足200元,操作无法继续,请及时预交！！", vbInformation, "错误提示"
Exit Sub
'End If
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub
Private Sub XPButton5_Click()
Unload Me
End Sub
Private Sub Grid1_CellChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish
If Grid1.Cell(Row, 2).Text <> "" And Row <> 0 Then
Dim i, l1, l2, l3, l4 As Integer
l1 = l2 = l3 = l4 = 0
l1 = Len(Grid1.Cell(Row, 2).Text)
For i = 1 To l1
If Right(Left(Grid1.Cell(Row, 2).Text, i), 1) = "~" Then
If l2 = 0 Then
l2 = i
Else
If l3 = 0 Then
l3 = i
Else
If l4 = 0 Then
l4 = i
End If
End If
End If
End If
Next
Grid1.Cell(Row, 1).Text = Left(Grid1.Cell(Row, 2).Text, l2 - 1)
Grid1.Cell(Row, 3).Text = Mid(Grid1.Cell(Row, 2).Text, l3 + 1, l4 - l3 - 1)
Grid1.Cell(Row, 4).Text = Right(Grid1.Cell(Row, 2).Text, l1 - l4)
str = Right(Left(Grid1.Cell(Row, 2).Text, l3 - 1), l3 - l2 - 1)
End If
If Grid1.Cell(Row, 5).Text <> "" And Row <> 0 Then
Grid1.Cell(1, 6).Text = Val(Grid1.Cell(1, 5).Text) * Val(Grid1.Cell(1, 4).Text)
End If
Exit Sub
finish:
MsgBox Err.Description
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -