评价模型.frm

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

    End With
End Sub
'装载数据库数据到supergrid
Private Sub Loaddatatosg()
    Dim sqlstr As String
    Dim rs As New ADODB.Recordset
    Dim i, j, k, m As Integer
    SuperGrid1.Enabled = True
    '定义数组长度为评价指标数目
    rs.Open "select Distinct itemName From FD_creEvaPara order by itemName ", con
    If rs.RecordCount > 0 Then
        m = rs.RecordCount
        ReDim creData(m - 1, 10)
    Else
        m = 0
        ReDim creData(0, 10)
    End If
    rs.Close
    If m > 0 Then
        SuperGrid1.Rows = m + 1
        '先将定量指标显示出来
        sqlstr = "select * from FD_creEvaPara Where Itemtype=1 order by itemName"
        rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
        i = rs.RecordCount - 1
        j = 0
        While Not (rs.EOF Or rs.BOF)
            If Not IsNull(rs("selFlag")) Then
                If rs("selFlag") Then
                    creData(j, 0) = "Y"
                Else
                    creData(j, 0) = ""
                End If
            Else
                creData(j, 0) = ""
            End If
            creData(j, 1) = IIf(IsNull(rs("itemName")), "", rs("itemName"))
            creData(j, 2) = "定量指标"
            creData(j, 3) = IIf(IsNull(rs("calFormu")), "", rs("calFormu"))
            creData(j, 4) = Format(IIf(IsNull(rs("stanvalue")), 0, rs("stanvalue")), "#0.00")
            If IsNull(rs("stanMark")) Then
                creData(j, 5) = ""
            Else
                creData(j, 5) = Format(rs("stanMark"), "#0.00")
            End If
            creData(j, 6) = CStr(IIf(IsNull(rs("calMarkFormu")), "", rs("calMarkFormu")))
            If IsNull(rs("Memo")) Then
                creData(j, 7) = ""
            Else
                creData(j, 7) = CStr(IIf(IsNull(rs("memo")), "", rs("memo")))
            End If
            
            '保存itemID信息
            creData(j, 8) = rs("itemID")
            
            rs.MoveNext
            '保存数组位置信息
            j = j + 1
        Wend
        rs.Close
        '显示定性指标
        Dim rs1 As New ADODB.Recordset
        sqlstr = "select Distinct ItemName,min(itemID) from FD_creEvaPara Where Itemtype=0 group by itemName order by itemName"
        rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
        While Not (rs.EOF Or rs.BOF)
                
                creData(j, 1) = IIf(IsNull(rs(0)), "", rs(0))
                sqlstr = "select selflag , standarD , quaMark , stanMark ,memo  from FD_creEvaPara Where itemName='" & creData(j, 1) & "'"
                rs1.Open sqlstr, con, adOpenDynamic, adLockOptimistic
                i = rs1.RecordCount
                If Not IsNull(rs1("selflag")) Then
                    If rs1("selFlag") Then
                        creData(j, 0) = "Y"
                    Else
                        creData(j, 0) = ""
                    End If
                Else
                    creData(j, 0) = ""
                End If
                creData(j, 2) = "定性指标"
                k = 1
                If IsNull(rs1("stanMark")) Then
                    creData(j, 5) = ""
                Else
                    creData(j, 5) = Format(rs1("stanMark"), "#0.00")
                End If
                creData(j, 3) = ""
                creData(j, 6) = ""
                '组合定性指标
                While (Not rs1.EOF Or rs1.BOF)
                    If IsNull(rs1("memo")) Then
                        creData(j, 7) = ""
                    Else
                        creData(j, 7) = rs1("memo")
                    End If
                    
                    If k < i Then
                        creData(j, 3) = creData(j, 3) & "0" & k & "," & IIf(IsNull(rs1("Standard")), "", rs1("Standard")) & ";"
                        creData(j, 6) = creData(j, 6) & "0" & k & "," & IIf(IsNull(rs1("quaMark")), "", rs1("quaMark")) & ";"
                    Else
                        creData(j, 3) = creData(j, 3) & "0" & k & "," & IIf(IsNull(rs1("Standard")), "", rs1("Standard"))
                        creData(j, 6) = creData(j, 6) & "0" & k & "," & IIf(IsNull(rs1("quaMark")), "", rs1("quaMark"))
                    End If
                    rs1.MoveNext
                    k = k + 1
                Wend
                rs1.Close
            
                '保存itemID信息
                creData(j, 8) = rs(1)
            
                rs.MoveNext
                j = j + 1
            Wend
            rs.Close
        Else
            SuperGrid1.Rows = 2
            For j = 0 To 7
                creData(0, j) = ""
            Next
            With tlbTool
                .Buttons("print").Enabled = False
                .Buttons("preview").Enabled = False
                .Buttons("Output").Enabled = False
                .Buttons("SelAll").Enabled = False
                .Buttons("Unsel").Enabled = False
                .Buttons("SelRow").Enabled = False
                .Buttons("cancelSel").Enabled = False
                .Buttons("Modi").Enabled = False
                .Buttons("Cancel").Enabled = False
                .Buttons("Save").Enabled = False
                .Buttons("creClass").Enabled = True
                .Buttons("Help").Enabled = True
                .Buttons("Exit").Enabled = True
            End With
            SuperGrid1.ReadOnly = True
            cmdUp.Enabled = False
            CmdDown.Enabled = False
            'rs.Close
        End If
        '定义supergrid的行数
        SuperGrid1.WordWrap = True
        '填充supergrid
        fillGrid
    Call sgsize
    If m > 0 Then
        With tlbTool
            .Buttons("print").Enabled = True
            .Buttons("preview").Enabled = True
            .Buttons("Output").Enabled = True
            .Buttons("SelAll").Enabled = False
            .Buttons("Unsel").Enabled = False
            .Buttons("SelRow").Enabled = False
            .Buttons("cancelSel").Enabled = False
            .Buttons("Modi").Enabled = True
            .Buttons("Cancel").Enabled = False
            .Buttons("Save").Enabled = False
            .Buttons("creClass").Enabled = True
            .Buttons("Help").Enabled = True
            .Buttons("Exit").Enabled = True
        End With
    End If
    SuperGrid1.ReadOnly = True
    cmdUp.Enabled = False
    CmdDown.Enabled = False
    
