frmgetmoney.frm
来自「银行定储模拟程序」· FRM 代码 · 共 340 行
FRM
340 行
VERSION 5.00
Begin VB.Form FrmGetMoney
BackColor = &H8000000A&
BorderStyle = 1 'Fixed Single
Caption = "办理取款"
ClientHeight = 2130
ClientLeft = 45
ClientTop = 330
ClientWidth = 6435
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2130
ScaleWidth = 6435
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Caption = "输入储户信息"
Height = 2055
Left = 120
TabIndex = 0
Top = 0
Width = 6255
Begin VB.TextBox Money
DataField = "档案号"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Left = 1320
MaxLength = 50
TabIndex = 5
Top = 1080
Width = 1440
End
Begin VB.PictureBox picture1
BackColor = &H000000C0&
BorderStyle = 0 'None
ForeColor = &H8000000E&
Height = 225
Left = 3360
ScaleHeight = 225
ScaleWidth = 2415
TabIndex = 13
Top = 1080
Width = 2415
Begin VB.Label BigMoney
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "大写金额"
ForeColor = &H00FFFFFF&
Height = 255
Left = 0
MousePointer = 99 'Custom
TabIndex = 15
Top = 0
Width = 2400
End
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "FrmGetMoney.frx":0000
Left = 1320
List = "FrmGetMoney.frx":000D
TabIndex = 3
Text = "定期一年"
Top = 720
Width = 1815
End
Begin VB.TextBox txtUserID
DataField = "档案号"
DataSource = "Data1"
ForeColor = &H00000000&
Height = 285
Left = 1320
MaxLength = 50
TabIndex = 1
Top = 360
Width = 1800
End
Begin VB.TextBox txtUserName
Height = 270
Left = 3960
TabIndex = 2
Top = 360
Width = 1815
End
Begin VB.TextBox txtPwd
Height = 270
IMEMode = 3 'DISABLE
Left = 3960
PasswordChar = "*"
TabIndex = 4
Top = 720
Width = 1815
End
Begin VB.CommandButton cmdCancel
Caption = "关闭窗口(&C)"
Height = 405
Left = 3240
TabIndex = 7
Top = 1440
Width = 1275
End
Begin VB.CommandButton cmdModify
Caption = "存款查询(&I)"
Height = 405
Left = 1920
TabIndex = 6
Top = 1440
Width = 1275
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "元"
ForeColor = &H00000000&
Height = 180
Index = 5
Left = 2880
TabIndex = 14
Top = 1110
Width = 180
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "用户帐号："
ForeColor = &H00000000&
Height = 180
Index = 0
Left = 360
TabIndex = 12
Top = 360
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "姓名："
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 3360
TabIndex = 11
Top = 360
Width = 540
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "密码："
ForeColor = &H00000000&
Height = 180
Index = 2
Left = 3360
TabIndex = 10
Top = 720
Width = 540
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "储种："
ForeColor = &H00000000&
Height = 180
Index = 3
Left = 720
TabIndex = 9
Top = 750
Width = 540
End
Begin VB.Label lblLabels
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "储金："
ForeColor = &H00000000&
Height = 180
Index = 7
Left = 720
TabIndex = 8
Top = 1095
Width = 540
End
End
End
Attribute VB_Name = "FrmGetMoney"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdModify_Click()
If txtUserID = "" Or txtUserName = "" Or txtPwd = "" Or Money = "" Then
MsgBox "请检查 帐号、姓名、存款、密码 是否填全!", vbInformation, "提示："
Exit Sub
End If
FindRecord
'frmPickMoney.Show
'Unload Me
End Sub
Private Sub Combo1_GotFocus()
ShowFocus Combo1
End Sub
Private Sub Combo1_LostFocus()
LeaveFocus Combo1
End Sub
Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2, Me.Width, Me.Height
AniShowFrm Me.hwnd
End Sub
Private Sub Money_Change()
If Not IsNumeric(Money) And Money <> "" Then
SendKeys "{BS}"
End If
If Money = "0" Then
BigMoney = "零圆"
Else
BigMoney = changemoney(Val(Money))
End If
If Money = "" Then BigMoney = "大写人民币金额"
End Sub
Private Sub Money_GotFocus()
ShowFocus Money
End Sub
Private Sub Money_LostFocus()
LeaveFocus Money
End Sub
Private Sub txtPwd_Change()
If Len(txtPwd) = 6 Then
SendKeys "{tab}"
End If
End Sub
Private Sub txtPwd_GotFocus()
ShowFocus txtPwd
End Sub
Private Sub txtPwd_LostFocus()
LeaveFocus txtPwd
End Sub
Private Sub txtUserID_GotFocus()
ShowFocus txtUserID
End Sub
Private Sub txtUserID_LostFocus()
LeaveFocus txtUserID
End Sub
Private Sub txtUserName_Change()
If Len(txtUserName) >= 10 Then
SendKeys "{tab}"
End If
End Sub
Private Sub txtUserName_GotFocus()
ShowFocus txtUserName
End Sub
Private Sub txtUserName_LostFocus()
LeaveFocus txtUserName
End Sub
Private Sub FindRecord()
Dim db As Database, rs As Recordset, SqlStr As String
Set db = OpenDatabase(App.Path & "\bank.mdb")
Set rs = db.OpenRecordset("存款记录", dbOpenDynaset)
SqlStr = "姓名='" & txtUserName & "'" & "AND 帐号='" & txtUserID & "'" & "AND 储种='" & Combo1 & "'" & "AND 本金=" & Money
rs.FindFirst SqlStr
If Not rs.NoMatch Then
If txtPwd = Decipher(rs!密码) Then
With frmPickMoney
.Show
.txtUserID = rs!帐号
.txtUserName = rs!姓名
.Combo1 = rs!储种
.txtMoney = rs!本金
.txtLiXi = ShowMoney(rs!本金, rs!储种) - rs!本金
.txtRate = ShowLiLu(rs!储种)
.txtPay = ShowMoney(rs!本金, rs!储种)
.txtAddress = rs!地址
.txtYear = Year(rs!存款日期)
.txtMonth = Month(rs!存款日期)
.txtday = Day(rs!存款日期)
.txtLostDay = IIf(IsDate(rs!挂失日期), rs!挂失日期, "未挂失")
.txtOperator = rs!营业员
.txtWorkNum = rs!工号
If .txtPay = "0" Then
.BigMoney = "零圆"
Else
.BigMoney = changemoney(Val(.txtPay))
End If
If rs!是否挂失 = True Then
.lblStatus = "该存款已经于 " & rs!挂失日期 & " 挂失，不能提款!"
.Command1.Enabled = False
.Picture1(1).BackColor = &HC0&
MsgBox "该帐户已于 " & rs!挂失日期 & " 挂失，不能提取存款!", vbInformation, "警告："
GoTo HANG
End If
If CashDay(rs!存款日期, rs!储种) < Date Then
.lblStatus = "该存款已经到期 " & Date - CashDay(rs!存款日期, rs!储种) & " 天，到期时间 " & CashDay(rs!存款日期, rs!储种)
.Picture1(1).BackColor = &HC0&
.txtLiXi = ShowMoney(rs!本金, rs!储种) - rs!本金 + 0.00005 * rs!本金 * (Date - CashDay(rs!存款日期, rs!储种))
.txtRate = ShowLiLu(rs!储种)
.txtPay = ShowMoney(rs!本金, rs!储种) + 0.00005 * rs!本金 * (Date - CashDay(rs!存款日期, rs!储种))
If .txtPay = "0" Then
.BigMoney = "零圆"
Else
.BigMoney = changemoney(Val(.txtPay))
End If
ElseIf CashDay(rs!存款日期, rs!储种) > Date Then
.lblStatus = "该存款尚未到期，到期时间 " & CashDay(rs!存款日期, rs!储种)
Else
.lblStatus = "该存款今日到期!"
.Picture1(1).BackColor = &HC0&
End If
HANG:
End With
db.Close
Unload Me
Else
MsgBox "用户密码错误!", vbCritical, "警告："
txtPwd.SetFocus
End If
On Error Resume Next
db.Close
Exit Sub
Else
MsgBox "没有找到该条记录!", vbInformation, "查找结果："
db.Close
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?