frmcheckchart.frm

这是本人用vb配合access数据库开发的一个部门人事管理的一个小软件的源码。

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmCheckChart 
   Caption         =   "CO PL Check Total Table"
   ClientHeight    =   6735
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9315
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6735
   ScaleWidth      =   9315
   Begin VB.CommandButton Command2 
      Caption         =   "print "
      Height          =   495
      Left            =   2280
      TabIndex        =   3
      Top             =   240
      Width           =   1455
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Create Chart"
      Height          =   495
      Left            =   480
      TabIndex        =   2
      Top             =   240
      Width           =   1455
   End
   Begin MSFlexGridLib.MSFlexGrid msgList 
      Height          =   4815
      Left            =   840
      TabIndex        =   0
      Top             =   1080
      Width           =   7815
      _ExtentX        =   13785
      _ExtentY        =   8493
      _Version        =   393216
      BackColor       =   8454016
      BackColorFixed  =   8454143
      BackColorBkg    =   12632256
   End
   Begin VB.Label lblTitle 
      Caption         =   "CO PL Check Total Table"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   855
      Left            =   480
      TabIndex        =   1
      Top             =   120
      Width           =   7335
   End
End
Attribute VB_Name = "frmCheckChart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mrc As ADODB.Recordset
Public txtSQL As String
Public MsgText As String

Private Sub Command1_Click()
    frmChart1.Show
    frmChart1.ZOrder 0
End Sub

Private Sub Command2_Click()
    
    frmPrint.Show
    frmPrint.ZOrder 0
    frmPrint.PrintContent
End Sub

