frmchange.frm

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

VERSION 5.00
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPFORM.OCX"
Begin VB.Form frmchange 
   BorderStyle     =   0  'None
   Caption         =   "钮棒替换"
   ClientHeight    =   3750
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5625
   LinkTopic       =   "Form13"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   3750
   ScaleWidth      =   5625
   ShowInTaskbar   =   0   'False
   Begin XP窗体控件.XPForm XPForm1 
      Height          =   810
      Left            =   3480
      Top             =   480
      Width           =   1920
      _ExtentX        =   3387
      _ExtentY        =   1429
      Caption         =   ""
      ShowMaxButton   =   0   'False
      ShowMinButton   =   0   'False
      ShowHelpButton  =   0   'False
      AlwaysOnTop     =   0   'False
      ShowFormSize    =   0   'False
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   600
      TabIndex        =   18
      Top             =   1560
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "放弃"
      Height          =   255
      Left            =   3360
      TabIndex        =   17
      Top             =   3360
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定"
      Height          =   255
      Left            =   4320
      TabIndex        =   16
      Top             =   3360
      Width           =   735
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   3240
      TabIndex        =   15
      Top             =   2640
      Width           =   1815
   End
   Begin VB.ComboBox Combo2 
      Height          =   300
      Left            =   600
      TabIndex        =   13
      Top             =   2640
      Width           =   1815
   End
   Begin VB.CheckBox Check2 
      Caption         =   "Check2"
      Height          =   255
      Left            =   600
      TabIndex        =   11
      Top             =   2160
      Width           =   255
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   3240
      TabIndex        =   10
      Top             =   1560
      Width           =   1815
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00B9C4B9&
      Height          =   255
      Left            =   600
      TabIndex        =   2
      Top             =   1080
      Width           =   4455
      Begin VB.OptionButton Option3 
         Caption         =   "Option3"
         Height          =   180
         Left            =   3120
         TabIndex        =   5
         Top             =   0
         Width           =   255
      End
      Begin VB.OptionButton Option2 
         Caption         =   "Option2"
         Height          =   180
         Left            =   1680
         TabIndex        =   4
         Top             =   0
         Width           =   255
      End
      Begin VB.OptionButton Option1 
         Caption         =   "Option1"
         Height          =   180
         Left            =   360
         TabIndex        =   3
         Top             =   0
         Width           =   255
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "事件 "
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   3360
         TabIndex        =   8
         Top             =   0
         Width           =   495
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "地点"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1920
         TabIndex        =   7
         Top             =   0
         Width           =   495
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "人员"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   600
         TabIndex        =   6
         Top             =   0
         Width           =   495
      End
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Left            =   600
      TabIndex        =   0
      Top             =   720
      Width           =   255
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "替换为>>"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2400
      TabIndex        =   14
      Top             =   2640
      Width           =   855
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Caption         =   "棒号设定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1080
      TabIndex        =   12
      Top             =   2160
      Width           =   855
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "替换为>>"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   2400
      TabIndex        =   9
      Top             =   1560
      Width           =   855
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "钮号设定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1080
      TabIndex        =   1
      Top             =   720
      Width           =   855
   End
End
Attribute VB_Name = "frmchange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Dim i As Integer
 Dim cnn1 As ADODB.Connection
 Dim rs1 As ADODB.Recordset
 Dim cnn2 As ADODB.Connection
 Dim rs2 As ADODB.Recordset
 Dim cnn3 As ADODB.Connection
 Dim rs3 As ADODB.Recordset
 Dim cnn As ADODB.Connection
 Dim rs As ADODB.Recordset
 
 Dim itemsCoard As String
 Dim clsnew As lwpdllcls
 Dim clsnew2 As Class1
