评价模型.frm

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

End Sub

'Dim reftest As U8FDRef.FDRefCtrl
'Dim refcol As U8FDRef.ReferenceTypeEnum
'Set reftest=new U
Private Sub tlbTool_ButtonClick(ByVal Button As MsComctlLib.Button)
        
        SuperGrid1.ProtectUnload

    With tlbTool
        Select Case Button.key
            Case "print"
                Call printProc
            Case "preview"
                Call previewProc
            Case "Output"
                Call outputProc
            Case "SelAll"
                Call SelAllProc
            Case "Unsel"
                Call UnselProc
            Case "SelRow"
                Call SelRowProc
            Case "cancelSel"
                Call cancelSelProc
            Case "Modi"
                Call ModiProc
            Case "Cancel"
                Call CancelProc
            Case "Save"
                Call saveProc
            Case "creClass"
                If show_creClass Then
                    If frmcreClass.check_open_Form Then
                        Unload Me
                        frmcreClass.Show
                        Exit Sub
                    End If
                End If
            Case "Help"
                SendKeys "{f1 3}"
            Case "Exit"
                Unload Me
                Exit Sub
        End Select
    End With
    If Button.key <> "Exit" Then ocxCtbTool.RefreshEnable
End Sub

Private Sub SelAllProc()
    Dim i As Integer
    With SuperGrid1
    For i = 1 To .Rows - 1
        .TextMatrix(i, 0) = "Y"
    Next
    tlbTool.Buttons("Save").Enabled = True
    tlbTool.Buttons("Cancel").Enabled = True
    End With
    credstat.modified = True
End Sub

Private Sub UnselProc()
    Dim i As Integer
    With SuperGrid1
    For i = 1 To .Rows - 1
        .TextMatrix(i, 0) = ""
    Next
    End With
    tlbTool.Buttons("Save").Enabled = True
    tlbTool.Buttons("Cancel").Enabled = True
    credstat.modified = True
End Sub

Private Sub SelRowProc()
    SuperGrid1.TextMatrix(SuperGrid1.row, 0) = "Y"
    tlbTool.Buttons("cancelSel").Enabled = True
    tlbTool.Buttons("Save").Enabled = True
    tlbTool.Buttons("Cancel").Enabled = True
    credstat.modified = True
End Sub

Private Sub cancelSelProc()
    SuperGrid1.TextMatrix(SuperGrid1.row, 0) = ""
    tlbTool.Buttons("Save").Enabled = True
    tlbTool.Buttons("Cancel").Enabled = True
    credstat.modified = True
End Sub

Private Sub ModiProc()
    credstat.ModifyState = 1
    credstat.modified = True
    With tlbTool
        .Buttons("Modi").Enabled = False
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        .Buttons("creClass").Enabled = False
        .Buttons("SelAll").Enabled = True
        .Buttons("Unsel").Enabled = True
        .Buttons("SelRow").Enabled = False
        .Buttons("cancelSel").Enabled = False
    End With
End Sub

Private Sub CancelProc()
    Dim i As Integer
    'SuperGrid1.clear
    
    On Error Resume Next
    i = UBound(creData)
    If Err.Number <> 0 Then
        SuperGrid1.Rows = 2
    Else
        SuperGrid1.Rows = UBound(creData) + 2
    End If
    Err.clear
    
    SuperGrid1.Cols = 8
    Call sgsize
    With SuperGrid1
            For i = 1 To .Rows - 1
                .TextMatrix(i, 0) = creData(i - 1, 0)
                .TextMatrix(i, 5) = creData(i - 1, 5)
                .TextMatrix(i, 7) = creData(i - 1, 7)
            Next
    End With
    With tlbTool
        .Buttons("Modi").Enabled = True
        .Buttons("Cancel").Enabled = False
        .Buttons("Save").Enabled = False
        .Buttons("print").Enabled = True
        .Buttons("preview").Enabled = True
        .Buttons("Output").Enabled = True
        .Buttons("creClass").Enabled = True
        .Buttons("SelAll").Enabled = False
        .Buttons("Unsel").Enabled = False
        .Buttons("SelRow").Enabled = False
        .Buttons("cancelSel").Enabled = False
    End With
    credstat.ModifyState = 0
    credstat.modified = False
    SuperGrid1.ReadOnly = True
    tlbTool.Buttons("Cancel").Enabled = False
End Sub
Private Sub saveProc()
    If Not SaveData Then
        MsgBox "数据保存失败！", vbInformation, "保存数据"
    Else
        Call setUserSettings
        
        credstat.ModifyState = 0
        
        Call getOrderString
        
        Call Loaddatatosg
        
        credstat.modified = False
        
        With tlbTool
            .Buttons("Modi").Enabled = True
            .Buttons("Cancel").Enabled = False
            .Buttons("Save").Enabled = False
            .Buttons("print").Enabled = True
            .Buttons("preview").Enabled = True
            .Buttons("Output").Enabled = True
            .Buttons("creClass").Enabled = True
            .Buttons("SelAll").Enabled = False
            .Buttons("Unsel").Enabled = False
            .Buttons("SelRow").Enabled = False
            .Buttons("cancelSel").Enabled = False
        End With
        
        credstat.modified = False
        credstat.ModifyState = 0
        
        SuperGrid1.ReadOnly = True
    End If
End Sub
Private Function SaveData() As Boolean
    Dim rs As New ADODB.Recordset
    Dim rs1 As New ADODB.Recordset
    Dim i As Integer
    Dim j As Integer
    Dim Total_stanvalue As Double
    On Error GoTo error0
    With SuperGrid1
    Total_stanvalue = 0
     .ProtectUnload
'        SaveData = False
'        Exit Function
'    End If
   '.col = 1
    j = 0
    For i = 1 To .Rows - 1
        If .TextMatrix(i, 5) <> "" And .TextMatrix(i, 0) = "Y" Then
            If Not (IsNumeric(.TextMatrix(i, 5))) Then
                MsgBox "第" & i & "行标准分输入错误!" & "输入的不是数字", vbInformation, "输入错误"
                SaveData = False
                Exit Function
            ElseIf CDbl(.TextMatrix(i, 5)) < 0 Then
                MsgBox "第" & i & "行标准分输入错误!" & "输入不能为负", vbInformation, "输入错误"
                SaveData = False
                Exit Function
            Else
                Total_stanvalue = Total_stanvalue + CDbl(.TextMatrix(i, 5))
                j = j + 1
            End If
        ElseIf .TextMatrix(i, 0) = "Y" Then
                MsgBox "第" & i & "行标准分输入错误!" & "输入不能为空"
                SaveData = False
                Exit Function
        End If
    Next
    
    If j > 0 Then
        If Total_stanvalue <> 100 Then
            MsgBox "选中的标准分总和必须为100分！", vbInformation, "输入错误"
            SaveData = False
            Exit Function
        End If
    End If
    
    If Not checkRealValue Then
        SaveData = False
        Exit Function
    End If
    
    con.BeginTrans
    For i = 1 To .Rows - 1
            If .TextMatrix(i, 2) = "定量指标" Then
                rs.Open "select * From FD_CreEvaPara WHERE itemName=" & "'" & .TextMatrix(i, 1) & "'", con, adOpenDynamic, adLockOptimistic
                rs("selflag") = IIf(.TextMatrix(i, 0) = "", 0, 1)
                rs("stanMark") = .TextMatrix(i, 5)
                rs.Update
                rs.Close
            Else
                rs1.Open "select * From FD_creEvaPara Where itemName=" & "'" & .TextMatrix(i, 1) & "'", con, adOpenDynamic, adLockOptimistic
                rs1.MoveFirst
                
                For j = 0 To rs1.RecordCount - 1
                    rs1("selflag") = IIf(.TextMatrix(i, 0) = "", 0, 1)
                    rs1("stanMark") = .TextMatrix(i, 5)
                    rs1.MoveNext
                Next
                rs1.UpdateBatch
                rs1.Close
            End If
    Next
    con.CommitTrans
    Set rs = Nothing
    SaveData = True
    Exit Function
error0:
    con.RollbackTrans
    Set rs = Nothing
    SaveData = False