Private Sub Form_Load()
    ShowTitle
    Showdata
     'CO PL Check Total Table
        txtSQL = "select * from BaseCheckTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        lblTitle.Caption = "CO PL Check Total Table of " & mrc.Fields(0) & "(This month's base work time is " & mrc.Fields(1) & "days*8h" & " = " & mrc.Fields(2) & " hours )"
        
        mrc.Close
   
    flagEdit = True
End Sub

Private Sub Form_Resize()
    
    If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
        '边界处理
        If Me.ScaleHeight < 10 * lblTitle.Height Then
            
            Exit Sub
        End If
        If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
            
            Exit Sub
        End If
        '控制控件的位置
        
        
        lblTitle.Top = lblTitle.Height
        lblTitle.Left = (Me.Width - lblTitle.Width) / 2
        
        msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
        msgList.Width = Me.ScaleWidth - 200
        msgList.Left = Me.ScaleLeft + 100
        msgList.Height = Me.ScaleHeight - msgList.Top - 200
    End If
    
    
End Sub



Public Sub FormClose()
    flagEdit = False
    Unload Me
End Sub


Public Function RecordCount(ByVal mrc As ADODB.Recordset) As Integer
    Dim i As Integer
    i = 0
    If mrc.EOF Then
        RecordCount = 0
        Exit Function
    End If
    
    With mrc
    mrc.MoveFirst
        Do While Not .EOF
        i = i + 1
        .MoveNext
        Loop
        .MoveFirst
    End With
    RecordCount = i
End Function


'显示Grid的内容
Public Sub Showdata()
    Dim j As Integer
    Dim i As Integer
    Dim k As Integer
    Dim Sum As Single
    Dim Sumcol As Single
    Dim checkNo As Integer
    Dim employNo As Integer
    
    If Trim(txtSQL) = "" Then
        txtSQL = "select * from EmployeeCheckTable"
    End If
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    'mrc.MoveLast
    'checkNo = mrc.RecordCount
    'checkNo = RecordCount(mrc)
    If mrc.EOF = False Then
   
        mrc.Close
        With msgList
        
        txtSQL = "select Em_id,Em_name from EmployeeTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
         'mrc.MoveLast
        .Rows = mrc.RecordCount + 2
        employNo = mrc.RecordCount + 2
        
         mrc.Close
        '.Rows = 6
        
    '    If Trim(txtSQL) = "" Then
        txtSQL = "select * from EmployeeCheckTable"
     '    End If
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        checkNo = RecordCount(mrc)
       
       '显示综合表格内容
        For k = 1 To checkNo
        
            For i = 1 To (.Rows - 2)
        
            If mrc.Fields("Em_id") = .TextMatrix(i, 1) Then
                For j = 2 To (.Cols - 6)
                    If mrc.Fields("Pro_id") = .TextMatrix(0, j) Then
                    .TextMatrix(i, j) = mrc.Fields("Worktime")
                    End If
                Next j
                
                .TextMatrix(i, (.Cols - 5)) = mrc.Fields("Others")
                .TextMatrix(i, (.Cols - 4)) = mrc.Fields("Leaving")
                .TextMatrix(i, (.Cols - 3)) = mrc.Fields("Overtime")
                .TextMatrix(i, (.Cols - 2)) = mrc.Fields("Errand")
              '  .TextMatrix(i, (.Cols - 1)) = Val(.TextMatrix(i, (.Cols - 5))) + Val(.TextMatrix(i, (.Cols - 2)))
                '计算每个员工的总工作时间
                Sum = 0
    
                     For j = 2 To (.Cols - 6)
                         Sum = Sum + Val(.TextMatrix(i, j))
                      'Sum = Sum + .TextMatrix(i, j)
                     Next j
                         Sum = Sum + Val(.TextMatrix(i, (.Cols - 5))) + Val(.TextMatrix(i, (.Cols - 3))) + Val(.TextMatrix(i, (.Cols - 2))) - Val(.TextMatrix(i, (.Cols - 4)))
                       '   Sum = Sum + .TextMatrix(i, (.Cols - 5)) + .TextMatrix(i, (.Cols - 3)) + .TextMatrix(i, (.Cols - 2)) - .TextMatrix(i, (.Cols - 4))
                 .TextMatrix(i, (.Cols - 1)) = Sum
                 
            'mrc.MoveNext
            End If
        
            Next i
        mrc.MoveNext
        Next k
    '    mrc.MoveLast
        
      '   MsgBox mrc.Fields("Worktime")
         
         '显示每列的总和
         
         
         For i = 2 To (.Cols - 1)
         Sumcol = 0
             For j = 1 To (employNo - 1)
         
                 Sumcol = Sumcol + Val(.TextMatrix(j, i))
            Next j
         .TextMatrix((employNo - 1), i) = Sumcol
         Next i
         
         
         
     '   MsgBox mrc.Fields("Em_name")
        
       ' Do While Not mrc.EOF
         '  .Rows = .Rows + 1
        '   For i = 1 To mrc.Fields.Count
        '        Select Case mrc.Fields(i - 1).Type
        '            Case adDBDate
        '                .TextMatrix(1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
        '            Case Else
       '                 .TextMatrix(1, i) = mrc.Fields(i - 1) & ""
        '        End Select
        '    Next i
        '    mrc.MoveNext
       ' Loop
        End With
  End If
    mrc.Close
End Sub


'显示Grid表头
Public Sub ShowTitle()
    Dim i As Integer
    
    With msgList
    
        txtSQL = "select Pro_name from ProjectTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
         
        .Cols = mrc.RecordCount + 7
        .TextMatrix(0, 0) = "ID"
        .TextMatrix(0, 1) = "Name"
        
        For i = 1 To mrc.RecordCount
                
             .TextMatrix(0, 1 + i) = mrc.Fields("Pro_name")
             mrc.MoveNext
            
                
        Next i
        .TextMatrix(0, (mrc.RecordCount + 2)) = "Others"
        .TextMatrix(0, (mrc.RecordCount + 3)) = "LeaveHours"
        .TextMatrix(0, (mrc.RecordCount + 4)) = "OverHours"
        .TextMatrix(0, (mrc.RecordCount + 5)) = "ErrandHours"
        .TextMatrix(0, (mrc.RecordCount + 6)) = "TotalHours"
     
     mrc.Close
     
     
     
     With msgList
     
     txtSQL = "select Em_id,Em_name from EmployeeTable"
     Set mrc = ExecuteSQL(txtSQL, MsgText)
     
     .Rows = mrc.RecordCount + 2
    ' .Col = 0
     For i = 1 To .Rows - 2
         
    '  .Row = i
   
      .TextMatrix(i, 0) = mrc.Fields("Em_id")
      .TextMatrix(i, 1) = mrc.Fields("Em_name")
       mrc.MoveNext
      
     Next i
   '  mrc.MoveNext
     .TextMatrix(.Rows - 1, 0) = "CO PL"
     .TextMatrix(.Rows - 1, 1) = "Total Hours"
      
    End With
    mrc.Close
     
  '       .TextMatrix(1, 0) = "ID"
  '       .TextMatrix(2, 0) = "Name"
  '       .TextMatrix(3, 0) = "Depetment"
       '  .TextMatrix(4, 0) = "Gender"
      '   .TextMatrix(5, 0) = "Title"
      '   .TextMatrix(6, 0) = "Remark"
        
        '固定表头
        .FixedRows = 1
        .FixedCols = 1
        
        txtSQL = "select Pro_name from ProjectTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
                
        '设置各列的对齐方式
        For i = 0 To (mrc.RecordCount + 6)
          .ColAlignment(i) = 0
        Next i
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .Col = 0
        .Row = 0
        .RowSel = .Rows - 1
        .ColSel = .Cols - 1
     '   .ColSel = 8
        .CellAlignment = 4
        
        '设置字体颜色
      '  .Col = mrc.RecordCount
       ' .BackColor = 254
        
        '设置单元大小
        .ColWidth(0) = 700
        .ColWidth(1) = 1500
        
        For i = 1 To mrc.RecordCount
                
        .ColWidth(i + 1) = 1000
                
        Next i
        .ColWidth(mrc.RecordCount + 2) = 1000
        .ColWidth(mrc.RecordCount + 3) = 1000
        .ColWidth(mrc.RecordCount + 4) = 1000
        .ColWidth(mrc.RecordCount + 5) = 1000
        .ColWidth(mrc.RecordCount + 6) = 1000
    '    .ColWidth(7) = 1000
     '   .ColWidth(8) = 2000
      '  .ColWidth(9) = 1200
      '  .ColWidth(10) = 1000
      '  .ColWidth(11) = 1200
      '  .ColWidth(12) = 1000
      '  .ColWidth(13) = 1200
      '  .ColWidth(14) = 3000
      '  .ColWidth(15) = 1000
      '  .ColWidth(16) = 1200
      '  .ColWidth(17) = 1000
      '  .ColWidth(18) = 1000
      '  .ColWidth(19) = 1000
     '   .ColWidth(20) = 1000
        .Row = 1
    End With
    mrc.Close
End Sub




Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    '右键弹出
   ' If Button = 2 And Shift = 0 Then
   '     PopupMenu fMainForm.menuManrecord
  '  End If
    
    
End Sub