form1.frm

这里有很多很实用的VB编程案例,方便大家学习VB.

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "电子名片"
   ClientHeight    =   5025
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   ScaleHeight     =   5025
   ScaleWidth      =   6975
   StartUpPosition =   3  '窗口缺省
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access 2000;"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   285
      Left            =   600
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   3960
      Visible         =   0   'False
      Width           =   2055
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭(&C)"
      Height          =   495
      Left            =   5040
      TabIndex        =   17
      Top             =   3480
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查询"
      Height          =   495
      Left            =   5040
      TabIndex        =   16
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除(&D)"
      Height          =   495
      Left            =   5040
      TabIndex        =   15
      Top             =   2520
      Width           =   1215
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "保存(&S)"
      Height          =   495
      Left            =   5040
      TabIndex        =   14
      Top             =   2040
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消(&C)"
      Height          =   495
      Left            =   5040
      TabIndex        =   13
      Top             =   1560
      Width           =   1215
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "新建(&N)"
      Height          =   495
      Left            =   5040
      TabIndex        =   12
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton Command6 
      Caption         =   "下一个(&B)"
      Height          =   495
      Left            =   5040
      TabIndex        =   11
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "上一个(&P)"
      Height          =   495
      Left            =   5040
      TabIndex        =   10
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   4
      Left            =   1680
      TabIndex        =   9
      Text            =   "Text5"
      Top             =   2760
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   3
      Left            =   1680
      TabIndex        =   8
      Text            =   "Text4"
      Top             =   2160
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   2
      Left            =   1680
      TabIndex        =   7
      Text            =   "Text3"
      Top             =   1560
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   1
      Left            =   1680
      TabIndex        =   6
      Text            =   "Text2"
      Top             =   960
      Width           =   3135
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Index           =   0
      Left            =   1680
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   360
      Width           =   3135
   End
   Begin VB.Label Label1 
      Caption         =   "Email"
      Height          =   495
      Index           =   4
      Left            =   360
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "电话"
      Height          =   495
      Index           =   3
      Left            =   360
      TabIndex        =   3
      Top             =   2160
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "职务"
      Height          =   495
      Index           =   2
      Left            =   360
      TabIndex        =   2
      Top             =   1560
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "工作单位"
      Height          =   495
      Index           =   1
      Left            =   360
      TabIndex        =   1
      Top             =   960
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "姓名"
      Height          =   495
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private id As Variant
Private Sub cleantext()
        Dim i As Integer
    For i = 0 To 4
            Text1(i).Text = ""
        Next i
End Sub

Public Sub initdbf()
        cmdUpdate.Enabled = True
    cmdCancel.Enabled = False
        If Data1.Recordset.RecordCount = 0 Then
            Command6.Enabled = False
        Command5.Enabled = False
            cmdRefresh.Enabled = False
            cmdDelete.Enabled = False
        Exit Sub
        End If
    If Command6.Enabled = False Then
        Command6.Enabled = True
        Command5.Enabled = True
        cmdRefresh.Enabled = True
        cmdDelete.Enabled = True
    End If
End Sub

Public Sub inittext()
        Dim i As Integer
    On Error Resume Next
    For i = 0 To 4
        Text1(i).Text = ""
        Text1(i).Text = Data1.Recordset(i)
    Next i
End Sub

Private Sub updatedbf()
    On Error Resume Next
    Dim i As Integer
    For i = 0 To 4
        Data1.Recordset(i) = Text1(i).Text
    Next i
    Data1.Recordset.Update
End Sub
 
Private Sub cmdCancel_Click()
    On Error Resume Next
    Data1.Recordset.CancelUpdate
    If id <> Null Then
         Data1.Recordset.Bookmark = id
    End If
    Call initdbf
    Call inittext
End Sub
 
Private Sub cmdClose_Click()
    End
End Sub
 
Private Sub cmdDelete_Click()
    On Error GoTo DeleteErr
    
    With Data1.Recordset
        .Delete
        If .RecordCount <> 0 Then
            .MoveNext
            If .EOF Then .MoveLast
        End If
    End With
    
    Call initdbf
    Call inittext
    Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub
 
Private Sub cmdRefresh_Click()
    If cmdCancel.Enabled = False Then
        Data1.Recordset.Edit
    End If
    Call updatedbf
    cmdCancel.Enabled = False
    cmdDelete.Enabled = True
    cmdUpdate.Enabled = True
    Command6.Enabled = True
    Command5.Enabled = True
End Sub
 
Private Sub cmdUpdate_Click()
    On Error Resume Next
    If Data1.Recordset.RecordCount <> 0 Then
        id = Data1.Recordset.Bookmark
    End If
    cleantext
    Data1.Recordset.AddNew
  
    cmdDelete.Enabled = False
    cmdUpdate.Enabled = False
    Command6.Enabled = False
    Command5.Enabled = False
    cmdRefresh.Enabled = True
    cmdCancel.Enabled = True
End Sub
 
Private Sub Command1_Click()
    Dim i
    i = InputBox("请输入要查询的姓名")
    If i <> "" Then
        Data1.Recordset.FindFirst "[姓名]='" + i + "'"
        If NoMatch Then
            MsgBox "对不起，没有发现此记录"
        Else
            Call initdbf
            Call inittext
        End If
    End If
End Sub
 
Private Sub Command5_Click()
    On Error GoTo GoPrevError

    If Not Data1.Recordset.BOF Then
         Data1.Recordset.MovePrevious
    End If
    If Data1.Recordset.BOF And Data1.Recordset.RecordCount > 0 Then
        Beep
        '已到最后返回
         Data1.Recordset.MoveFirst
    Else
        If Data1.Recordset.RecordCount > 0 Then
            Call initdbf
            Call inittext
        End If
    End If
    Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub
 
Private Sub Command6_Click()
    On Error GoTo GoNextError
    If Not Data1.Recordset.EOF Then
         Data1.Recordset.MoveNext
    End If
    If Data1.Recordset.EOF And Data1.Recordset.RecordCount > 0 Then
        Beep
        '已到最后返回
         Data1.Recordset.MoveLast
    Else
        If Data1.Recordset.RecordCount > 0 Then
            Call initdbf
            Call inittext
        End If
    End If

    Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub
 
Private Sub Form_Load()
    Dim windownamesave As String
    Data1.DatabaseName = App.Path + "\card.mdb"
    Data1.RecordSource = "card"
    Data1.Refresh
    
    Call initdbf

    If Data1.Recordset.BOF Then
        Exit Sub
    End If
    Call inittext
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    If Data1.Recordset.EditMode <> 0 Then
        Data1.Recordset.CancelUpdate
    End If
    Data1.Recordset.Close
    Set Data1.Recordset = Nothing
End Sub
 
Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub
 
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End Sub