Private Sub Check1_Click()
    Combo1.BackColor = "&H00C0FFC0"
    Text1.BackColor = "&H00C0FFC0"
    Combo1.Clear
    If Option1.Value = True Then
        Set cnn1 = New ADODB.Connection
        Set rs1 = New ADODB.Recordset
        clsnew.showlib cnn1, rs1, clsnew2.getpersonN
        i = 0
        Do While rs1.EOF <> True
            itemsCoard = Trim(CStr(rs1.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs1.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs1.MoveNext
            i = i + 1
        Loop
            
    ElseIf Option2.Value = True Then
        Set cnn2 = New ADODB.Connection
        Set rs2 = New ADODB.Recordset
        clsnew.showlib cnn2, rs2, clsnew2.getplaceN
        i = 0
        Do While rs2.EOF <> True
            itemsCoard = Trim(CStr(rs2.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs2.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs2.MoveNext
            i = i + 1
        Loop
   Else
        Set cnn3 = New ADODB.Connection
        Set rs3 = New ADODB.Recordset
        clsnew.showlib cnn3, rs3, clsnew2.getactionN
        i = 0
        Do While rs3.EOF <> True
            itemsCoard = Trim(CStr(rs3.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs3.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs3.MoveNext
            i = i + 1
        Loop
            
    End If
End Sub

Private Sub Check2_Click()
    Combo2.BackColor = "&H00C0FFC0"
    Text2.BackColor = "&H00C0FFC0"
    Set cnn = New ADODB.Connection
        Set rs = New ADODB.Recordset
        clsnew.showlib cnn, rs, clsnew2.getbarN
        i = 0
        Do While rs.EOF <> True
            itemsCoard = Trim(CStr(rs.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs.Fields(0).Value
            Combo2.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs.MoveNext
            i = i + 1
        Loop
End Sub

Private Sub Command1_Click()
    
    If Check1.Value = Checked Then
        If clsnew2.checkNiuHao(Text1.Text) Then
            If Option1.Value = True Then
                cnn1.Execute ("update " & clsnew2.getpersonN & "set T_person.钮号 ='" & UCase(Text1.Text) & "' where T_person.钮号 ='" & Combo1.Text & "'")
                rs1.Requery
            End If
            If Option2.Value = True Then
                cnn2.Execute ("update " & clsnew2.getplaceN & " set T_place.钮号 ='" & UCase(Text1.Text) & "' where T_place.钮号 ='" & Combo1.Text & "'")
                rs2.Requery
            End If
            If Option3.Value = True Then
                cnn3.Execute ("update " & clsnew2.getactionN & " set T_action.钮号 ='" & UCase(Text1.Text) & "' where T_action.钮号 ='" & Combo1.Text & "'")
                rs3.Requery
            End If
        End If
    End If
    If Check2.Value = Checked Then
        If clsnew2.checkBangHao(Text2.Text) Then
            cnn.Execute ("update " & clsnew2.getbarN & " set T_bar.棒号 ='" & Text2.Text & "' where T_bar.棒号 ='" & Combo2.Text & "'")
            rs.Requery
        End If
    End If
    rs1.Close
    cnn.Close
    Unload Me
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
XPForm1.Make

    Set clsnew = New lwpdllcls
    Set clsnew2 = New Class1
    MDIForm1.Command1.Enabled = False
    MDIForm1.Command2.Enabled = False
    MDIForm1.Command3.Enabled = False
    MDIForm1.Command8.Enabled = False
    MDIForm1.Command9.Enabled = False
    MDIForm1.Command10.Enabled = False
    MDIForm1.sysCmd_p1.Enabled = False
    MDIForm1.sysSet_p2.Enabled = False
    Option1.Value = True
    
End Sub
Private Sub Option1_Click()
    Combo1.Clear
    Set cnn1 = New ADODB.Connection
        Set rs1 = New ADODB.Recordset
        clsnew.showlib cnn1, rs1, clsnew2.getpersonN
        i = 0
        Do While rs1.EOF <> True
            itemsCoard = Trim(CStr(rs1.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs1.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs1.MoveNext
            i = i + 1
        Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
      MDIForm1.Command1.Enabled = True
    MDIForm1.Command2.Enabled = True
    MDIForm1.Command3.Enabled = True
    If MDIForm1.blnmaglogin = False Then
        MDIForm1.Command8.Enabled = False
    Else
        MDIForm1.Command8.Enabled = True
    End If
    If MDIForm1.blnmaglogin = False Then
        MDIForm1.sysSet_p2.Enabled = False
    Else
        MDIForm1.sysSet_p2.Enabled = True
    End If
 '   MDIForm1.Command8.Enabled = True
    MDIForm1.Command9.Enabled = True
    MDIForm1.Command10.Enabled = True
    MDIForm1.sysCmd_p1.Enabled = True
    
End Sub
Private Sub Option2_Click()
     Combo1.Clear
     Set cnn2 = New ADODB.Connection
        Set rs2 = New ADODB.Recordset
        clsnew.showlib cnn2, rs2, clsnew2.getplaceN
        i = 0
        Do While rs2.EOF <> True
            itemsCoard = Trim(CStr(rs2.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs2.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs2.MoveNext
            i = i + 1
        Loop
End Sub

Private Sub Option3_Click()
    Combo1.Clear
    Set cnn3 = New ADODB.Connection
        Set rs3 = New ADODB.Recordset
        clsnew.showlib cnn3, rs3, clsnew2.getactionN
        i = 0
        Do While rs3.EOF <> True
            itemsCoard = Trim(CStr(rs3.Fields(0).Value))  '设定地点和钮号
            Debug.Print rs3.Fields(0).Value
            Combo1.AddItem itemsCoard, i
            'Combo3.AddItem itemsCoard, i
            rs3.MoveNext
            i = i + 1
        Loop
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
 

    If Chr(KeyAscii) = Chr(13) Then
        tmpnh = Trim(Text1.Text)
        If clsnew2.checkNiuHao(tmpnh) Then
             
        
       End If
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
 
     If Chr(KeyAscii) = Chr(13) Then
        tmpnh = Trim(Text2.Text)
        If clsnew2.checkBangHao(tmpnh) Then
             
        
       End If
    End If
End Sub