End With
End Function
'检查是否已有冲突窗体打开
Public Function check_open_Form() As Boolean
    If credstat.proctype = "" Then
        duplicate = False
        check_open_Form = True
        credstat.proctype = "jlmx"
    Else
       Select Case credstat.proctype
            Case "jlzb"
                 MsgBox "您已打开评价指标窗口！" & vbCrLf & "请先关闭评价指标窗口！"
                 duplicate = True
                 check_open_Form = False
                 'Unload Me
                 Exit Function
            Case "jlmx"
                 MsgBox "您已打开了评价模型窗口！" & vbCrLf & "请先关闭评价模型窗口！"
                 duplicate = True
                 check_open_Form = False
                 'Unload Me
                 Exit Function
            Case "xypj"
                 MsgBox "您已打开了信用评价窗口！" & vbCrLf & "请先关闭信用评价窗口！"
                 duplicate = True
                 check_open_Form = False
                 'Unload Me
                 Exit Function
            Case "dked"
                 MsgBox "您已打开贷款额度窗口！" & vbCrLf & "请先关闭贷款额度窗口！"
                 duplicate = True
                 check_open_Form = False
                 'Unload Me
                 Exit Function
       End Select
    End If
        duplicate = False
        check_open_Form = True
        credstat.proctype = ""
End Function

Private Sub loadstatic()
    ImageList1.ListImages.Add , "print", LoadResPicture(314, vbResBitmap)
    ImageList1.ListImages.Add , "preView", LoadResPicture(312, vbResBitmap)
    ImageList1.ListImages.Add , "Output", LoadResPicture(263, vbResBitmap)
    ImageList1.ListImages.Add , "Modi", LoadResPicture(324, vbResBitmap)
    ImageList1.ListImages.Add , "SelAll", LoadResPicture(207, vbResBitmap)
    ImageList1.ListImages.Add , "Unsel", LoadResPicture(208, vbResBitmap)
    ImageList1.ListImages.Add , "SelRow", LoadResPicture(888, vbResBitmap)
    ImageList1.ListImages.Add , "cancelSel", LoadResPicture(326, vbResBitmap)
    ImageList1.ListImages.Add , "creClass", LoadResPicture(313, vbResBitmap)
    ImageList1.ListImages.Add , "Cancel", LoadResPicture(316, vbResBitmap)
    ImageList1.ListImages.Add , "Save", LoadResPicture(1145, vbResBitmap)
    ImageList1.ListImages.Add , "Help", LoadResPicture(396, vbResBitmap)
    ImageList1.ListImages.Add , "Exit", LoadResPicture(1118, vbResBitmap)


    With tlbTool
        .Buttons("print").Caption = "打印"
        .Buttons("print").Image = "print"
        .Buttons("print").ToolTipText = "Ctrl+P"
        
        .Buttons("preview").Caption = "预览"
        .Buttons("preview").Image = "preView"
        .Buttons("preview").ToolTipText = "Ctrl+V"
        
        .Buttons("Output").Caption = "输出"
        .Buttons("Output").Image = "Output"
        .Buttons("Output").ToolTipText = "Ctrl+O"
        
        .Buttons("Modi").Caption = "修改"
        .Buttons("Modi").Image = "Modi"
        '.Buttons("Modi").ToolTipText = "F12"
        .Buttons("Modi").ToolTipText = ""
        
        .Buttons("SelAll").Caption = "全选"
        .Buttons("SelAll").Image = "SelAll"
        .Buttons("SelAll").ToolTipText = "Ctrl+1"
        
        .Buttons("SelRow").Caption = "选择"
        .Buttons("SelRow").Image = "SelRow"
        .Buttons("SelRow").ToolTipText = "Ctrl+3"
        
        .Buttons("Unsel").Caption = "全消"
        .Buttons("Unsel").Image = "Unsel"
        .Buttons("Unsel").ToolTipText = "Ctrl+2"
        
        .Buttons("cancelSel").Caption = "取消"
        .Buttons("cancelSel").Image = "cancelSel"
        .Buttons("cancelSel").ToolTipText = "Ctrl+4"
        
        .Buttons("creClass").Caption = "等级"
        .Buttons("creClass").Image = "creClass"
        .Buttons("creClass").ToolTipText = "Alt+R"
        
        .Buttons("Cancel").Caption = "放弃"
        .Buttons("Cancel").Image = "Cancel"
        .Buttons("Cancel").ToolTipText = "Ctrl+Z"
        
        .Buttons("Save").Caption = "保存"
        .Buttons("Save").Image = "Save"
        .Buttons("Save").ToolTipText = "F6"
        
        .Buttons("Help").Image = "Help"
        .Buttons("Help").Caption = "帮助"