frmcqcl.frm

储蓄管理演示系统.rar 用Visual Basic语言为某储蓄所建立一个“储蓄管理系统”

VERSION 5.00
Begin VB.Form frmCQcl 
   Caption         =   "存取款处理"
   ClientHeight    =   6225
   ClientLeft      =   3345
   ClientTop       =   3225
   ClientWidth     =   8895
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   6225
   ScaleWidth      =   8895
   Begin VB.CommandButton cmdAbort 
      Caption         =   "取消(&A)"
      Enabled         =   0   'False
      Height          =   375
      Left            =   5040
      TabIndex        =   13
      Top             =   5640
      Width           =   1095
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "确认(&U)"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3360
      TabIndex        =   12
      Top             =   5640
      Width           =   1095
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "存款(&S)"
      Height          =   375
      Left            =   6360
      TabIndex        =   3
      Top             =   480
      Width           =   1215
   End
   Begin VB.TextBox txtJe 
      Height          =   375
      Left            =   3000
      TabIndex        =   2
      Top             =   1560
      Width           =   2415
   End
   Begin VB.CommandButton cmdReset 
      Caption         =   "重置(&R)"
      Height          =   375
      Left            =   6360
      TabIndex        =   5
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "关闭(&C)"
      Height          =   375
      Left            =   6600
      TabIndex        =   14
      Top             =   5640
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "储户存取款信息"
      Height          =   3015
      Left            =   720
      TabIndex        =   15
      Top             =   2520
      Width           =   7335
      Begin VB.Label Label6 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   11
         Top             =   2160
         Width           =   3735
      End
      Begin VB.Label Label5 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   10
         Top             =   1800
         Width           =   3495
      End
      Begin VB.Label Label4 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   """￥""#,##0.00"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   2
         EndProperty
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   9
         Top             =   1440
         Width           =   3735
      End
      Begin VB.Label Label3 
         BeginProperty DataFormat 
            Type            =   1
            Format          =   """￥""#,##0.00"
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   2
         EndProperty
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   8
         Top             =   1080
         Width           =   3975
      End
      Begin VB.Label Label2 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   7
         Top             =   720
         Width           =   3855
      End
      Begin VB.Label Label1 
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   2280
         TabIndex        =   6
         Top             =   360
         Width           =   3375
      End
   End
   Begin VB.CommandButton cmdTake 
      Caption         =   "取款(&T)"
      Height          =   375
      Left            =   6360
      TabIndex        =   4
      Top             =   1080
      Width           =   1215
   End
   Begin VB.TextBox txtZh 
      Height          =   405
      Left            =   3000
      TabIndex        =   1
      Top             =   600
      Width           =   2415
   End
   Begin VB.Label LabelJe 
      Caption         =   "请输入金额："
      Height          =   375
      Left            =   960
      TabIndex        =   16
      Top             =   1560
      Width           =   1815
   End
   Begin VB.Label LabelZh 
      Caption         =   "请输入帐号："
      Height          =   255
      Left            =   960
      TabIndex        =   0
      Top             =   660
      Width           =   1815
   End
End
Attribute VB_Name = "frmCQcl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim Jcye As Currency
Dim Jcje As Currency
Dim Je As Currency
Dim num As Currency
Dim strZh As String
Dim strName As String

Private Sub cmdAbort_Click()
    txtZh = ""
    Clear
    adoPrimaryRS.Close
    
    cmdSave.Enabled = True
    cmdTake.Enabled = True
    cmdReset.Enabled = True
    cmdUpdate.Enabled = False
    cmdAbort.Enabled = False

End Sub

Private Sub cmdReset_Click()
    On Error Resume Next
    Clear
End Sub

Private Sub cmdSave_Click()
  '存款处理
  On Error Resume Next
  Je = Abs(txtJe)
  strZh = Trim(txtZh)
  adoPrimaryRS.Open "SHAPE {select 帐号,姓名 from 储户 where 帐号='" & strZh & "'}", db, adOpenStatic, adLockOptimistic
  
  If adoPrimaryRS.RecordCount > 0 Then
    strName = adoPrimaryRS("姓名")
    adoPrimaryRS.Close
    
    adoPrimaryRS.Open "SHAPE {select 帐号,金额,结存金额,日期,编号,备注 from 储蓄帐 where 帐号='" & strZh & "' Order by 日期}", db, adOpenStatic, adLockOptimistic

    num = adoPrimaryRS.RecordCount
    
    If num > 0 Then
        FindLast
        If adoPrimaryRS("备注") = True Then
            Jcye = adoPrimaryRS("结存金额")
            Jcje = Jcye + txtJe
            Xxxs strZh, strName
        Else
            MsgBox Space(15) & "有错误！" & Space(15)
        End If
    Else
        Jcye = 0
        Jcje = Jcye + txtJe
        Xxxs strZh, strName
    End If
  Else
    MsgBox Space(15) & "该帐号不存在！" & Space(15)
    adoPrimaryRS.Close
    txtZh = ""
    Exit Sub
  End If
      
