frmperson.frm

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

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPForm.ocx"
Begin VB.Form frmperson 
   BorderStyle     =   0  'None
   Caption         =   "设置人员 "
   ClientHeight    =   8220
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   8220
   Icon            =   "frmperson.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   8220
   ScaleWidth      =   8220
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0FFC0&
      Height          =   270
      Left            =   1560
      TabIndex        =   3
      Top             =   2160
      Visible         =   0   'False
      Width           =   1560
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0FFFF&
      Caption         =   "加入"
      Height          =   735
      Left            =   120
      TabIndex        =   1
      Top             =   5880
      Width           =   2895
      Begin as97Popup.asPopup asPopup2 
         Height          =   255
         Left            =   1680
         Top             =   240
         Width           =   855
         _ExtentX        =   1508
         _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       =   16777152
         ScaleWidth      =   57
         ScaleMode       =   0
         ScaleHeight     =   17
      End
      Begin as97Popup.asPopup asPopup1 
         Height          =   255
         Left            =   360
         Top             =   240
         Width           =   855
         _ExtentX        =   1508
         _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       =   16777152
         ScaleWidth      =   57
         ScaleMode       =   0
         ScaleHeight     =   17
      End
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H00C0FFFF&
      Caption         =   "编辑"
      Height          =   735
      Left            =   3120
      TabIndex        =   0
      Top             =   5880
      Width           =   3135
      Begin as97Popup.asPopup cmdmodify 
         Height          =   375
         Left            =   240
         Top             =   240
         Width           =   975
         _ExtentX        =   1720
         _ExtentY        =   661
         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       =   16777088
         ScaleWidth      =   65
         ScaleMode       =   0
         ScaleHeight     =   25
      End
      Begin as97Popup.asPopup cmddel 
         Height          =   375
         Left            =   1440
         Top             =   240
         Width           =   975
         _ExtentX        =   1720
         _ExtentY        =   661
         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       =   16777088
         ScaleWidth      =   65
         ScaleMode       =   0
         ScaleHeight     =   25
      End
   End
   Begin MSDataGridLib.DataGrid DataGrid1 
      Height          =   3495
      Left            =   1320
      TabIndex        =   2
      Top             =   960
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   6165
      _Version        =   393216
      BackColor       =   12648447
      HeadLines       =   1
      RowHeight       =   15
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   0
      Top             =   2280
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin XP窗体控件.XPForm XPForm2 
      Height          =   810
      Left            =   3960
      Top             =   4320
      Width           =   1920
      _ExtentX        =   3387
      _ExtentY        =   1429
      Caption         =   "设置人员 "
      ShowHelpButton  =   0   'False
      Icon            =   "frmperson.frx":1272
      AlwaysOnTop     =   0   'False
      ShowFormSize    =   0   'False
   End
   Begin as97Popup.asPopup cmdupdate 
      Height          =   495
      Left            =   6600
      Top             =   6000
      Width           =   975
      _ExtentX        =   1720
      _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
      BackColor       =   12648447
      ScaleWidth      =   65
      ScaleMode       =   0
      ScaleHeight     =   33
   End
End
Attribute VB_Name = "frmperson"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn1 As New ADODB.Connection
Dim rs As New ADODB.Recordset




Dim flag As Boolean
Public answer As Integer

Dim bang_num As String
Dim Count_Total As Integer
Dim mon_time As String
Dim Time_Date() As String
Dim Niu() As String
Dim Xia_Biao As Integer
Dim receive(9) As Byte
Dim inTinputlen As Integer
Dim flag_end As Boolean
Dim k_flag As Boolean


Private Sub asPopup1_Click(Cancel As Boolean)
Dim flag As Boolean
On Error Resume Next
 Horizontal Me, RGB(131, 166, 244), RGB(33, 120, 224)

If rs.EOF = False And rs.BOF = False Then
rs.MoveLast
End If
DataGrid1.AllowAddNew = True
DataGrid1.AllowUpdate = True
cmdupdate.Enabled = True
 
DataGrid1.Refresh

DataGrid1.Col = 1
If rs.EOF <> True And rs.BOF <> True Then
rs.MoveFirst
End If
If rs.EOF = True Or rs.BOF = True Then
Else

Do While rs.EOF <> True
If Len(Trim(rs.Fields(0))) = 0 Then
MsgBox "已经有一条空白记录，不能再增加新空记录！", , "提示"
flag = False
Exit Do
End If
rs.MoveNext
Loop
If flag Then
rs.MoveLast
With rs
.AddNew
.Fields(0) = ""
.Fields(1) = ""
.Update
End With
End If




