评价指标.frm

用友u8财务源码,用visual basic开发

    cmdoprLBracket.Enabled = True
    cmdoprRBracket.Enabled = False
    cmdComma.Enabled = True
End Sub
'添加记录的处理程序
Private Sub AddProc()
    Frame2.Enabled = True
    
    credstat.ModifyState = 1
    credstat.modified = True
    'set input formula frame component's state ready for input
    cmdReinp.Value = True
    Lastinput = ""
    oprcount = 0
    bL = 0
    str = ""
    strcalMark = ""
    ItemUsed.Visible = False
    Me.FraInpFormu.Visible = False
    
        'set textbox ready for input
        TxtcalFormula.Enabled = True
        TxtstanValue.Enabled = True
        TxtcalMarkFormu.Enabled = True
        TxtdlMemo.Enabled = True
        TxtcalFormula.Text = ""
        TxtstanValue.Text = ""
        TxtcalMarkFormu.Text = ""
        TxtdlMemo.Text = ""
''        Fradxzb.Visible = True
'        Fradxzb.Visible = False
'        Fradlzb.Visible = True
        dxItemSG1.clear
        dxItemSG1.Rows = 2
        dxItemSG1.Cols = 3
        dxItemSG1.ReadOnly = False
        Txtdxmemo.Enabled = True
        Txtdxmemo.Text = ""
'        Fradxzb.Visible = True
'        Fradlzb.Visible = False
        'sg.Rows = credstat.Dxzbsm + 1
        dxItemSG1.TextMatrix(0, 0) = "序号"
        dxItemSG1.TextMatrix(0, 1) = "标准"
        dxItemSG1.TextMatrix(0, 2) = "得分"
        dxItemSG1.TextMatrix(1, 0) = "01"
        dxItemSG1.SetColProperty 1, 12, BrowNull, EditNormal
        dxItemSG1.SetColProperty 2, 4, BrowNull, EditLng
        Me.FraInpFormu.Visible = False
    If credstat.ItemType = 1 Then
        Optdlzb.Value = True
    Else
        Optdxzb.Value = True
    End If

    TxtitemName.Text = ""
    TxtitemName.Enabled = True
    
    Call setModifyBtn
End Sub
 '修改记录的处理程序
Private Sub modifyproc()
    credstat.ModifyState = 2
    credstat.modified = True
    TxtitemName.Enabled = True
    If credstat.ItemType = 1 Then
        TxtcalFormula.Enabled = True
        TxtdlMemo.Enabled = True
    Else
        Txtdxmemo.Enabled = True
    End If
    If Not ItemUsed.Visible Then
        Frame2.Enabled = True
        If credstat.ItemType = 1 Then
            Optdlzb.Value = True
            TxtcalFormula.Enabled = True
            TxtstanValue.Enabled = True
            TxtcalMarkFormu.Enabled = True
            TxtdlMemo.Enabled = True
            str = Trim(TxtcalMarkFormu.Text)
            dxItemSG1.clear
            dxItemSG1.Rows = 2
            dxItemSG1.Cols = 3
            dxItemSG1.ReadOnly = False
            Txtdxmemo.Enabled = True
            Txtdxmemo.Text = ""
            dxItemSG1.TextMatrix(0, 0) = "序号"
            dxItemSG1.TextMatrix(0, 1) = "标准"
            dxItemSG1.TextMatrix(0, 2) = "得分"
            dxItemSG1.TextMatrix(1, 0) = "01"
            dxItemSG1.SetColProperty 1, 12, BrowNull, EditNormal
            dxItemSG1.SetColProperty 2, 4, BrowNull, EditLng
        Else
            Optdxzb.Value = True
            Fradxzb.Visible = True
            dxItemSG1.ReadOnly = False
            Txtdxmemo.Enabled = True
            TxtcalFormula.Text = ""
            TxtstanValue.Text = ""
            TxtcalMarkFormu.Text = ""
            TxtdlMemo.Text = ""
        End If
    End If
    With tlbTool
        .Buttons("Add").Enabled = False
        .Buttons("Modify").Enabled = False
        .Buttons("Delete").Enabled = False
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        If Not credstat.ItemType Then
            .Buttons("addColumn").Visible = True
            .Buttons("delColumn").Visible = True
        
            .Buttons("addColumn").Enabled = False
            .Buttons("delColumn").Enabled = False
        End If
        .Buttons("Exit").Enabled = True
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
    End With
    setModifyBtn
End Sub

'保存数据到数据库
Private Sub saveProc()
    If SaveData Then
        ItemName = Trim(TxtitemName.Text)
        Call setdata
        Call setQueryState
        setTreeview
        TreeView1.Enabled = True
