frmshowtimes.frm

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

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

Private Sub asPopup2_Click(Cancel As Boolean)

End Sub

Private Sub asPopup3_Click(Cancel As Boolean)

End Sub

Private Sub asPopup4_Click(Cancel As Boolean)
frmtimes.Left = 4000
    frmtimes.Top = 2500
frmtimes.Show

Unload Me


End Sub

Private Sub asPopup7_Click(Cancel As Boolean)
Set conn1 = Nothing

Unload Me

End Sub

Private Sub asPopup8_Click(Cancel As Boolean)

End Sub


Private Sub cmddel_Click(Cancel As Boolean)


Dim i As Integer

On Error Resume Next
If DataGrid1.SelBookmarks.Count > 0 Then
      cmddel.Enabled = True
  Else
        cmddel.Enabled = False
 End If
       
       For i = 0 To DataGrid1.SelBookmarks.Count - 1
        rs1.Move DataGrid1.SelBookmarks.Item(i) - 1, 1
        rs1.Delete
        Next i
            
           rs1.Update
           rs1.Requery
           
           
End Sub

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

Dim answer As String
On Error GoTo cmdmodify
cmddel.Enabled = False
cmdmodify.Enabled = False
cmdupdate.Enabled = True

cmdupdate.BackColor = cmdmodify.BackColor


DataGrid1.AllowUpdate = True
If rs1.EOF = False And rs1.BOF = False Then
rs1.MoveFirst
End If
cmdmodify:
If Err.number <> 0 Then
   frmmsg.msg.MsgChar = Err.Description
End If
End Sub

Private Sub cmdupdate_Click(Cancel As Boolean)
'On Error Resume Next

If rs1.EOF And rs1.BOF Then
Else
rs1.MoveFirst
Do While rs1.EOF <> True
rs1.Update
rs1.MoveNext
Loop

End If



   
   TimeDelay 50
   

   cmdmodify.Enabled = True
   cmddel.Enabled = True
   cmdupdate.Enabled = False
   DataGrid1.AllowUpdate = False
   DataGrid1.AllowAddNew = False
    MsgBox "更新成功！", vbOKOnly + vbExclamation, ""
End Sub

Private Sub combo1_Click()
DataGrid1.Columns(1).Text = Combo1.Text
End Sub

Private Sub Combo2_Click()
DataGrid1.Columns(2).Text = Combo2.Text
End Sub

Private Sub Combo3_Click()
DataGrid1.Columns(0).Text = Combo3.Text
End Sub

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

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

End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)


  If DataGrid1.Col = 0 Then
         Combo2.Visible = False
         Combo1.Visible = False
         Text1.Visible = False
        
        Combo3.Width = DataGrid1.Columns(DataGrid1.Col).Width
        Combo3.Left = DataGrid1.Left + DataGrid1.Columns(DataGrid1.Col).Left
        Combo3.Top = DataGrid1.Top + DataGrid1.Row * DataGrid1.RowHeight + 275
        Combo3.Visible = True
         DataGrid1.Columns(0).DataField = Combo3.Text
         
       
    End If
    If DataGrid1.Col = 1 Then
      Combo2.Visible = False
         Combo3.Visible = False
         Text1.Visible = False
        
        Combo1.Width = DataGrid1.Columns(DataGrid1.Col).Width
        Combo1.Left = DataGrid1.Left + DataGrid1.Columns(DataGrid1.Col).Left
        Combo1.Top = DataGrid1.Top + DataGrid1.Row * DataGrid1.RowHeight + 275
        Combo1.Visible = True
         DataGrid1.Columns(1).DataField = Combo1.Text
         
       
    End If
    
    
    If DataGrid1.Col = 2 Then
    Combo1.Visible = False
             Combo3.Visible = False
             Text1.Visible = False
          
             Combo2.Width = DataGrid1.Columns(DataGrid1.Col).Width
            Combo2.Left = DataGrid1.Left + DataGrid1.Columns(DataGrid1.Col).Left
            Combo2.Top = DataGrid1.Top + DataGrid1.Row * DataGrid1.RowHeight + 275
            Combo2.Visible = True
             DataGrid1.Columns(2).DataField = Combo2.Text
             
       
    End If
             
    If DataGrid1.Col = 3 Then
     Combo1.Visible = False
    Combo2.Visible = False
     Combo3.Visible = False
    
   
    End If
    If DataGrid1.Col = 4 Then
    Combo1.Visible = False
    Combo2.Visible = False
     Combo3.Visible = False
     Text1.Visible = False
     End If
     DataGrid1.AllowAddNew = False
     
    
    
End Sub

Private Sub Form_Load()
On Error Resume Next


XPForm1.Make
Dim txtsql As String
Dim conn2 As New ADODB.Connection
Dim mrc1, mrc2 As New ADODB.Recordset
Dim connecting As String
connecting = "provider=Microsoft.Jet.oledb.4.0;" & _
            "data source=" & App.path & "\jk.mdb"
conn1.Open connecting
txtsql = "select * from 计划次数表"
rs1.CursorLocation = adUseClient
rs1.Open txtsql, conn1, adOpenKeyset, adLockPessimistic
Set DataGrid1.DataSource = rs1

conn2.Open connecting
'Me.WindowState = 2
txtsql = "select * from 地点设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo1.AddItem mrc1.Fields(1)
mrc1.MoveNext
Loop
End If
mrc1.Close

txtsql = "select * from 人员设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo2.AddItem mrc1.Fields(1)
mrc1.MoveNext

Loop
End If
mrc1.Close
txtsql = "select * from 棒号设置表"
Set mrc1 = conn2.Execute(txtsql)
If mrc1.EOF = True And mrc1.BOF = True Then
Else
mrc1.MoveFirst
Do While mrc1.EOF <> True
Combo3.AddItem mrc1.Fields(1)
mrc1.MoveNext
Loop
End If
mrc1.Close

'设定datagrid控件属性
DataGrid1.AllowAddNew = False '不可增加
DataGrid1.AllowDelete = False                              '不可删除
DataGrid1.AllowUpdate = False
 DataGrid1.RowHeight = Combo1.Height
 Text1.Height = DataGrid1.RowHeight












End Sub

Private Sub UpDown1_Change()

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set rs1 = Nothing
Set conn1 = Nothing


End Sub

Private Sub Text1_Change()
If Len(Text1) = 2 Then
Text1.Text = Text1.Text & ":"
End If
If Len(Text1) = 5 Then
DataGrid1.Columns(3).Text = Text1.Text
End If






End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If Chr(KeyAscii) = Chr(13) Then
      
   DataGrid1.Columns(3).Text = Text1.Text
   End If
   
   
End Sub