frmcheckinfo.frm

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

            '        msgList.Row = msgList.Row - 1
            '    Else
           '         msgList.Row = t04
           '     End If
      '      Else
     '           If msgList.Row > msgList.TopRow Then
     '               msgList.Row = msgList.Row - 1
     '           ElseIf msgList.Row = msgList.TopRow And msgList.Row <> 1 Then
     '               msgList.Row = msgList.Row - 1
     '               msgList.TopRow = msgList.TopRow - 1
     '           Else
     '           msgList.Row = t04
     '           rownum = 10
     '           colnum = 1 '防止最后一行回车后，跳转到第十行，而应该跳到第一行
     '           msgList.TopRow = t04
     '           End If
     '       End If
     
            If msgList.Row > msgList.TopRow Then
                msgList.Row = msgList.Row - 1
            Else
                msgList.Row = 1
            End If
     
            colnum = 1
            rownum = msgList.Row - msgList.TopRow + 1
            Text1.Text = msgList.Text
            Text1.Left = msgList.Left + (msgList.ColWidth(0) + msgList.GridLineWidth * 12) * colnum
            If rownum < 5 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 3) * rownum
        ElseIf rownum >= 5 And rownum < 7 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 20) * rownum
            ElseIf rownum >= 7 And rownum < 10 Then
                Text1.Top = msgList.Top + (msgList.RowHeight(0) - 30) * rownum
                ElseIf rownum >= 10 And rownum < 17 Then
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 35) * rownum
                Else
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 40) * rownum
        End If
    Exit Sub

        Case 40 '光标向下
        
        'If t04 < 11 Then
        '    If msgList.Row Then
        '        msgList.Row = msgList.Row + 1
        '    Else
        '    msgList.Row = 1
        '    End If
  '      Else
  '      If msgList.Row Then
  '          msgList.Row = msgList.Row + 1
  '      ElseIf msgList.Row <> t04 And msgList.Row = msgList.TopRow + 10 - 1 Then
  '          msgList.Row = msgList.Row + 1
  '          msgList.TopRow = msgList.TopRow + 1
  '          Else
   '         msgList.Row = 1
  '          rownum = 1
   '         colnum = 1 '防止最后一行回车后，跳转到第十行，而应该跳到第一行
  '          msgList.TopRow = 1
  '          End If
  '      End If
  
        If msgList.Row < msgList.Rows - 1 Then
            msgList.Row = msgList.Row + 1
        Else
            msgList.Row = 1
        End If
  
        colnum = 1
        rownum = msgList.Row - msgList.TopRow + 1
        Text1.Text = msgList.Text
        Text1.Left = msgList.Left + (msgList.ColWidth(0) + msgList.GridLineWidth * 12) * colnum
        If rownum < 5 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 3) * rownum
        ElseIf rownum >= 5 And rownum < 7 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 20) * rownum
            ElseIf rownum >= 7 And rownum < 10 Then
                Text1.Top = msgList.Top + (msgList.RowHeight(0) - 30) * rownum
                ElseIf rownum >= 10 And rownum < 17 Then
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 35) * rownum
                Else
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 40) * rownum
        End If
    Exit Sub
    
        Case 13 '回车
        
       ' If t04 < 11 Then
       '     If msgList.Row Then msgList.Row = msgList.Row + 1
       '     Else
        '    msgList.Row = 1
       '     End If
       ' Else
       '     If msgList.Row Then msgList.Row = msgList.Row + 1
       '     ElseIf msgList.Row <> t04 And msgList.Row = msgList.TopRow + 10 - 1 Then
       '     msgList.Row = msgList.Row + 1
       '     msgList.TopRow = msgList.TopRow + 1
       '     Else
       '         msgList.Row = 1
       '         rownum = 1
       '         colnum = 1 '防止最后一行回车后，跳转到第十行，而应该跳到第一行
       '         msgList.TopRow = 1
       '     End If
       ' End If
       
       If msgList.Row < msgList.Rows - 1 Then
       msgList.Row = msgList.Row + 1
       Else
       msgList.Row = 1
       End If
       
        colnum = 1
        rownum = msgList.Row - msgList.TopRow + 1
        'Text1.Text = msgList.Text
        Text1.Text = msgList.TextMatrix(rownum, 1)
        Text1.Left = msgList.Left + (msgList.ColWidth(0) + msgList.GridLineWidth * 12) * colnum
        If rownum < 5 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 3) * rownum
        ElseIf rownum >= 5 And rownum < 7 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 20) * rownum
            ElseIf rownum >= 7 And rownum < 10 Then
                Text1.Top = msgList.Top + (msgList.RowHeight(0) - 30) * rownum
                ElseIf rownum >= 10 And rownum < 17 Then
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 35) * rownum
                Else
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 40) * rownum
        End If
      
       
       
    Exit Sub
 End Select

