frmaddbang.frm

用户MODBUS规约通信编程,起参考作用.

VERSION 5.00
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPForm.ocx"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmplanshow 
   BackColor       =   &H00C0FFFF&
   BorderStyle     =   0  'None
   Caption         =   "查询结果"
   ClientHeight    =   9930
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15090
   Icon            =   "frmaddbang.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   9930
   ScaleWidth      =   15090
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin MSFlexGridLib.MSFlexGrid flggrid 
      Height          =   6375
      Left            =   960
      TabIndex        =   2
      Top             =   960
      Width           =   13455
      _ExtentX        =   23733
      _ExtentY        =   11245
      _Version        =   393216
   End
   Begin as97Popup.asPopup asPopup3 
      Height          =   255
      Left            =   10200
      Top             =   7920
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   450
      Caption         =   "查询"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16744703
      ScaleWidth      =   65
      ScaleMode       =   0
      ScaleHeight     =   17
   End
   Begin VB.ComboBox Combo3 
      Height          =   300
      Left            =   8040
      TabIndex        =   0
      Text            =   "任何人"
      Top             =   7920
      Width           =   1335
   End
   Begin as97Popup.asPopup asPopup2 
      Height          =   495
      Left            =   4920
      Top             =   7800
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   873
      Caption         =   "退出"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleWidth      =   89
      ScaleMode       =   0
      ScaleHeight     =   33
   End
   Begin as97Popup.asPopup asPopup1 
      Height          =   495
      Left            =   3240
      Top             =   7800
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   873
      Caption         =   "打印"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleWidth      =   81
      ScaleMode       =   0
      ScaleHeight     =   33
   End
   Begin XP窗体控件.XPForm XPForm1 
      Height          =   810
      Left            =   5280
      Top             =   8280
      Width           =   1920
      _ExtentX        =   3387
      _ExtentY        =   1429
      Caption         =   "查询结果"
      ShowHelpButton  =   0   'False
      Icon            =   "frmaddbang.frx":0CCA
      AlwaysOnTop     =   0   'False
      ShowFormSize    =   -1  'True
   End
   Begin VB.Label Label2 
      BackColor       =   &H8000000A&
      Caption         =   "按人员"
      Height          =   255
      Left            =   6840
      TabIndex        =   1
      Top             =   7920
      Width           =   975
   End
End
Attribute VB_Name = "frmplanshow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim connectstring As String

Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub asPopup1_Click(Cancel As Boolean)
DataReport2.Show

End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
Unload Me

End Sub

Private Sub asPopup3_Click(Cancel As Boolean)
On Error Resume Next

Dim ren_1 As String
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection
conn.Open connectstring
conn.CursorLocation = adUseClient

rs.Close

ren_1 = Combo3.Text
If ren_1 = "任何人" Then
sqltxt = "select  * from 计划执行表"
Else

sqltxt = "select  * from 计划执行表 where 计划人员='" & ren_1 & "'"
End If
rs.Open sqltxt, conn, adOpenKeyset, adLockPessimistic

Set DataReport2.DataSource = rs

flggrid.Clear
    flggrid.Cols = 9
    flggrid.FixedCols = 0
    flggrid.FixedRows = 1
    
    flggrid.ColWidth(0) = flggrid.Width / 9
    flggrid.ColWidth(1) = flggrid.Width / 9
    flggrid.ColWidth(2) = flggrid.Width / 9
    flggrid.ColWidth(3) = flggrid.Width / 9
    flggrid.ColWidth(4) = flggrid.Width / 9
    flggrid.ColWidth(5) = flggrid.Width / 9
    flggrid.ColWidth(6) = flggrid.Width / 9
    flggrid.ColWidth(7) = flggrid.Width / 9
    flggrid.ColWidth(8) = flggrid.Width / 9
   flggrid.TextMatrix(0, 0) = "巡检日期"
    flggrid.TextMatrix(0, 1) = "巡检类型"
    flggrid.TextMatrix(0, 2) = "地点"
    flggrid.TextMatrix(0, 3) = "计划人员"
    flggrid.TextMatrix(0, 4) = "计划时间"
     flggrid.TextMatrix(0, 5) = "实际人员"
     flggrid.TextMatrix(0, 6) = "实到时间"
     flggrid.TextMatrix(0, 7) = "允许误差"
     
    flggrid.TextMatrix(0, 8) = "执行结果"
    flggrid.Rows = 2
    
    If rs.EOF And rs.BOF Then
    Else
    rs.MoveFirst
    End If
    Do While rs.EOF <> True
     flggrid.TextMatrix(flggrid.Rows - 1, 0) = rs.Fields(0).Value ' Set Grid Col 0 the data from Row 0
        flggrid.TextMatrix(flggrid.Rows - 1, 1) = rs.Fields(1).Value ' Set Grid Col 1 the data from Row 1
        flggrid.TextMatrix(flggrid.Rows - 1, 2) = rs.Fields(2).Value ' Set Grid Col 2 the data from Row 2
        flggrid.TextMatrix(flggrid.Rows - 1, 3) = rs.Fields(3).Value ' Set Grid Col 3 the data from Row 3
        flggrid.TextMatrix(flggrid.Rows - 1, 4) = rs.Fields(4).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 5) = rs.Fields(5).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 6) = rs.Fields(6).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 7) = rs.Fields(7).Value
       flggrid.TextMatrix(flggrid.Rows - 1, 8) = rs.Fields(8).Value
       
        
        flggrid.Rows = flggrid.Rows + 1
        rs.MoveNext ' Remember to move to the next record.
    Loop
    
     flggrid.Rows = flggrid.Rows - 1
     
      Dim k, i, j As Integer
      k = flggrid.Cols
   
    For i = 1 To flggrid.Rows - 1
    
    flggrid.Row = i
    If flggrid.TextMatrix(i, 8) = "漏检" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = vbRed
    Next
    End If
    
    If flggrid.TextMatrix(i, 8) = "早到" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = &HFF8080
    Next
    End If
    
      If flggrid.TextMatrix(i, 8) = "迟到" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = &HFF80FF
    Next
    End If
    
    
      
    
    
    Next
    flggrid.Refresh
    



