frmbankcard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmBankcard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增银行"
   ClientHeight    =   1725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4290
   HelpContextID   =   10242
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1725
   ScaleWidth      =   4290
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1002"
      Top             =   555
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   2
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtBankName 
      Height          =   285
      Left            =   270
      TabIndex        =   1
      Top             =   660
      Width           =   2325
      _ExtentX        =   4101
      _ExtentY        =   503
      maxchar         =   30
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Text            =   ""
   End
   Begin VB.Label lblBankName 
      Caption         =   "银行名称(&B)"
      Height          =   195
      Left            =   300
      TabIndex        =   0
      Top             =   450
      Width           =   1485
   End
End
Attribute VB_Name = "frmBankcard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                                '
'                功能:   完成银行的增、删、改。                                              '
'                卡片接口:             EditCard 参数: lngID 记录的ID号                           '
'                作用:                           LNGID为零是增加记录、其它为编辑记录             '
'                                      DelCard 参数: lngID 记录的ID号                            '
'                作用:                           删除ID号为LNGID的记录                           '
'                作者：                                                                                  '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Option Explicit

Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mlngbankID As Integer   '文化程度ID
Private mblnIsNew As Boolean
Private mblnIsChanged As Boolean
Private mblnIsEmployee As Boolean

Public Property Get getID() As Long
    getID = mlngbankID
End Property

'引入银行
Public Function AddBank(ByVal strBank As String) As Integer
    AddBank = 0
    If strBank = "" Then Exit Function
    txtBankName.Text = strBank
    mblnIsNew = True
    If Not SaveCard Then Exit Function
    AddBank = 1
End Function

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    mlngbankID = 0
    mblnIsNew = True
    mblnIsChanged = True
    InitCard strName
    Caption = "新增银行"
    mblnIsList = IsList
    Show intModal
    AddCard = mlngbankID
End Function

Public Function DelCard(lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recbankname As rdoResultset
    Dim strName As String, strSql As String
    
    DelCard = False
    strSql = "SELECT * FROM Bank WHERE lngBankID=" & lngID
    Set recbankname = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recbankname.EOF Then
        DelCard = True
        recbankname.Close
        Exit Function
    Else
        strName = recbankname!strbankname
    End If
    recbankname.Close
    
    If CodeIsUsed(lngID) Then
        ShowMsg lnghWnd, "银行已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除银行"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除“" & strName & "”银行吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除银行") = vbNo Then Exit Function
    strSql = "DELETE FROM Bank WHERE lngbankID=" & lngID
    gclsBase.BaseDB.Execute strSql
    gclsSys.SendMessage CStr(Me.hWnd), Message.msgEmployee
    DelCard = True
End Function

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
        Optional strbankname As String)
    Dim strMess As String
    
    If Not CheckIDUsed("Bank", "lngBankID", lngID) Then
        If Trim(strbankname) <> "" Then
            strMess = "“" & strbankname & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "银行不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改银行"
        Unload Me
    Else
        mlngbankID = lngID
        mblnIsNew = False
        InitCard
        Caption = "修改银行"
        cmdOK(2).Visible = False
        Show intModal
    End If
End Sub

Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    CodeIsUsed = True
    If lngID <> 0 Then
        If CheckIDUsed("BankField", "lngBankID", lngID) Then Exit Function
        If CheckIDUsed("Employee", "lngBankID", lngID) Then Exit Function
        If CheckIDUsed("Salary", "lngBankID", lngID) Then Exit Function
    End If
    CodeIsUsed = False
End Function


Private Sub InitCard(Optional strName As String = "")
    Dim recbankname As rdoResultset
    Dim strSql As String
    
    mblnIsInit = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM Bank WHERE lngbankID=" & mlngbankID
        Set recbankname = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtBankName.Text = recbankname!strbankname
        recbankname.Close
    Else
        txtBankName.Text = Trim(strName)
    End If
    mblnIsInit = False
End Sub

Private Sub cmdOK_Click(Index As Integer)
    
    If Index = 0 Then
        If Not SaveCard Then Exit Sub
    ElseIf Index = 2 Then
        If SaveCard Then
'            mlngEducateID = 0
            mblnIsNew = True
            mblnIsChanged = True
            InitCard
            txtBankName.SetFocus
        End If
        Exit Sub
    End If
    Unload Me
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hWnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 10242
    Utility.LoadFormResPicture Me
'    SendKeys "%{B}"
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
  FrameBox Me.hWnd, 90, 150, 2775, 1335
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer
    Dim strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtBankName.Text) = "" Then Exit Sub
    If mblnIsChanged Then
          strMess = "“" & txtBankName.Text & "”" & "银行名称已被修改，是否保存？"
        
        intMsgReturn = ShowMsg(hWnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
End Sub

Private Function SaveCard() As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    
    SaveCard = False
    
    If Not mblnIsChanged Then
        SaveCard = True
        Exit Function
    End If
    If txtBankName.Text = "" Then
        ShowMsg hWnd, "银行名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtBankName.SetFocus
        Exit Function
    End If
     
    strSql = "SELECT * FROM Bank WHERE strbankName='" & txtBankName.Text _
        & "' AND lngbankID <>" & IIf(mblnIsNew, 0, mlngbankID)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        ShowMsg hWnd, "银行名称不能为重复,请重新录入！", vbExclamation + MB_TASKMODAL, Caption
        txtBankName.SetFocus
        recTemp.Close
        Exit Function
    End If
    recTemp.Close
    If mblnIsNew Then
        mlngbankID = GetNewID("Bank")
        strSql = "INSERT INTO Bank(lngBankID,strbankname) VALUES(" _
            & mlngbankID & ",'" & IIf(txtBankName.Text = "", " ", txtBankName.Text) & "')"
        If Not gclsBase.ExecSQL(strSql) Then Exit Function
'        Strsql = "SELECT * FROM Bank WHERE strbankname='" & txtBankName.Text & "'"
'        Set recTemp = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
'        mlngbankID = recTemp!lngBankID
'        recTemp.Close
    Else
        strSql = "UPDATE Bank SET strbankName='" & txtBankName.Text _
            & "'" & "WHERE lngbankID=" & mlngbankID
        If Not gclsBase.ExecSQL(strSql) Then Exit Function
    End If
    SaveCard = True
    mblnIsChanged = False
'    gclsSys.SendMessage CStr(Me.hWnd), Message.msgEmployee
End Function

Private Sub txtBankName_Change()
     
     If ContainErrorChar(txtBankName.Text, "'|~`@^&") Then BKKEY txtBankName.hWnd
     If Not mblnIsInit Then mblnIsChanged = True
End Sub