📄 frmdeposit.frm
字号:
VERSION 5.00
Begin VB.Form frmDeposit
BackColor = &H80000007&
Caption = "Form1"
ClientHeight = 3270
ClientLeft = 60
ClientTop = 345
ClientWidth = 6015
LinkTopic = "Form1"
ScaleHeight = 3270
ScaleWidth = 6015
StartUpPosition = 3 '窗口缺省
Tag = "frmDeleteUser"
Begin VB.TextBox txt
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Index = 0
Left = 2640
TabIndex = 5
Top = 720
Width = 2415
End
Begin VB.TextBox txt
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Index = 1
Left = 2640
TabIndex = 4
Top = 1200
Width = 2415
End
Begin VB.TextBox txt
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Index = 2
Left = 2640
TabIndex = 3
Top = 1680
Width = 2415
End
Begin VB.TextBox txt
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Index = 3
Left = 2640
TabIndex = 2
Top = 2160
Width = 2415
End
Begin VB.CommandButton cmdFinally
Caption = "完 成"
Default = -1 'True
Height = 345
Left = 2160
TabIndex = 1
Top = 2760
Width = 975
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取 消"
Height = 345
Left = 3360
TabIndex = 0
Top = 2760
Width = 975
End
Begin VB.Line line
BorderColor = &H00FFFFFF&
BorderWidth = 2
X1 = -600
X2 = 6840
Y1 = 360
Y2 = 360
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "存款"
BeginProperty Font
Name = "华文新魏"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 315
Index = 2
Left = 2640
TabIndex = 10
Top = 0
Width = 630
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入帐户号码："
ForeColor = &H00FFFFFF&
Height = 180
Index = 4
Left = 1080
TabIndex = 9
Top = 840
Width = 1440
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请再次输入帐户号码："
ForeColor = &H00FFFFFF&
Height = 180
Index = 0
Left = 720
TabIndex = 8
Top = 1320
Width = 1800
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请输入存款金额："
ForeColor = &H00FFFFFF&
Height = 180
Index = 1
Left = 1080
TabIndex = 7
Top = 1800
Width = 1440
End
Begin VB.Label lbl
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "请再次输入存款金额："
ForeColor = &H00FFFFFF&
Height = 180
Index = 3
Left = 720
TabIndex = 6
Top = 2280
Width = 1800
End
End
Attribute VB_Name = "frmDeposit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rst As Recordset
Dim nowDate As String
Dim nowTime As String
Dim passTime As Double
Dim percentage As Double
Dim money As Double
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdFinally_Click()
Set rst = New Recordset
nowTime = Now
nowDate = Format(nowTime, "yyyy") + Format(nowTime, "mm") + Format(nowTime, "dd") + Format(nowTime, "hh") + Format(nowTime, "nn") + Format(nowTime, "ss")
If txt(0).Text = txt(1).Text Then
If txt(2).Text <> txt(3).Text Then
MsgBox "请确定两次输入的存款金额相同"
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim depositMoney As Double
Dim getErr As Boolean
getErr = True
On Error GoTo errMoney
depositMoney = CDbl(txt(2).Text)
getErr = False
errMoney:
If getErr = True Then
MsgBox "请确定你所输入的金额为数字！"
Exit Sub
End If
Call LinkDB(landWay, SName, "weboy", SUName, SUPw)
con.Open
Dim have As Boolean
have = False
On Error GoTo errHave
rst.Open "select id from CConsumers", con, adOpenDynamic, adLockOptimistic
rst.MoveFirst
Do While Not rst.EOF
If rst!id = txt(0).Text Then
have = True
Exit Do
End If
rst.MoveNext
Loop
errHave:
If have = False Then
MsgBox "对不起，此帐户不存在！"
Exit Sub
Else
rst.Close
rst.Open "select * from " & txt(0).Text, con, adOpenDynamic, adLockOptimistic
Dim have2 As Boolean
have = False
Dim i As Integer
i = 0
On Error GoTo errHave2
rst.MoveFirst
Do While Not rst.EOF
i = i + 1
rst.MoveNext
Loop
have = True
errHave2:
If have = False Then
con.Execute "insert " & txt(0).Text & " values('" & nowDate & "','set','" & txt(2).Text & "','" & txt(2).Text & "','" & userName & "')"
MsgBox "存款成功"
Unload Me
Else
If i = 1 Then
rst.MoveFirst
passTime = (CDbl(Mid(nowDate, 1, 4)) - CDbl(Mid(rst!Wdate, 1, 4))) * 12 + (CDbl(Mid(nowDate, 5, 2)) - CDbl(Mid(rst!Wdate, 5, 2)))
money = CDbl(txt(2).Text) + (1 + passTime * ((percentage0 / 100) / 12)) * CDbl(rst!balance)
con.Execute "insert " & txt(0).Text & " values('" & nowDate & "','set','" & txt(2).Text & "','" & money & "','" & userName & "')"
rst.Close
con.Close
MsgBox "存款完成"
Unload Me
Else
rst.MoveLast
passTime = (CDbl(Mid(nowDate, 1, 4)) - CDbl(Mid(rst!Wdate, 1, 4))) * 12 + (CDbl(Mid(nowDate, 5, 2)) - CDbl(Mid(rst!Wdate, 5, 2)))
money = CDbl(txt(2).Text) + (1 + passTime * ((percentage0 / 100) / 12)) * CDbl(rst!balance)
con.Execute "insert " & txt(0).Text & " values('" & nowDate & "','set','" & txt(2).Text & "','" & money & "','" & userName & "')"
rst.Close
con.Close
MsgBox "存款完成"
Unload Me
End If
End If
End If
Else
MsgBox "请确定两次输入的帐户值相同"
Exit Sub
End If
End Sub
Private Sub Form_Load()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -