-

VB开发的ERP系统

                     " and FactorCode='" & CheckFactor(Jsqte).FactorCode & "'" & _
                     " and ValListCode='" & Trim(CxbbGrid.TextMatrix(int_row, Sydz("001", GridStr(), Szzls))) & "'" & _
                     " and Empid= " & int_EmpID & _
                     " and TotalType=2"

            Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not Rec_Query.EOF Then
                '填充考核要素分值
                If Rec_Query.Fields("ObjectTotal") > 0 Then
                    CxbbGrid.TextMatrix(int_row, Jsqte) = Format(Rec_Query.Fields("ObjectTotal"), str_format)
                End If
            End If

        Next Jsqte
        
        '读取有效票数和合计分值
        Sqlstr = " SELECT ObjectBallot,ObjectTotal  From Kh_BaseTotal " & _
                 " Where TitleCode='" & str_TitleCode & "'" & _
                 " and ValListCode='" & Trim(CxbbGrid.TextMatrix(int_row, Sydz("001", GridStr(), Szzls))) & "'" & _
                 " and Empid= " & int_EmpID & _
                 " and TotalType=4"

        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Not Rec_Query.EOF Then
            If (Rec_Query.Fields("ObjectBallot")) > 0 Then
                CxbbGrid.TextMatrix(int_row, CxbbGrid.Cols - 1 - 1) = Rec_Query.Fields("ObjectBallot")                           '有效票数
            End If
            If (Rec_Query.Fields("ObjectTotal")) > 0 Then
                CxbbGrid.TextMatrix(int_row, CxbbGrid.Cols - 1 - 0) = Format(Rec_Query.Fields("ObjectTotal"), str_format)       '合计
            End If
        End If

    Next int_row
    
    '填充合计行数据
    For Jsqte = CxbbGrid.FixedCols To CxbbGrid.Cols - 1 - 2
    
        CxbbGrid.Cell(flexcpBackColor, CxbbGrid.Rows - 1, Jsqte) = &HF7F3EC
        '读取考核要素分值
        Sqlstr = " SELECT ObjectTotal  From Kh_BaseTotal " & _
                 " Where TitleCode='" & str_TitleCode & "'" & _
                 " and FactorCode='" & CheckFactor(Jsqte).FactorCode & "'" & _
                 " and Empid= " & int_EmpID & _
                 " and TotalType=1"

        Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Not Rec_Query.EOF Then
            '填充考核要素分值
            If Rec_Query.Fields("ObjectTotal") > 0 Then
                CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, Jsqte) = Format(Rec_Query.Fields("ObjectTotal"), str_format)
            End If
        End If

    Next Jsqte
        
    CxbbGrid.Cell(flexcpBackColor, CxbbGrid.Rows - 1, CxbbGrid.Cols - 1 - 1) = &HF7F3EC
    CxbbGrid.Cell(flexcpBackColor, CxbbGrid.Rows - 1, CxbbGrid.Cols - 1 - 0) = &HF7F3EC
    
    '读取有效票数和合计分值
    Sqlstr = " SELECT  ObjectTotal  , ObjectBallot " & _
             "   From  Kh_Object " & _
             "  where  Kh_Object.TitleCode='" & str_TitleCode & "'" & _
             "    and  EmpID=" & int_EmpID

    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not Rec_Query.EOF Then
        If (Rec_Query.Fields("ObjectBallot")) > 0 Then
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, CxbbGrid.Cols - 1 - 1) = Rec_Query.Fields("ObjectBallot")                          '有效票数
        End If
        If (Rec_Query.Fields("ObjectTotal")) > 0 Then
            CxbbGrid.TextMatrix(CxbbGrid.Rows - 1, CxbbGrid.Cols - 1 - 0) = Format(Rec_Query.Fields("ObjectTotal"), str_format)       '合计
        End If
    End If
    
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide

    
End Sub



Private Sub Form_Resize()
    On Error Resume Next

    With Pic_Title
      .Width = Me.Width - 160
    End With
    
    '设置 height 属性
    TreeView.Height = Me.Height - TreeView.Top - 400
    
    imgSplitter.Top = TreeView.Top
    imgSplitter.Left = TreeView.Left + TreeView.Width
    imgSplitter.Height = TreeView.Height
    
    With CxbbGrid
      .Left = imgSplitter.Left + 40
      .Width = Me.Width - (imgSplitter.Left + 160)   'Me.Width - 160
      .Height = Me.Height - .Top - 400
    End With
    

    GsToolbar.Left = Me.Width - GsToolbar.Width - 160
   
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
    
    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl

End Sub


'*******************以下区域为编写自定义过程区域**********************
Private Sub Imgcbo_Title_Click()
    int_EmpID = -1
    str_TitleCode = GetComboKey(Imgcbo_Title, 0)
    Call ShowFormat
    str_titleRoot = Mid(str_TitleCode, 1, int_titleRootlen)
    Add_Tree
    '添加列标题
    Call Sub_AddCol
End Sub
Private Function AddTitleCode()
    Dim RecExist As New Recordset
    
    FillImageCombo Imgcbo_Title, "Khgl_TitleAnalyze", 1
    
  
    Sqlstr = "SELECT TitleCode,titleName From Kh_Title where (endflag=1 and ComputeFlag=1 and CreateTime=(select max(createTime) from kh_title where endflag=1 and ComputeFlag=1))"
    Set RecExist = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecExist.EOF Then
        If Len(Trim(RecExist.Fields("titleName"))) > 0 Then
            Imgcbo_Title.Text = RecExist.Fields("titleName")
        End If
    End If
    
    str_TitleCode = GetComboKey(Imgcbo_Title, 0)

End Function
Private Sub ShowFormat()
    '设置考核数据显示格式
    Dim rec_format As New Recordset
    Dim str_sql As String
    str_sql = "select TitleDigit from Kh_Title where TitleCode='" & str_TitleCode & "'"
    Set rec_format = Cw_DataEnvi.DataConnect.Execute(str_sql)
    If Not rec_format.EOF Then
        str_format = "########" + "." + String(rec_format.Fields("TitleDigit"), "0")
    End If
    rec_format.Close
End Sub

'*******************以上区域为编写自定义过程区域**********************



'******************以下为基本处理程序(固定不变)************************'

Private Sub Add_Tree() '添加树项
    Dim aDo_Sort As New Recordset
    Dim str_DeptCode  As String  '加入接点时的部门号
    Dim Sqlstr As String         '临时字符串
    
    Sqlstr = "SELECT TitleCode, EmpID, EmpNo,EmpName,DeptCode,DeptName from Kh_v_Object where TitleCode='" & str_TitleCode & "' order by TitleCode,DeptCode"
    TreeView.Nodes.Clear
    TreeView.Nodes.Add , 4, "T", "被考核对象", "T"
    Set aDo_Sort = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With aDo_Sort
        str_DeptCode = ""
        Do While Not .EOF
            
            If Trim(str_DeptCode) <> Trim(.Fields("DeptCode")) Then
                Set nodX = TreeView.Nodes.Add("T", 4, "!" & Trim(.Fields("DeptCode")) & "", Trim(.Fields("DeptName")) & "", "Cl")
                    nodX.Tag = "-1"
                '树形是否展开
                nodX.EnsureVisible
                
                Set nodX = TreeView.Nodes.Add("!" & Trim(.Fields("DeptCode")) & "", 4, "@" & Trim(.Fields("EmpNo")) & "", Trim(.Fields("EmpName")) & "", "C")
                    nodX.Tag = Trim(.Fields("EmpID"))
            Else
                Set nodX = TreeView.Nodes.Add("!" & Trim(.Fields("DeptCode")) & "", 4, "@" & Trim(.Fields("EmpNo")) & "", Trim(.Fields("EmpName")) & "", "C")
                    nodX.Tag = Trim(.Fields("EmpID"))
            End If

            
            str_DeptCode = .Fields("DeptCode")
            .MoveNext
        Loop

    End With

   
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True

End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim sglPos As Single
    If mbMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < sglSplitLimit Then
            picSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            picSplitter.Left = Me.Width - sglSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If

End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mbMoving = False

End Sub

Private Sub SizeControls(X As Single)
    
    On Error Resume Next

    '设置 Width 属性
    If X < 2000 Then X = 2000
    If X > (Me.Width - 5000) Then X = Me.Width - 5000
    TreeView.Width = X
    imgSplitter.Left = X
    CxbbGrid.Left = X + 40
    CxbbGrid.Width = Me.Width - (X + 40 + 160)

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
            Case "P"                                                                          'Ctrl+P 打印
                If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
                    Call bbyl(False)
                End If
        End Select
    End If

End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "ymsz"                                          '页面设置
            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
            
      Case "tx"                                              '图形
        Call Txfxbb(CxbbGrid, "Khgl_FactorAnalyze")
        
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select

End Sub

Private Sub CxbbGrid_AfterMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
    FnBln_RefreshArray Col, Position, GridStr(), GridInf()
End Sub


Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)
    
    Select Case Button.Key
        Case "bcgs"                                       '保存表格格式
            Call Bcwggs(CxbbGrid, GridCode, GridStr())
        Case "hfmrgs"                                     '恢复默认格式
            Call Hfmrgs(CxbbGrid, GridCode, GridStr())
        'Case "szxsxm"                                     '设置显示项目
            'Call Szxsxm(CxbbGrid, GridCode)
    End Select

End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 2                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    
    Bbxbt(2) = Fun_FormatOutPut("考核类别:" + Imgcbo_Title.Text, 30) + Fun_FormatOutPut(TsLabel(1).Caption, 30)
    bbxbtzzxs(2) = 0                                    '居左
    
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If

End Sub

Private Sub TreeView_Expand(ByVal Node As MSComctlLib.Node)
    
    If Node.Index <> 1 And Node.Key <> "T" Then
        Node.Image = "O"
    End If

End Sub

Private Sub TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    int_EmpID = Val(Node.Tag)
    If int_EmpID > 0 Then
        TsLabel(1).Caption = "被考核对象:" + Node.Text
        '填 充 网 格
        Call Sub_Query
    Else
        TsLabel(1).Caption = "被考核对象:"
    End If
End Sub