End Sub

Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
On Error Resume Next

rs.Sort = rs.Fields(ColIndex).name & " asc "
DataGrid1.Refresh


End Sub

Private Sub Form_Load()
On Error Resume Next
Dim conn As New ADODB.Connection
Dim result_1, ren_1 As String
Me.WindowState = 2

XPForm1.Make



connectstring = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.Path & "\jk.mdb"
 
conn.Open connectstring
conn.CursorLocation = adUseClient
ren_1 = frmplan_ex.Combo3.Text
result_1 = frmplan_ex.Combo1.Text
sqltxt = "update  计划执行表  set 实际人员='未知' ,实到时间='未知', 执行结果='漏检' where 计划人员<>'任何人'  and 计划人员<> 实际人员"
conn.Execute (sqltxt)
'TimeDelay 1000

sqltxt = ""



If ren_1 = "任何人" Then

If result_1 = "全部" Then
sqltxt = "select  * from 计划执行表"
Else
sqltxt = "select  * from 计划执行表 where 执行结果='" & result_1 & "'"
End If



Else
If result_1 = "全部" Then
sqltxt = "select  * from 计划执行表 where 计划人员='" & ren_1 & "'"
Else
sqltxt = "select  * from 计划执行表 where 执行结果='" & result_1 & "' and  计划人员='" & ren_1 & "' "
End If


End If







rs.Open sqltxt, conn, adOpenKeyset, adLockPessimistic
Set DataReport2.DataSource = rs



   flggrid.Clear
    flggrid.Cols = 9
    flggrid.FixedCols = 0
    flggrid.FixedRows = 1
    
    flggrid.ColWidth(0) = flggrid.Width / 9
    flggrid.ColWidth(1) = flggrid.Width / 9
    flggrid.ColWidth(2) = flggrid.Width / 9
    flggrid.ColWidth(3) = flggrid.Width / 9
    flggrid.ColWidth(4) = flggrid.Width / 9
    flggrid.ColWidth(5) = flggrid.Width / 9
    flggrid.ColWidth(6) = flggrid.Width / 9
    flggrid.ColWidth(7) = flggrid.Width / 9
    flggrid.ColWidth(8) = flggrid.Width / 9
   flggrid.TextMatrix(0, 0) = "巡检日期"
    flggrid.TextMatrix(0, 1) = "巡检类型"
    flggrid.TextMatrix(0, 2) = "地点"
    flggrid.TextMatrix(0, 3) = "计划人员"
    flggrid.TextMatrix(0, 4) = "计划时间"
     flggrid.TextMatrix(0, 5) = "实际人员"
     flggrid.TextMatrix(0, 6) = "实到时间"
     flggrid.TextMatrix(0, 7) = "允许误差"
     
    flggrid.TextMatrix(0, 8) = "执行结果"
    flggrid.Rows = 2
    
    If rs.EOF And rs.BOF Then
    Else
    rs.MoveFirst
    End If
    Do While rs.EOF <> True
     flggrid.TextMatrix(flggrid.Rows - 1, 0) = rs.Fields(0).Value ' Set Grid Col 0 the data from Row 0
        flggrid.TextMatrix(flggrid.Rows - 1, 1) = rs.Fields(1).Value ' Set Grid Col 1 the data from Row 1
        flggrid.TextMatrix(flggrid.Rows - 1, 2) = rs.Fields(2).Value ' Set Grid Col 2 the data from Row 2
        flggrid.TextMatrix(flggrid.Rows - 1, 3) = rs.Fields(3).Value ' Set Grid Col 3 the data from Row 3
        flggrid.TextMatrix(flggrid.Rows - 1, 4) = rs.Fields(4).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 5) = rs.Fields(5).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 6) = rs.Fields(6).Value
        flggrid.TextMatrix(flggrid.Rows - 1, 7) = rs.Fields(7).Value
       flggrid.TextMatrix(flggrid.Rows - 1, 8) = rs.Fields(8).Value
       
        
        flggrid.Rows = flggrid.Rows + 1
        rs.MoveNext ' Remember to move to the next record.
    Loop
    
     flggrid.Rows = flggrid.Rows - 1
     
      Dim k, i, j As Integer
      k = flggrid.Cols
   
    For i = 1 To flggrid.Rows - 1
    
    flggrid.Row = i
    If flggrid.TextMatrix(i, 8) = "漏检" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = vbRed
    Next
    End If
    
    If flggrid.TextMatrix(i, 8) = "早到" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = &HFF8080
    Next
    End If
    
      If flggrid.TextMatrix(i, 8) = "迟到" Then
    For j = 0 To k - 1
    flggrid.Col = j
    flggrid.CellForeColor = &HFF80FF
    Next
    End If
    
    
     
    
    Next
    flggrid.Refresh
    














Dim rs_1 As New ADODB.Recordset
sqltxt = "select  * from 人员设置表"
Set rs_1 = conn.Execute(sqltxt)
If rs.BOF And rs.EOF Then
Else
rs_1.MoveFirst
Do While rs_1.EOF <> True
Combo3.AddItem rs_1.Fields(1)
rs_1.MoveNext
Loop
End If
Combo3.AddItem "任何人"


Set rs_1 = Nothing


End Sub

Private Sub Form_Unload(Cancel As Integer)
Set conn = Nothing
Set rs = Nothing
End Sub