frmlist.frm

生产数据经常用到文本及数据库方式, 本程序将文本数据转换成数据库, 非常使用

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmList 
   Caption         =   "FirstDb"
   ClientHeight    =   5130
   ClientLeft      =   1110
   ClientTop       =   345
   ClientWidth     =   6375
   LinkTopic       =   "Form2"
   ScaleHeight     =   5130
   ScaleWidth      =   6375
   Begin MSDBGrid.DBGrid DBGrid1 
      Bindings        =   "frmList.frx":0000
      Height          =   1575
      Left            =   360
      OleObjectBlob   =   "frmList.frx":0014
      TabIndex        =   16
      Top             =   2760
      Width           =   4695
   End
   Begin VB.TextBox txtTime 
      Height          =   285
      Left            =   1440
      TabIndex        =   15
      Text            =   "Text1"
      Top             =   1200
      Width           =   2055
   End
   Begin VB.CommandButton cmdLast 
      Caption         =   "--->||"
      Height          =   255
      Left            =   2760
      TabIndex        =   13
      Top             =   1800
      Width           =   735
   End
   Begin VB.CommandButton cmdNext 
      Caption         =   "----->"
      Height          =   255
      Left            =   2160
      TabIndex        =   12
      Top             =   2280
      Width           =   735
   End
   Begin VB.CommandButton cmdPrevious 
      Caption         =   "<-----"
      Height          =   255
      Left            =   1080
      TabIndex        =   11
      Top             =   2280
      Width           =   735
   End
   Begin VB.CommandButton cmdFirst 
      Caption         =   "||<---"
      Height          =   255
      Left            =   600
      TabIndex        =   10
      Top             =   1800
      Width           =   735
   End
   Begin VB.TextBox txtIMEI 
      Height          =   285
      Left            =   1440
      TabIndex        =   9
      Text            =   "Text1"
      Top             =   840
      Width           =   2055
   End
   Begin VB.TextBox txtBoxNo 
      Height          =   285
      Left            =   1440
      TabIndex        =   8
      Text            =   "Text1"
      Top             =   480
      Width           =   2055
   End
   Begin VB.TextBox txtItemNo 
      Height          =   285
      Left            =   1440
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   120
      Width           =   2055
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "&Close"
      Height          =   300
      Left            =   4080
      TabIndex        =   6
      Top             =   1920
      Width           =   975
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "&Update"
      Height          =   300
      Left            =   4080
      TabIndex        =   5
      Top             =   1320
      Width           =   975
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "&Refresh"
      Height          =   300
      Left            =   4080
      TabIndex        =   4
      Top             =   720
      Width           =   975
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "&Delete"
      Height          =   300
      Left            =   4080
      TabIndex        =   3
      Top             =   240
      Width           =   975
   End
   Begin VB.Data Data1 
      Align           =   2  'Align Bottom
      Connect         =   "Access"
      DatabaseName    =   "E:\VB works\Database\IMEIRecords.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      EOFAction       =   2  'Add New
      Exclusive       =   0   'False
      Height          =   345
      Left            =   0
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "IMEIRecords"
      Top             =   4785
      Visible         =   0   'False
      Width           =   6375
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Time:"
      Height          =   195
      Left            =   360
      TabIndex        =   14
      Top             =   1200
      Width           =   390
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "IMEI:"
      Height          =   195
      Index           =   2
      Left            =   360
      TabIndex        =   2
      Top             =   825
      Width           =   375
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "Box No:"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   1
      Top             =   495
      Width           =   570
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "ITem No:"
      Height          =   195
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   180
      Width           =   660
   End
End
Attribute VB_Name = "frmList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'Private Sub cmdAdd_Click()
'  Data1.Recordset.AddNew
'End Sub

Private Sub cmdDelete_Click()
  'this may produce an error if you delete the last
  'record or the only record in the recordset
  Data1.Recordset.Delete
  Data1.Recordset.MoveNext
End Sub

Private Sub cmdFirst_Click()
Data1.Recordset.MoveFirst
End Sub

Private Sub cmdLast_Click()
Data1.Recordset.MoveLast
End Sub

Private Sub cmdNext_Click()
Dim iRecordNo As Integer
On Error GoTo Err1
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then Exit Sub

Data1.Recordset.MoveNext
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then
    Data1.Recordset.AddNew
End If
Err1:
End Sub

Private Sub cmdPrevious_Click()
Dim iRecordNo As Integer

On Error GoTo Err2
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then Exit Sub

Data1.Recordset.MovePrevious
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then
    Data1.Recordset.AddNew
End If
Err2:
End Sub

Private Sub cmdRefresh_Click()
  'this is really only needed for multi user apps
  Data1.Refresh
End Sub

Private Sub cmdUpdate_Click()

On Error GoTo Err1
    Data1.Recordset.Fields(0).Value = txtItemNo.Text
    Data1.Recordset.Fields(1).Value = txtBoxNo.Text
    Data1.Recordset.Fields(2).Value = txtIMEI.Text
    Data1.Recordset.Fields(3).Value = txtTime.Text

  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  Exit Sub
Err1:
    MsgBox "There are IMEI or BoxNo repeattion..."
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  'This is where you would put error handling code
  'If you want to ignore errors, comment out the next line
  'If you want to trap them, add code here to handle them
  MsgBox "Data error event hit err:" & Error$(DataErr)
  Response = 0  'throw away the error
End Sub

Private Sub Data1_Reposition()
Dim iRecordNo As Integer
    iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo >= 0 Then
  txtItemNo.Text = Data1.Recordset.Fields(0).Value
  If IsNull(Data1.Recordset.Fields(1).Value) Then
    txtBoxNo.Text = ""
    
  Else
    txtBoxNo.Text = Data1.Recordset.Fields(1).Value
  End If
  txtIMEI.Text = Data1.Recordset.Fields(2).Value
  If IsNull(Data1.Recordset.Fields(3).Value) Then
    txtTime.Text = ""
  Else
    txtTime.Text = Data1.Recordset.Fields(3).Value
  End If

Else
  txtItemNo.Text = ""
  txtBoxNo.Text = ""
  txtIMEI.Text = ""
  txtTime.Text = ""
End If


  Screen.MousePointer = vbDefault
  On Error Resume Next
  'This will display the current record position
  'for dynasets and snapshots
  Data1.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1)
  'for the table object you must set the index property when
  'the recordset gets created and use the following line
  'Data1.Caption = "Record: " & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
  'This is where you put validation code
  'This event gets called when the following actions occur
  Select Case Action
    Case vbDataActionMoveFirst
'        txtCity.Text = Data1.Recordset.Fields(0).Value
'        txtProvince.Text = Data1.Recordset.Fields(1).Value
'        txtPostZone.Text = Data1.Recordset.Fields(2).Value
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose
  End Select
  
  
  Screen.MousePointer = vbHourglass
End Sub