End Sub

Private Sub cmdUpdate_Click()
    If num > 0 Then
        adoPrimaryRS("备注") = False
    End If
    
    Cq strZh, Je, Jcje
    
    cmdSave.Enabled = True
    cmdTake.Enabled = True
    cmdReset.Enabled = True
    cmdUpdate.Enabled = False
    cmdAbort.Enabled = False

End Sub

Private Sub Form_Load()
  On Error Resume Next
  Clear
  Set adoPrimaryRS = New Recordset
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
End Sub

Private Sub cmdExit_Click()
  '关闭窗口
  Unload Me
End Sub

Private Sub Clear()
    '输入初始化
    txtZh = ""
    txtJe = ""
    strName = ""
    Label1.Caption = ""
    Label2.Caption = ""
    Label3.Caption = ""
    Label4.Caption = ""
    Label5.Caption = ""
    Label6.Caption = ""
End Sub

Private Sub cmdTake_Click()
  '取款处理
  On Error Resume Next
  Je = -Abs(txtJe)
  strZh = Trim(txtZh)
  adoPrimaryRS.Open "SHAPE {select 帐号,姓名 from 储户 where 帐号='" & strZh & "'}", db, adOpenStatic, adLockOptimistic
  
  If adoPrimaryRS.RecordCount > 0 Then
    strName = adoPrimaryRS("姓名")
    adoPrimaryRS.Close
    adoPrimaryRS.Open "SHAPE {select 帐号,金额,结存金额,日期,编号,备注 from 储蓄帐 where 帐号='" & strZh & "' Order by 日期}", db, adOpenStatic, adLockOptimistic

        num = adoPrimaryRS.RecordCount
        
        If num > 0 Then
        FindLast
        If adoPrimaryRS("备注") = True Then
            Jcye = adoPrimaryRS("结存金额")
            If Jcye < Abs(Je) Then
                MsgBox "取款数额超过了结存金额！该帐户的结存金额为" & Str(Jcye) & "元"
                txtJe = ""
            Else
                Jcje = Jcye + Je
                Xxxs strZh, strName
            End If
        Else
            MsgBox Space(15) & "有错误！" & Space(15)
        End If
    Else
        MsgBox "该帐户没有存款，不能取款！"
        adoPrimaryRS.Close
    End If
  Else
    MsgBox Space(15) & "该帐号不存在！" & Space(15)
    adoPrimaryRS.Close
    txtZh = ""
    Exit Sub
  End If
End Sub

Private Sub Xxxs(ByVal strZh As String, ByVal strName As String)
    '储户存取款信息显示
  On Error Resume Next
    Label1.Caption = "帐号：" & strZh
    Label2.Caption = "姓名：" & strName
    Label3.Caption = "金额：" & Je
    Label4.Caption = "结存金额：" & Jcje
    Label5.Caption = "日期：" & Date & Space(2) & Time
    Label6.Caption = "编号：" & gstrBH
       
    txtZh = ""
    txtJe = ""
    
    cmdSave.Enabled = False
    cmdTake.Enabled = False
    cmdReset.Enabled = False
    cmdUpdate.Enabled = True
    cmdAbort.Enabled = True
        
End Sub

Private Sub Cq(ByVal strZh As String, ByVal Je As Currency, ByVal Jcje As Currency)
    '存取款数据更新
  On Error Resume Next
    adoPrimaryRS.AddNew
    adoPrimaryRS("帐号") = strZh
    adoPrimaryRS("金额") = Je
    adoPrimaryRS("编号") = gstrBH
    adoPrimaryRS("结存金额") = Jcje
    adoPrimaryRS("日期") = Date & Time
    adoPrimaryRS("备注") = True
    adoPrimaryRS.Update
    adoPrimaryRS.Close
    Clear
End Sub

Private Sub FindLast()
    '查找最后一次存取款记录
    On Error Resume Next
    adoPrimaryRS.MoveFirst
    Do While Not adoPrimaryRS.EOF And adoPrimaryRS("备注") = False
        adoPrimaryRS.MoveNext
    Loop
End Sub