End Sub

Private Sub Text1_Change()

    msgList.Text = Text1.Text
  '  msgList.TextMatrix(rownum, 1) = Text1.Text
End Sub

Private Sub msgList_Scroll()


    msgList.Row = msgList.TopRow + rownum - 1
    Text1.Left = msgList.Left + (msgList.ColWidth(0) + msgList.GridLineWidth * 12) * colnum
    Text1.Top = msgList.Top + (msgList.RowHeight(0) + msgList.GridLineWidth * 12) * rownum
    Text1.Text = msgList.Text
End Sub

Private Sub msgList_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Text1.SetFocus
End Sub
Private Sub msgList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)



    msgList.Col = msgList.ColSel
    msgList.Row = msgList.RowSel
    'Text1.Text = msgList.Text
    Text1.Text = msgList.TextMatrix(msgList.Row, 1)
    'colnum = msgList.Col - msgList.LeftCol + 1
    colnum = 1
    rownum = msgList.Row - msgList.TopRow + 1
    Text1.Left = msgList.Left + (msgList.ColWidth(0) + msgList.GridLineWidth * 12) * colnum
    'Text1.Top = msgList.Top + (msgList.RowHeight(0) + msgList.GridLineWidth * 12) * rownum
    If rownum < 5 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 3) * rownum
        ElseIf rownum >= 5 And rownum < 7 Then
            Text1.Top = msgList.Top + (msgList.RowHeight(0) - 20) * rownum
            ElseIf rownum >= 7 And rownum < 10 Then
                Text1.Top = msgList.Top + (msgList.RowHeight(0) - 30) * rownum
                ElseIf rownum >= 10 And rownum < 17 Then
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 35) * rownum
                Else
                    Text1.Top = msgList.Top + (msgList.RowHeight(0) - 40) * rownum
        End If

End Sub




'显示Grid表头
Public Sub ShowTitle()
    Dim i As Integer
    
    With msgList
    
        txtSQL = "select Pro_name from ProjectTable"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
         
        .Rows = mrc.RecordCount + 1
        .Cols = 2
        .TextMatrix(0, 0) = "Project Name"
        .TextMatrix(0, 1) = "Working Hours"
        
        For i = 1 To mrc.RecordCount
                
             .TextMatrix(i, 0) = 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 1
          .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) = 1000
        
       ' For i = 1 To mrc.RecordCount
                
       ' .ColWidth(i + 1) = 1000
                
                
                
           msgList.ColWidth(0) = 1500
    msgList.RowHeight(0) = 285
    
    msgList.ColWidth(1) = 1500
    msgList.RowHeight(1) = 285
    '文本框的宽、高度
    Text1.Width = msgList.ColWidth(1)
    Text1.Height = msgList.RowHeight(1)
    'Text1.Width = 900
    'Text1.Height = 280
    
    '文本框的位置
    Text1.Left = msgList.Left + msgList.ColWidth(0) + msgList.GridLineWidth * 12
    Text1.Top = msgList.Top + msgList.RowHeight(0) + msgList.GridLineWidth * 35
    'Text1.Top = msgList.Top + msgList.RowHeight(0) + msgList.GridLineWidth
   ' msgList.Cols = 2
  '  msgList.Rows = 20 '表中总的列、行数
    msgList.Col = 1
    msgList.Row = 1 '网格的列、行初始位置
    msgList.LeftCol = 1
    msgList.TopRow = 1 '网格中左上角的列、行初始位置
    Text1.Text = ""
                
                
                
                
       ' 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 txtItem_Change(Index As Integer)
    '有变化设置gblchange
    mblChange = True
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
    txtItem(Index).SelStart = 0
    txtItem(Index).SelLength = Len(txtItem(Index))
End Sub

Private Sub txtItem_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    
    EnterToTab KeyCode

    
End Sub