End Sub

Private Sub Form_Resize()
    If credstat.modified Then
        SuperGrid1.ProtectUnload
    End If
    
    If Me.width > 300 Then
        Frame1.width = Me.width - 300
    End If
    If Me.Height > tlbTool.Height + 500 Then
        Frame1.Height = Me.Height - tlbTool.Height - 500
    End If
    Frame1.left = tlbTool.left + 100
    Frame1.top = tlbTool.top + tlbTool.Height + 200
    Frame1.top = tlbTool.top + tlbTool.ButtonHeight + 150
    SuperGrid1.top = 150
    SuperGrid1.left = 360
    If Frame1.Height > 200 Then
        SuperGrid1.Height = Frame1.Height - 200
    End If
    If Frame1.width > cmdUp.width + 200 Then
        SuperGrid1.width = Frame1.width - cmdUp.width - 200
    End If
    cmdUp.top = SuperGrid1.top + SuperGrid1.Height / 4
    CmdDown.top = cmdUp.top + cmdUp.Height + 100
    ResizeTlb Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim result As VbMsgBoxResult
        SuperGrid1.ProtectUnload

    If tlbTool.Buttons("Save").Enabled Then
        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
    End If
    If con.State = adStateOpen Then
        con.Close
    End If
    Set con = Nothing
'    If Not duplicate Then
        Call clear
        Call setUserSettings
'    End If
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 credstat.selRow >= 1 Then
    If SuperGrid1.TextMatrix(R, c) <> creData(R - 1, c) Then
    'If SuperGrid1.TextMatrix(credstat.selRow, credstat.selcol) <> creData(credstat.selRow - 1, credstat.selcol) Then
        credstat.modified = True
        tlbTool.Buttons("Cancel").Enabled = True
        tlbTool.Buttons("Save").Enabled = True
    End If
    If credstat.modified Then
        If Not IsNumeric(SuperGrid1.TextMatrix(R, c)) Then
        'If Not isnumber(SuperGrid1.TextMatrix(SuperGrid1.Row, SuperGrid1.Col)) Then
            MsgBox "该项输入必须为数字！", vbInformation, "输入错误"
        End If
    End If
