贷款额度.frm

财务信息管理系统,适合做毕业论文的人使用

Dim curNodeIndex As Long

Dim unitInfor() As String
Dim GridData() As String
Dim duplicate As Boolean
Dim borQua As New Collection
Dim curPos As Integer
Dim xmlInit As Boolean
Dim unitzero As Boolean
Dim precol As Integer


'设置treeview项目
Private Sub setTreeview()
    Dim sqlstr As String
    Dim i As Integer
    TreeView1.Nodes.clear
    credstat.ModifyState = 0
    TreeView1.Nodes.Add , , "p", "单位名称", 1
    TreeView1.Nodes.Add "p", tvwChild, "k0", "个人", 1
    TreeView1.Nodes.Add "p", tvwChild, "k1", "部门", 1
    TreeView1.Nodes.Add "p", tvwChild, "k2", "银行", 1
    TreeView1.Nodes.Add "p", tvwChild, "k3", "客户", 1
    TreeView1.Nodes.Add "p", tvwChild, "k4", "供应商", 1
    TreeView1.Nodes.Add "p", tvwChild, "k5", "项目", 1
    
    If unitInfor(0, 0) <> "#$" And unitInfor(0, 1) <> "#$" And unitInfor(0, 2) <> "#$" Then
        For i = 0 To UBound(unitInfor)
            Select Case unitInfor(i, 2)
                Case 0
                    TreeView1.Nodes.Add "k0", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
                Case 1
                    TreeView1.Nodes.Add "k1", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
                Case 2
                    TreeView1.Nodes.Add "k2", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
                Case 3
                    TreeView1.Nodes.Add "k3", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
                Case 4
                    TreeView1.Nodes.Add "k4", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
                Case 5
                    TreeView1.Nodes.Add "p", tvwChild, "p" & CStr(i), CStr(unitInfor(i, 1)), 3
            End Select
        Next
        TreeView1.Nodes("p").Expanded = True
    Else
        'MsgBox "目前没有可用的单位信息！" & vbCrLf & "请先建立单位信息！", vbInformation, "系统信息"
        unitzero = True
    End If
End Sub

Private Sub Form_Load()
'Dim con As New ADODB.Connection
    loadstatic
    SetTBStyle Me
    
    Call setSupergrid
    
    credstat.ModifyState = 0
    curPos = 0
    Constr = zjLogInfo.UfDbName
    con.ConnectionString = Constr
    con.CursorLocation = adUseClient
    con.Open
    
    Call Initialize
    Call setTreeview
    Call setQueryState
    
    tlbTool.Buttons("Modi").Enabled = False
    ocxCtbTool.RefreshEnable
End Sub
'设置表格格式
Private Sub setSupergrid()
    With SuperGrid1
        .clear
        .Rows = 3
        .TextMatrix(0, 0) = "有效期限"
        .TextMatrix(0, 1) = "有效期限"
        .TextMatrix(0, 2) = ""
        .TextMatrix(1, 0) = "下限"
        .TextMatrix(1, 1) = "上限"
        .TextMatrix(1, 2) = "贷款额度"
        .MergeCells = flexMergeFree
        .MergeRow(0) = True
        .SetColProperty 0, 10, DateBrowButton, EditDate
        .SetColProperty 1, 10, DateBrowButton, EditDate
        .SetColProperty 2, 16, DblBrowButton, EditDbl
        .ColAlignment(0) = 3
        .ColAlignment(1) = 3
        .ColAlignment(2) = 3
        .Refresh
    End With
End Sub
'初始化过程
Private Sub Initialize()
    Dim rs As New ADODB.Recordset
    Dim sqlstr As String
    Dim i As Integer
    
    '取已评价单位信息存入数组
    credstat.ModifyState = 0
'    sqlStr = "Select Distinct a.cUnitCode As cUnitCode,b.cUnitName As cunitName,b.iType As iType" & _
'            " From Fd_creEstamate a,FD_AccUnit b where a.cUnitCode=b.cUnitCode order by cUnitCode"
    sqlstr = "select cunitcode,cunitname,iType from fd_AccUnit"
    rs.Open sqlstr, con, adOpenDynamic
    If rs.RecordCount > 0 Then
        ReDim unitInfor(rs.RecordCount - 1, 2)
        For i = 0 To rs.RecordCount - 1
            unitInfor(i, 0) = rs("cUnitCode")
            unitInfor(i, 1) = rs("cUnitName")
            unitInfor(i, 2) = rs("iType")
            rs.MoveNext
        Next
    Else
        ReDim unitInfor(0, 2)
        unitInfor(0, 0) = "#$"
        unitInfor(0, 1) = "#$"
        unitInfor(0, 2) = "#$"
    End If
    rs.Close
    '取信用等级信息存入数组
    sqlstr = "select creClass,borLim from FD_creClass order by creClass"
    rs.Open sqlstr, con, adOpenDynamic
    For i = 1 To borQua.count
        borQua.Remove 1
    Next
    If rs.RecordCount = 0 Then
       ' MsgBox "您还没有建立信用等级信息！" & vbCrLf & "请先建立信用等级！", vbCritical, "系统错误"
        'Unload Me
        'End
    Else
        While Not rs.EOF Or rs.BOF
            borQua.Add CStr(rs("borLim")), CStr("b" & rs("creClass"))
            rs.MoveNext
        Wend
    End If
    
    Set rs = Nothing
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
     Dim result As VbMsgBoxResult
    If credstat.modified Then
        result = MsgBox("您还有数据未保存，是否决定在退出贷款额度程序时保存数据？", vbYesNoCancel, "退出程序")
        Select Case result
         Case vbYes
            If CheckData Then
                If SaveData Then
                   Cancel = 0
                Else
                   Cancel = 1
                   Exit Sub
                End If
            Else
                Cancel = 1
                Exit Sub
            End If
        Case vbNo
            Cancel = 0
        Case vbCancel
            Cancel = 1
            Exit Sub
        End Select
    Else
