frmzjzh.frm

证券公司监测内部客户资金流向的系统

VERSION 5.00
Begin VB.Form frmZjzh 
   Caption         =   "资金账号"
   ClientHeight    =   3210
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5595
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3210
   ScaleWidth      =   5595
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame Frame1 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2055
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   5295
      Begin VB.TextBox txtCode 
         Height          =   375
         Left            =   1560
         TabIndex        =   0
         Top             =   480
         Width           =   3255
      End
      Begin VB.TextBox txtName 
         Height          =   375
         Left            =   1560
         TabIndex        =   1
         Top             =   1080
         Width           =   3255
      End
      Begin VB.Label Label1 
         Caption         =   "资金账号："
         Height          =   255
         Left            =   360
         TabIndex        =   6
         Top             =   600
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "名称："
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   1200
         Width           =   615
      End
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Height          =   495
      Left            =   960
      TabIndex        =   2
      Top             =   2400
      Width           =   1335
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出(&E)"
      Height          =   495
      Left            =   3000
      TabIndex        =   4
      Top             =   2400
      Width           =   1335
   End
End
Attribute VB_Name = "frmZjzh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public msStatus As String
Public mlFatherID As Long

Private Sub cmdExit_Click()
    
    Unload Me
    
End Sub

Private Sub cmdOk_Click()
Dim Nodx As MSComctlLib.Node
Dim sSQL As String
Dim sCode As String
Dim sName As String
Dim rsTemp As ADODB.Recordset
Dim lFatherID As Long
Dim iCount As Long
Dim lsvItem As MSComctlLib.ListItem
    
    If CheckItem = False Then Exit Sub
    
    sCode = txtCode.Text
    sName = txtName.Text
    
    If msStatus = "New" Then
        lFatherID = GetID
        sSQL = "insert into zjzh(id,zjzh,name)" & _
             "values(" & lFatherID & ",'" & sCode & "','" & sName & "')"
        GDB.Execute (sSQL)
    ElseIf msStatus = "Modify" Then
        sSQL = "update zjzh set zjzh='" & sCode & "' ,name='" & sName & "' where id=" & mlFatherID
        GDB.Execute (sSQL)
    End If

   '将新的资金账号添加到资金树中
   If msStatus = "New" Then
     Set Nodx = frmLC.trvItem.Nodes.Add("*-1", tvwChild, "K" & CStr(lFatherID), sCode + " " + sName, 2)
     Nodx.Tag = lFatherID
     txtCode.Text = ""
     txtName.Text = ""
     txtCode.SetFocus
   ElseIf msStatus = "Modify" Then
     Unload Me
   End If

End Sub

Private Function CheckItem() As Boolean
Dim sSQL As String
Dim lID As Long
Dim sZjzh As String, sName As String
Dim rsTemp As ADODB.Recordset
Dim bExist As Boolean

    CheckItem = False
    
    If Trim(txtCode.Text) = "" Then
        MsgBox "请输入资金账号！", vbOKOnly + vbInformation, "提示"
        Exit Function
    End If
        
    If Trim(txtName.Text) = "" Then
        MsgBox "请输入名称！", vbOKOnly + vbInformation, "提示"
        Exit Function
    End If
    
    sZjzh = txtCode.Text
    sName = txtName.Text
    
    If msStatus = "New" Then
        sSQL = "select * from zjzh where zjzh='" & sZjzh & "'"
        Set rsTemp = GDB.Execute(sSQL)
        
        With rsTemp
        Do While Not .EOF
            bExist = True
            .MoveNext
        Loop
        End With
        
        If bExist = True Then
            MsgBox "该资金账号已存在，请重新输入！", vbInformation + vbOKOnly, "提示"
            Exit Function
        End If
    ElseIf msStatus = "Modify" Then
        sSQL = "select * from zjzh where zjzh='" & sZjzh & "'"
        Set rsTemp = GDB.Execute(sSQL)
        
        With rsTemp
        Do While Not .EOF
            lID = rsTemp!ID
'            bExist = True
            .MoveNext
        Loop
        End With
        
        If lID = mlFatherID Then
            bExist = False
        ElseIf lID > 0 And lID <> mlFatherID Then
            bExist = True
        End If
        
        If bExist = True Then
            MsgBox "该资金账号已存在，请重新输入！", vbInformation + vbOKOnly, "提示"
            Exit Function
        End If
    End If
        
    CheckItem = True
    
End Function

Private Function GetID() As Long
Dim sSQL As String
Dim rsTemp As Recordset
Dim lMaxID As Long
Dim lTempID As Long

    sSQL = "select max(ID) as MaxID from zjzh "
    Set rsTemp = GDB.Execute(sSQL)
    
    With rsTemp
    Do While Not .EOF
        lMaxID = IIf(IsNull(rsTemp!maxid), 0, rsTemp!maxid)
        .MoveNext
    Loop
    End With
    
        
    lTempID = IIf(IsNull(lMaxID), 0, lMaxID) + 1
    
    GetID = lTempID
    
    rsTemp.Close
    Set rsTemp = Nothing
    
End Function

Private Sub Form_Load()
Dim lItemIndex As Long

    If msStatus = "Modify" Then
        Call SetInfo(mlFatherID)
    ElseIf msStatus = "New" Then
        txtCode.Text = ""
        txtName.Text = ""
    End If
    
End Sub

Private Sub SetInfo(ByVal FatherID As Long)
Dim sSQL As String
Dim rsTemp As Recordset

    sSQL = "select * from zjzh where id=" & mlFatherID
    Set rsTemp = GDB.Execute(sSQL)
    
    With rsTemp
    Do While Not .EOF
        txtCode.Text = rsTemp!zjzh
        txtName.Text = rsTemp!Name
        .MoveNext
    Loop
    End With
    
    rsTemp.Close
    Set rsTemp = Nothing

End Sub

Private Sub txtCode_GotFocus()
    txtCode.SelStart = 0
    txtCode.SelLength = Len(txtCode.Text)
End Sub

Private Sub txtcode_KeyDown(KeyCode As Integer, Shift As Integer)
    
    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If

End Sub

Private Sub txtName_GotFocus()
    txtName.SelStart = 0
    txtName.SelLength = Len(txtName.Text)
End Sub

Private Sub txtname_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    End If
    
End Sub