End If

End Sub

'
Private Sub SuperGrid1_Click()
    credstat.selRow = SuperGrid1.row
    credstat.selcol = SuperGrid1.col
    If SuperGrid1.row <= 1 Then
        cmdUp.Enabled = False
        CmdDown.Enabled = True
    ElseIf SuperGrid1.row = SuperGrid1.Rows - 1 Then
        cmdUp.Enabled = True
        CmdDown.Enabled = False
    Else
        cmdUp.Enabled = True
        CmdDown.Enabled = True
    End If
    
    If SuperGrid1.col = 5 And credstat.modified Then
        SuperGrid1.ReadOnly = False
    Else
        SuperGrid1.ReadOnly = True
    End If
    
    If credstat.modified Then
        If SuperGrid1.TextMatrix(SuperGrid1.row, 0) = "Y" Then
            tlbTool.Buttons("SelRow").Enabled = False
            tlbTool.Buttons("cancelSel").Enabled = True
        Else
            tlbTool.Buttons("SelRow").Enabled = True
            tlbTool.Buttons("cancelSel").Enabled = False
        End If
    End If
    ocxCtbTool.RefreshEnable
End Sub
'双击表单表示选中
Private Sub SuperGrid1_DblClick()
'MsgBox SuperGrid1.MouseCol
    
    If credstat.modified Then
        If SuperGrid1.col = 1 And SuperGrid1.row > 0 Then
            If SuperGrid1.TextMatrix(SuperGrid1.row, 0) <> "Y" Then
                SuperGrid1.TextMatrix(SuperGrid1.row, 0) = "Y"
                'credstat.modified = True
                tlbTool.Buttons("SelRow").Enabled = False
                tlbTool.Buttons("cancelSel").Enabled = True
            Else
                SuperGrid1.TextMatrix(SuperGrid1.row, 0) = ""
                'credstat.modified = True
                tlbTool.Buttons("SelRow").Enabled = True
                tlbTool.Buttons("cancelSel").Enabled = False
            End If
        End If
    End If
    
    If SuperGrid1.col = 5 And credstat.modified Then
        SuperGrid1.ReadOnly = False
    Else
        SuperGrid1.ReadOnly = True
    End If
    
    credstat.selRow = SuperGrid1.row
    credstat.selcol = SuperGrid1.col
    
    ocxCtbTool.RefreshEnable
End Sub

Private Sub SuperGrid1_RowColChange()
    If credstat.modified Then
        If SuperGrid1.TextMatrix(SuperGrid1.row, 0) = "Y" Then
            tlbTool.Buttons("SelRow").Enabled = False
            tlbTool.Buttons("cancelSel").Enabled = True
        Else
            tlbTool.Buttons("SelRow").Enabled = True
            tlbTool.Buttons("cancelSel").Enabled = False
        End If
    End If
    
    If credstat.ModifyState <> 0 Then
        'If SuperGrid1.Col <> 5 And SuperGrid1.Col <> 7 Then
        If SuperGrid1.col <> 5 Then
            SuperGrid1.ReadOnly = True
        Else
            SuperGrid1.ReadOnly = False
        End If
    End If
    
    If SuperGrid1.row = 1 Then
        If SuperGrid1.Rows > 2 Then
            cmdUp.Enabled = False
            CmdDown.Enabled = True
        Else
            cmdUp.Enabled = False
            CmdDown.Enabled = False
        End If
    ElseIf SuperGrid1.row = SuperGrid1.Rows - 1 Then
        If SuperGrid1.Rows > 2 Then
            cmdUp.Enabled = True
            CmdDown.Enabled = False
        Else
            cmdUp.Enabled = False
            CmdDown.Enabled = False
        End If
    Else
        cmdUp.Enabled = True
        CmdDown.Enabled = True
    End If

    credstat.selRow = SuperGrid1.row
    credstat.selcol = SuperGrid1.col
    
    ocxCtbTool.RefreshEnable