'        cmdReinp.Value = True

        str = ""
        strcalMark = ""
        bL = 0
        Lastinput = ""
        str = ""
        Lastchar = ""
        oprcount = 0
        strcalMark = ""
        cpara(0) = "实际值"
        cpara(1) = "标准值"
        cpara(2) = "标准分"
        epara(0) = "realValue"
        epara(1) = "stanValue"
        epara(2) = "stanMark"
        
        Lastinput = ""
        oprcount = 0
        bL = 0
        str = ""
        strcalMark = ""
    End If
End Sub
'Function SaveData() As Boolean
'    Dim Con As New ADODB.Connection
'    Dim rs As New ADODB.Recordset
'    On Error GoTo Erro0
'    Con.Open zjLogInfo.UfDbName
'    If credstat.ModifyState = 2 Then
'        If credstat.ItemType = 1 Then
'            rs.Open "select * From FD_CreEvaPara WHERE itemName=" & "'" & credstat.itemName & "'", Con, adOpenDynamic, adLockOptimistic
'            rs("itemName") = TxtitemName.Text
'            rs("calFormu") = TxtcalFormula.Text
'            rs("stanValue") = TxtstanValue.Text
'            rs("calmarkformu") = TxtcalMarkFormu.Text
'            rs("calmarkformu1") = strcalMark
'            rs("memo") = TxtdlMemo.Text
'        Else
'            rs.Open "select * From FD_creEvaPara Where itemName=" & "'" & credstat.itemName & "'", Con, adOpenDynamic, adLockOptimistic
'            rs.MoveFirst
'            Dim i As Integer
'            For i = 0 To credstat.Dxzbsm - 1
'                rs("itemName") = TxtitemName.Text
'                rs("standard") = dxItemSG1.TextMatrix(i + 1, 1)
'                rs("quaMark") = dxItemSG1.TextMatrix(i + 1, 2)
'                rs("memo") = Txtdxmemo.Text
'                rs.MoveNext
'            Next
'        End If
'    End If
'    If credstat.ModifyState = 1 Then
'        If credstat.ItemType = 1 Then
'            rs.Open "select * From FD_CreEvaPara", Con, adOpenDynamic, adLockOptimistic
'            ' WHERE itemName=" & "'" & credstat.itemName & "'", con, adOpenDynamic, adLockOptimistic
'            rs.AddNew
'            rs("itemName") = TxtitemName.Text
'            rs("itemtype") = 1
'            rs("calFormu") = TxtcalFormula.Text
'            rs("stanValue") = TxtstanValue.Text
'            rs("calmarkformu") = TxtcalMarkFormu.Text
'            rs("calmarkformu1") = strcalMark
'            rs("memo") = TxtdlMemo.Text
'        Else
'            rs.Open "select * From FD_creEvaPara", Con, adOpenDynamic, adLockOptimistic
'            ' Where itemName=" & "'" & credstat.itemName & "'", con, adOpenDynamic, adLockOptimistic
'           ' Dim i As Integer
'            For i = 1 To dxItemSG1.Rows - 1
'                rs.AddNew
'                rs("itemName") = TxtitemName.Text
'                rs("itemtype") = 0
'                rs("standard") = dxItemSG1.TextMatrix(i, 1)
'                rs("quaMark") = dxItemSG1.TextMatrix(i, 2)
'                rs("memo") = Txtdxmemo.Text
'            Next
'        End If
'    Else
'             rs.Open "select * From FD_creEvaPara", Con, adOpenDynamic, adLockOptimistic
'            ' Where itemName=" & "'" & credstat.itemName & "'", con, adOpenDynamic, adLockOptimistic
'           ' Dim i As Integer
'            i = dxItemSG1.Rows - 1
'                rs.AddNew
'                rs("itemName") = TxtitemName.Text
'                rs("itemtype") = 0
'                rs("standard") = dxItemSG1.TextMatrix(i, 1)
'                rs("quaMark") = dxItemSG1.TextMatrix(i, 2)
'                rs("memo") = Txtdxmemo.Text
'    End If
'
'
'    rs.UpdateBatch
'    rs.Close
'    Set rs = Nothing
'    Con.Close
'    Set Con = Nothing
'    SaveData = True
'    Exit Function
'Erro0:  SaveData = False
'End Function

