frmlc.frm

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

    With rsItem
    Do While Not .EOF
        Set Nodx = trvItem.Nodes.Add("*-1", tvwChild, "K" & CStr(rsItem!ID), rsItem!zjzh + " " + rsItem!Name, 2)
        Nodx.Tag = rsItem!ID
        .MoveNext
    Loop
    End With
    
    If trvItem.Nodes.Count > 0 Then
        trvItem.Nodes(1).Selected = True
    End If
    
End Sub

Private Sub iniListView()
    
    lsvDetail.View = lvwReport
    lsvDetail.LabelEdit = lvwManual
    lsvDetail.FullRowSelect = True
    
    lsvDetail.ListItems.Clear
    lsvDetail.ColumnHeaders.Add 1, "K1", "序号", 600, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 2, "K2", "日期", 1400, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 3, "K3", "金额", 2000, lvwColumnRight
    lsvDetail.ColumnHeaders.Add 4, "K4", "明细", 4000, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 5, "K5", "用途", 1600, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 6, "K6", "备注", 1000, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 7, "K7", "更新日期", 1400, lvwColumnLeft
    lsvDetail.ColumnHeaders.Add 8, "K8", "ID", 0, lvwColumnLeft
    
End Sub

Private Sub Form_Resize()
    
    trvItem.Left = 20
    trvItem.Top = 600
    trvItem.Width = Me.ScaleWidth * 0.2
    trvItem.Height = Me.ScaleHeight - 700
    
    lsvDetail.Left = Me.ScaleWidth * 0.2 + 80
    lsvDetail.Top = 600
    lsvDetail.Width = Me.ScaleWidth * 0.8 - 140
    lsvDetail.Height = Me.ScaleHeight - 700 - Picture1.Height - 200
    
    Picture1.Top = lsvDetail.Top + lsvDetail.Height + 100
    Picture1.Left = lsvDetail.Left
    Picture1.Width = lsvDetail.Width
    
    txtZjzj.Width = Picture1.Width - (lblzjzj.Left + lblzjzj.Width) - (cmdUpdate.Width + 60) - 60
    cmdUpdate.Left = txtZjzj.Left + txtZjzj.Width + 60
End Sub

Private Sub lsvDetail_DblClick()
    
    frmZjmx.msStatus = "Browser"
    frmZjmx.mlFatherID = mlFatherID
    frmZjmx.mlID = lsvDetail.SelectedItem.Tag
    frmZjmx.Show vbModal
    
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Dim Nodx As MSComctlLib.Node
Dim strItem As String
Dim sSQL As String
Dim lFatherID As Long
Dim lDetailID As Long
Dim sTempName As String
Dim rsTemp As ADODB.Recordset
Dim HaveRecord As Boolean
Dim lTempID As Long
                   

    Select Case Button.Key
        Case "Refresh"
            
            RefreshItemTree
            
        Case "NewZjzh"
             '添加资金账号
             
             frmZjzh.msStatus = "New"
             frmZjzh.Show vbModal
                
        Case "EditZjzh"
            '修改资金账号
             If Val(trvItem.SelectedItem.Tag) > 0 Then
                mlIndex = trvItem.SelectedItem.Index
                frmZjzh.msStatus = "Modify"
                frmZjzh.mlFatherID = trvItem.SelectedItem.Tag
                frmZjzh.Show vbModal
             ElseIf Val(trvItem.SelectedItem.Tag) <= 0 Then
                Exit Sub
             End If
             
             Call RefreshItemTree
             
        Case "DeleteZjzh"
            '删除资金账号
            If trvItem.SelectedItem.Index < 1 Then
                MsgBox "请先选择一个资金账号!", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
            
            If Val(trvItem.SelectedItem.Tag) > 0 Then
                lFatherID = trvItem.SelectedItem.Tag
            Else
                Exit Sub
            End If
            
            If Not CheckItem(lFatherID) Then
                MsgBox "请先删除该资金账号的资金明细！", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If
            
            If MsgBox("这将删除当前的资金账号，确定吗？", vbQuestion + vbYesNo, "删除资金账号") = vbNo Then
                Exit Sub
            End If
            
            sSQL = "delete from zjzh where id=" & lFatherID
            GDB.Execute (sSQL)

            trvItem.Nodes.Remove trvItem.SelectedItem.Index
            If trvItem.Nodes.Count > 0 Then
                trvItem.Nodes(1).Selected = True
            End If
            
        Case "NewDetail"
            '新增明细记录
            If trvItem.SelectedItem.Key = "*-1" Then Exit Sub
            
            frmZjmx.msStatus = "New"
            frmZjmx.mlFatherID = trvItem.SelectedItem.Tag
            frmZjmx.Show vbModal

        Case "EditDetail"
            '更新明细记录
            If lsvDetail.ListItems.Count <= 0 Then Exit Sub
            If lsvDetail.SelectedItem.Index < 1 Then Exit Sub
            
            frmZjmx.msStatus = "Modify"
            frmZjmx.mlFatherID = mlFatherID
            frmZjmx.mlID = lsvDetail.SelectedItem.Tag
            frmZjmx.Show vbModal
            Call trvItem_Click

        Case "DeleteDetail"
            '删除明细记录
            If lsvDetail.SelectedItem.Index < 1 Then
                MsgBox "请先选择一条明细记录!", vbOKOnly + vbInformation, "提示"
                Exit Sub
            End If

            If MsgBox("这将删除当前的明细记录，确定吗？", vbQuestion + vbYesNo, "删除内容") = vbNo Then
                Exit Sub
            End If

            '删除当前的ITEM
            lDetailID = lsvDetail.SelectedItem.Tag
            sSQL = "delete from zjls where id=" & lDetailID
            GDB.Execute (sSQL)

            Call trvItem_Click
            
        Case "PrintPreview"
              QueryID = mlFatherID
              sSQL = "select * from zjzh,zjls where zjzh.id=zjls.fatherid and zjzh.id=" & QueryID
              Set rsTemp = GDB.Execute(sSQL)
              
              With rsTemp
              If rsTemp.EOF Then
                    Exit Sub
              Else
                  Set DataEnvironment1 = New DataEnvironment1
                  DataEnvironment1.CMDZJLS_Grouping QueryID
                  DataZjlx.Show vbModal
              End If
              End With