End If



       
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
'On Error GoTo err_write
Dim strtxt As String
Dim txtsql As String
Dim rs1 As New ADODB.Recordset
Dim k As Integer

Dim i As Integer
flag_end = False
k_flag = False

'On Error Resume Next

strset = "9600,n,8,1"
MSComm1.CommPort = strfile

MSComm1.InBufferSize = 1024
MSComm1.OutBufferSize = 512

MSComm1.PortOpen = True

'On Error GoTo err_write

DataGrid1.AllowAddNew = True
Xia_Biao = 0
strtxt = "0"
MSComm1.Output = strtxt
TimeDelay 600
MSComm1.InBufferCount = 0
liqin ("55")
 TimeDelay 30
 MSComm1.InputMode = comInputModeBinary
 MSComm1.InputLen = 9
 inTinputlen = 9
 ReDim byTinput(9) As Byte
 
 byTinput = MSComm1.Input
 For i = 2 To 9
 receive(i - 2) = byTinput(i - 1)
 Next
 Call GetDisplayText
 If k_flag = True Then
 Exit Sub
 End If
 
 

 MSComm1.InBufferCount = 0
liqin ("04")
TimeDelay 100
 MSComm1.InputMode = comInputModeBinary
 MSComm1.InputLen = 9
  ReDim byTinput(9) As Byte
 byTinput = MSComm1.Input
 For i = 2 To 9
 receive(i - 2) = byTinput(i - 1)
 Next
 Call Display
For k = 1 To 4100
Call Niu_Hao
Call Display
If flag_end = True Then
k = 5000
End If
Next

DataGrid1.AllowUpdate = True
cmdupdate.Enabled = True
MSComm1.PortOpen = False






Exit Sub
 

err_write:
MSComm1.PortOpen = False

frmmsg.msg.MsgChar = "硬件或串口问题"
frmmsg.Show



End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
On Error Resume Next

 If DataGrid1.Col = 0 Then
        lpis = DataGrid1.Left + DataGrid1.Columns(0).Left
        tpis = DataGrid1.RowHeight * (DataGrid1.Row + 5.1 + DataGrid1.Row / 12)
            Text1.Left = lpis
            Text1.Top = tpis
            Text1.Text = DataGrid1.Text
            Text1.Visible = True
            
     Else
        Text1.Visible = False
        
    End If
   
    
'    If LastCol = 0 Then
End Sub

Private Sub Form_Load()
On Error GoTo 100

XPForm2.Make


Dim connecting As String
Dim txtsql As String

connecting = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.path & "\jk.mdb"
                   
conn1.Open connecting
txtsql = "select * from 人员设置表"
rs.CursorLocation = adUseClient
rs.Open txtsql, conn1, adOpenKeyset, adLockPessimistic

  Set DataGrid1.DataSource = rs

DataGrid1.Refresh
cmdupdate.Enabled = False
DataGrid1.AllowAddNew = False
DataGrid1.AllowDelete = False
DataGrid1.AllowUpdate = False
Exit Sub

100:
frmmsg.msg.MsgChar = Err.Description
frmmsg.Show

End Sub


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

Dim answer As String
On Error GoTo delerror
answer = MsgBox("确定要删除吗？", vbYesNo, "")
If answer = vbYes Then


   DataGrid1.AllowDelete = True
   rs.Delete
   rs.Update
   DataGrid1.Refresh
   MsgBox "成功删除！", vbOKOnly + vbExclamation, ""
   DataGrid1.AllowDelete = False
Else
   Exit Sub
End If

delerror:
If Err.number <> 0 Then
   frmmsg.msg.MsgChar = Err.Description
   frmmsg.Show
   
End If


End Sub

Private Sub cmdmodify_Click(Cancel As Boolean)
On Error GoTo cmdmodify1

Dim answer As String
DataGrid1.AllowAddNew = False
DataGrid1.AllowUpdate = True
If rs.EOF = True And rs.BOF = True Then
Else
rs.MoveFirst
End If



cmddel.Enabled = False
cmdmodify.Enabled = False
cmdupdate.Enabled = True
cmdupdate.BackColor = cmdmodify.BackColor



cmdmodify1:
If Err.number <> 0 Then
   frmmsg.msg.MsgChar = Err.Description
End If
End Sub
Private Sub cmdupdate_Click(Cancel As Boolean)
If rs.EOF And rs.BOF Then
Else
rs.MoveFirst
Do While rs.EOF <> True
rs.Update
rs.MoveNext
Loop

End If



   
   TimeDelay 50
   

   cmdmodify.Enabled = True
   cmddel.Enabled = True
   cmdupdate.Enabled = False