'保存记录处理程序
Function SaveData() As Boolean
    If Not ItemNameCheck Then
        SaveData = False
        Exit Function
    End If
    If credstat.ItemType = 1 Then
        If Not dlzbCheck Then
            SaveData = False
            Exit Function
        Else
            If saveDlzb Then
                'MsgBox "数据保存成功！", vbInformation, "保存数据"
            Else
                MsgBox "保存数据操作失败！请重试或取消！"
                SaveData = False
                Exit Function
            End If
        End If
    Else
        If Not DxzbCheck Then
            SaveData = False
            Exit Function
        Else
            If saveDxzb Then
                'MsgBox "数据保存成功！", vbInformation, "保存数据"
            Else
                MsgBox "保存数据操作失败！", vbInformation, "保存数据"
                SaveData = False
                Exit Function
            End If
        End If
    End If
        SaveData = True
End Function

'取消操作
Private Sub CancelProc()
    If credstat.ModifyState = 2 Then
        If credstat.ItemType = 1 Then
            TxtitemName.Text = credstat.ItemName
            TxtcalFormula.Text = credstat.dlzbitem(0)
            
            If credstat.dlzbitem(1) <> "" Then
                TxtstanValue.Text = Format(credstat.dlzbitem(1), "#0.00")
            Else
                TxtstanValue.Text = ""
            End If
            TxtcalMarkFormu.Text = credstat.dlzbitem(2)
            FraInpFormu.Visible = False
        Else
            TxtitemName.Text = credstat.ItemName
            Call LoadArrayToGrid(credstat, dxItemSG1)
        End If
    ElseIf credstat.ModifyState = 1 Then
        If credstat.ItemType = 1 Then
            TxtitemName.Text = ""
            TxtcalFormula.Text = ""
            TxtstanValue.Text = ""
            TxtcalMarkFormu.Text = ""
            FraInpFormu.Visible = False
            TxtdlMemo.Text = ""
        'Else
            TxtitemName.Text = ""
            dxItemSG1.clear
            Txtdxmemo.Text = ""
        End If
    End If
    Call setQueryState
    setNoItemState
End Sub
'增行操作
Private Sub addColumnProc()
    Dim coldiscolor() As Long
    TreeView1.Enabled = False
    credstat.modified = True
    'credstat.ModifyState = 3
    If dxItemSG1.Rows < 10 Then
        credstat.selRow = dxItemSG1.Rows
        dxItemSG1.AddRecord "0" & dxItemSG1.Rows, coldiscolor()
    Else
        If dxItemSG1.Rows = 10 Then
            dxItemSG1.AddRecord "10", coldiscolor()
        Else
            MsgBox "该指标基准数不能超过10！", vbCritical, "输入错误"
            tlbTool.Buttons("addColumn").Enabled = False
            Exit Sub
        End If
    End If
    Call setaddColBtn
End Sub
Private Sub setaddColBtn()
    With tlbTool
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("Output").Enabled = False
        .Buttons("Add").Enabled = False
        .Buttons("Modify").Enabled = False
        .Buttons("Delete").Enabled = False
        .Buttons("addColumn").Enabled = False
        .Buttons("delColumn").Enabled = False
        .Buttons("Cancel").Enabled = True
        .Buttons("Save").Enabled = True
        .Buttons("Help").Enabled = True
        .Buttons("Exit").Enabled = True
    End With
End Sub
'删行操作
Private Sub delColumnProc()
    Dim i, j As Integer
    Dim ReturnValue As VbMsgBoxResult
    Dim b As Boolean
    Dim sqlstr As String
    On Error GoTo error0
    'credstat.ModifyState = 3
    If credstat.ModifyState = 1 Then
        credstat.ItemName = Trim(TxtitemName.Text)
    End If
    If credstat.selRow <> 0 Then
    ReturnValue = MsgBox("该操作将删除所选行的数据，确定需要删除吗？", vbYesNo, "删除数据")
        Select Case ReturnValue
            Case vbYes
                    If dxItemSG1.Rows = 2 Then
'                        If Trim(dxItemSG1.TextMatrix(credstat.selRow, 1)) = "" And Trim(dxItemSG1.TextMatrix(credstat.selRow, 2)) = "" Then
'                            MsgBox "表中已无数据！", vbInformation, "删除该行信息"
'                            b = False
'                            Exit Sub
'                        Else
                            If MsgBox("该操作将删除所选指标，确定需要删除吗？", _
                                    vbYesNo, "删除数据") = vbYes Then
                                sqlstr = "delete from Fd_creEvaPara where itemName='" & credstat.ItemName & "';"
                                con.BeginTrans
                                con.Execute sqlstr
                                con.CommitTrans
                               b = True
                                credstat.modified = False
                                Call SetdeleteState
                                'copyDxzbToarray credstat
                                'LoadArrayToGrid credstat, dxItemSG1