'              DataZjlx.PrintReport True, rptRangeAllPages
'              QueryID = mlFatherID
'              ReportLCMX.Show
'               frmReport.Show
                
        Case "Print"
        
        Case "Exit"
                
            Unload Me

    End Select
End Sub

Private Function CheckItem(ByVal FatherID As Long) As Boolean
Dim sSQL As String
Dim lFatherID As Long
Dim rsTemp As ADODB.Recordset

    lFatherID = FatherID
    sSQL = "select * from ZJLS where fatherid=" & lFatherID
    Set rsTemp = GDB.Execute(sSQL)
    
    If rsTemp.EOF Then
        CheckItem = True
    ElseIf Not rsTemp.EOF Then
        CheckItem = False
    End If
    
    Set rsTemp = Nothing
    
End Function

Private Sub trvItem_Click()
Dim Nodex As MSComctlLib.Node

    trvItem.DropHighlight = trvItem.SelectedItem
    If trvItem.SelectedItem.Index > 1 Then
        Set Nodex = trvItem.SelectedItem
        mlFatherID = Nodex.Tag
    Else
        lsvDetail.ListItems.Clear
        Exit Sub
    End If
    
    Call SetZjmxInfo(mlFatherID)
    Call SetZjzhInfo(mlFatherID)
    
End Sub

Private Sub SetZjzhInfo(ByVal ID As Long)
Dim rsZjzh  As ADODB.Recordset
Dim sZjzj   As String
Dim sSQL    As String
    
    
    sSQL = "select * from zjzh where id= " & ID
    Set rsZjzh = GDB.Execute(sSQL)
    
    With rsZjzh
    Do While Not .EOF
        sZjzj = IIf(IsNull(rsZjzh!zjzj), "", rsZjzh!zjzj)
        .MoveNext
    Loop
    End With
    
    txtZjzj.Text = sZjzj
    
    rsZjzh.Close
    Set rsZjzh = Nothing

End Sub

Private Sub SetZjmxInfo(ByVal ID As Long)
Dim rsDetail    As ADODB.Recordset
Dim lsvItem     As MSComctlLib.ListItem
Dim iCount      As Long
Dim sSQL        As String
Dim lRow        As Long
                

    sSQL = "select * from zjls where fatherid= " & ID & " order by fsrq,id"
    Set rsDetail = GDB.Execute(sSQL)
    
    lsvDetail.ListItems.Clear
    
    iCount = 1
    With rsDetail
    Do While Not .EOF
       Set lsvItem = lsvDetail.ListItems.Add(iCount, "U" & iCount)
       lsvItem.Text = iCount
       lsvItem.SubItems(1) = IIf(IsNull(rsDetail!fsrq), "2000-01-01", rsDetail!fsrq)
       lsvItem.SubItems(2) = IIf(IsNull(rsDetail!fsje), 0, Format(rsDetail!fsje, "###,###.00"))
       lsvItem.SubItems(3) = IIf(IsNull(rsDetail!zjmx), "", rsDetail!zjmx)
       lsvItem.SubItems(4) = IIf(IsNull(rsDetail!zjyt), "", rsDetail!zjyt)
       lsvItem.SubItems(5) = IIf(IsNull(rsDetail!comment), "", rsDetail!comment)
       lsvItem.SubItems(6) = IIf(IsNull(rsDetail!modifydate), "", rsDetail!modifydate)
       lsvItem.Tag = rsDetail!ID
       iCount = iCount + 1
       .MoveNext
    Loop
    End With
    
   
    rsDetail.Close
    Set rsDetail = Nothing

End Sub

Private Sub trvItem_NodeClick(ByVal Node As MSComctlLib.Node)
    
    Call trvItem_Click
    
End Sub

Private Sub RefreshItemTree()
Dim sSQL As String
Dim Nodx As MSComctlLib.Node
    
    With trvItem
        .Nodes.Clear
        .Nodes.Add , , "*-1", "资金账号", 1
    End With
    
    sSQL = "select * from zjzh order by zjzh"
    Set rsItem = GDB.Execute(sSQL)
    With rsItem
    Do While Not .EOF
        Set Nodx = trvItem.Nodes.Add("*-1", tvwChild, "K" & CStr(rsItem!ID), rsItem!zjzh + " " + rsItem!Name, 2)
        Nodx.Tag = rsItem!ID
        .MoveNext
    Loop
    End With
    
    If trvItem.Nodes.Count > 0 And mlIndex > 0 Then
        trvItem.Nodes(mlIndex).Selected = True
    End If
    
End Sub