'        If MsgBox("确定要退出贷款额度程序吗？", vbYesNo, "退出程序") = vbYes Then
'            Cancel = 0
'        Else
'            Cancel = 1
'            Exit Sub
'        End If
    End If
    con.Close
    Set con = Nothing

'    If Not duplicate Then
        Call clear
'    End If

End Sub

Private Sub Form_Resize()
    If Me.width > Label2.width Then
        Label2.left = (Me.width - Label2.width) / 2
    End If
    If Me.width > 200 Then
        Picture1.width = Me.width - 200
    End If
    If Me.Height > tlbTool.Height + 500 Then
        Picture1.Height = Me.Height - tlbTool.Height - 500
    End If
    If Picture1.Height > 300 Then
        TreeView1.Height = Picture1.Height - 300
    End If
    If Picture1.width > TreeView1.width + 300 Then
        SuperGrid1.width = Picture1.width - TreeView1.width - 300
    End If
    If Picture1.Height > SuperGrid1.top + 300 Then
        SuperGrid1.Height = Picture1.Height - SuperGrid1.top - 300
    End If
    ResizeTlb Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
'     Dim result As VbMsgBoxResult
'    If credstat.modified Then
'        result = MsgBox("您还有数据未保存，是否决定在退出贷款额度程序时保存数据？", vbYesNoCancel, "退出程序")
'        Select Case result
'         Case vbYes
'             If saveData Then
'                Cancel = 0
'             Else
'                Cancel = 1
'                Exit Sub
'             End If
'        Case vbNo
'            Cancel = 0
'        Case vbCancel
'            Cancel = 1
'            Exit Sub
'        End Select
'    Else
''        If MsgBox("确定要退出贷款额度程序吗？", vbYesNo, "退出程序") = vbYes Then
''            Cancel = 0
''        Else
''            Cancel = 1
''            Exit Sub
''        End If
'    End If
'    con.Close
'    Set con = Nothing
'
'    If Not duplicate Then
'        Call clear
'    End If

End Sub


Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
    tlbTool_ButtonClick tlbTool.Buttons(cButtonId)
End Sub

Private Sub SuperGrid1_CellDataCheck(RetValue As String, RetState As MsSuperGrid.OpType, ByVal R As Long, ByVal c As Long)
    If R > 1 Then
        If (c = 0 Or c = 1) Then
            SuperGrid1.TextMatrix(R, c) = Format(DateCheck(SuperGrid1.TextMatrix(R, c)), "YYYY-MM-DD")
        Else
            SuperGrid1.TextMatrix(R, c) = Format(SuperGrid1.TextMatrix(R, c), "#0.00")
        End If
    End If
End Sub

Private Sub SuperGrid1_Click()
    credstat.selRow = SuperGrid1.row
    credstat.selcol = SuperGrid1.col
    If credstat.modified Then
        tlbTool.Buttons("delColumn").Enabled = True
    End If
    If SuperGrid1.row = SuperGrid1.Rows - 1 And SuperGrid1.col = 2 Then
        precol = 1
    Else
        precol = 0
    End If

End Sub

Private Sub SuperGrid1_GotFocus()
    If credstat.modified Then
        tlbTool.Buttons("delColumn").Enabled = True
    End If
End Sub

Private Sub SuperGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
   'Dim discolor() As Long
   
   If credstat.ModifyState <> 0 Then
        If KeyCode = vbKeyReturn Then
            If credstat.selcol = 2 And credstat.selRow = SuperGrid1.Rows - 1 Then
                If precol = 0 Or precol = 2 Then
                    precol = 1
                ElseIf precol = 1 Then
                    'SuperGrid1.AddRecord "0" & SuperGrid1.Rows, discolor()
                    Call addColumnProc
                    precol = 0
                End If
            Else
                precol = 0
            End If
        End If
    End If
End Sub

Private Sub SuperGrid1_LostFocus()
    tlbTool.Buttons("delColumn").Enabled = False
    SuperGrid1.ProtectUnload
End Sub

Private Sub SuperGrid1_RowColChange()
    With SuperGrid1
        If credstat.selRow > 1 And (credstat.selcol = 1 Or credstat.selcol = 0) Then
            .TextMatrix(credstat.selRow, credstat.selcol) = Format(DateCheck(.TextMatrix(credstat.selRow, credstat.selcol)), "YYYY-MM-DD")
        End If
        If .row = .Rows - 1 Then
            If credstat.selcol = 2 Then
                precol = 2
            ElseIf credstat.selcol = 1 Then
                precol = 0
            End If
        Else
            precol = credstat.selcol
        End If
        credstat.selRow = .row
        credstat.selcol = .col
    End With
    '    If credstat.ModifyState = 1 Then
'        If SuperGrid1.Row <> credstat.selRow Then
'            MsgBox "您正在编辑新增数据，请保存后再执行本操作！", vbInformation, "新增纪录"
'            SuperGrid1.Row = credstat.selRow
'            SuperGrid1.Col = credstat.selcol
'            Exit Sub
'        Else
'            credstat.selroe = SuperGrid1.Row
'            credstat.selcol = SuperGrid1.Col
'        End If
'    End If
End Sub

Private Sub tlbTool_ButtonClick(ByVal Button As MSComctlLib.Button)
    With tlbTool
        Select Case Button.key
            Case "print"
                Call printProc
            Case "preview"
                Call previewProc
            Case "Output"
                Call outputProc
            Case "Modi"
                Call ModiProc
            Case "addColumn"
                Call addColumnProc
            Case "delColumn"
                Call delColumnProc