frmcreateindex.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.Form frmCreateIndex 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Create Index"
   ClientHeight    =   3795
   ClientLeft      =   1590
   ClientTop       =   2265
   ClientWidth     =   6855
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3795
   ScaleWidth      =   6855
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   465
      Index           =   1
      Left            =   5400
      TabIndex        =   13
      Top             =   3150
      Width           =   1275
   End
   Begin VB.CommandButton cmd 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   465
      Index           =   0
      Left            =   3870
      TabIndex        =   12
      Top             =   3150
      Width           =   1275
   End
   Begin VB.CommandButton cmdAddField 
      Caption         =   "&Add Field"
      Height          =   465
      Left            =   990
      TabIndex        =   7
      Top             =   2070
      Width           =   1275
   End
   Begin VB.Frame fraIndex 
      Caption         =   "Index"
      Height          =   1815
      Left            =   180
      TabIndex        =   4
      Top             =   1080
      Width           =   6495
      Begin VB.CheckBox chkUnique 
         Caption         =   "&Unique"
         Height          =   375
         Left            =   4860
         TabIndex        =   11
         Top             =   1080
         Width           =   1455
      End
      Begin VB.CheckBox chkPrimary 
         Caption         =   "&Primary"
         Height          =   375
         Left            =   4860
         TabIndex        =   10
         Top             =   540
         Width           =   1365
      End
      Begin VB.ListBox lstFields 
         Height          =   1035
         Left            =   2340
         TabIndex        =   9
         Top             =   540
         Width           =   2175
      End
      Begin VB.ComboBox cboFieldName 
         Height          =   315
         Left            =   180
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   540
         Width           =   1905
      End
      Begin VB.Label lblFields 
         Caption         =   "Field &List"
         Height          =   285
         Left            =   2340
         TabIndex        =   8
         Top             =   270
         Width           =   2175
      End
      Begin VB.Label lblFieldName 
         Caption         =   "&Field Name"
         Height          =   285
         Left            =   180
         TabIndex        =   5
         Top             =   270
         Width           =   1905
      End
   End
   Begin VB.TextBox txtIndexName 
      Height          =   315
      Left            =   2520
      TabIndex        =   3
      Top             =   540
      Width           =   2175
   End
   Begin VB.ComboBox cboTableDefName 
      Height          =   315
      Left            =   180
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   540
      Width           =   2085
   End
   Begin VB.Label lblIndexName 
      Caption         =   "&Index Name"
      Height          =   285
      Left            =   2520
      TabIndex        =   2
      Top             =   270
      Width           =   2175
   End
   Begin VB.Label lblTableDefName 
      Caption         =   "&Table Name"
      Height          =   285
      Left            =   180
      TabIndex        =   0
      Top             =   270
      Width           =   2085
   End
End
Attribute VB_Name = "frmCreateIndex"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' database object
Private mdb As Database

' cancel flag
Private mblnCancel As Boolean

' flags for controlling the OK button
Private mblnHasTableDefName As Boolean
Private mblnHasIndexName As Boolean
Private mblnHasFields As Boolean

' tabledefname for property get
Private mstrTableDefName As String

' command button array constants
Private Const cmdOK = 0
Private Const cmdCancel = 1

' Public Methods

Public Sub Initialize( _
  db As DAO.Database, _
  Optional strTableDefName As String = "")
' initialize the form
' NOTE: must be called before the form is shown

  Set mdb = db
  ' populate the table combo
  GetTables

  ' set an initial table name if provided
  If strTableDefName <> "" Then
    cboTableDefName.Text = strTableDefName
    ' fill the field list
    GetFields (strTableDefName)
  End If

End Sub
Public Property Get TableDefName() As String

  TableDefName = mstrTableDefName

End Property
Public Property Get Cancelled() As Boolean

  Cancelled = mblnCancel

End Property

' Private Procedures
Private Sub EnableOK()

  If mblnHasTableDefName _
    And mblnHasIndexName And mblnHasFields Then
    cmd(cmdOK).Enabled = True
  Else
    cmd(cmdOK).Enabled = False
  End If

End Sub
Private Sub EnableIndex()

  If mblnHasTableDefName And mblnHasIndexName Then
    fraIndex.Enabled = True
  Else
    fraIndex.Enabled = False
  End If

End Sub
Private Sub GetTables()
' fill the table list combo

  Dim td As TableDef
  
  With cboTableDefName
    ' clear what (if anything) is there
    .Clear
    For Each td In mdb.TableDefs
      ' check for system table
      If (td.Attributes And dbSystemObject) = 0 Then
        ' not a system table, add it
        .AddItem td.Name
      End If
    Next  ' TableDef
  End With

End Sub
Private Sub GetFields(strTableDefName As String)
' fill the field list combo

  Dim fld As Field
  
  With cboFieldName
    ' clear it
    .Clear
    For Each fld In mdb.TableDefs(strTableDefName).Fields
      ' add it
      .AddItem fld.Name
    Next  ' Field
  End With

End Sub

' Event Procedures

Private Sub Form_Load()
' setup controls

  ' disabled until a name is set and
  ' at list one field is in the field list
  cmd(cmdOK).Enabled = False

  ' disabled until a field is chosen
  cmdAddField.Enabled = False
  
  ' disable the entire fraIndex frame
  ' until a table and index name are chosen
  fraIndex.Enabled = False

End Sub


Private Sub cboTableDefName_Click()
' setup controls and status

  ' copy it to the module level variable
  ' for later property get
  mstrTableDefName = cboTableDefName.Text
  ' text it and set flags
  If mstrTableDefName <> "" Then
    ' enable the Index frame
    mblnHasTableDefName = True
  Else
    mblnHasTableDefName = False
  End If

  EnableIndex
  EnableOK

End Sub
Private Sub txtIndexName_Change()
' set control and status flags

  If txtIndexName.Text <> "" Then
    mblnHasIndexName = True
  Else
    mblnHasIndexName = False
  End If
  
  EnableIndex
  EnableOK

End Sub
Private Sub cboFieldName_Click()
' enable/disable add field button

  If cboFieldName.Text <> "" Then
    ' enable the add field button
    cmdAddField.Enabled = True
  Else
    cmdAddField.Enabled = False
  End If

End Sub
Private Sub chkPrimary_Click()
' if it's primary, it must be unique
' set control status to indicate the
' user doesn't need to deal with the
' unique check box if primary is set

  If chkPrimary Then
    chkUnique = 1
    chkUnique.Enabled = False
  Else
    chkUnique.Enabled = True
  End If

End Sub

Private Sub cmdAddField_Click()
' add to list and remove from combo

  lstFields.AddItem cboFieldName.Text
  cboFieldName.RemoveItem cboFieldName.ListIndex
  
  ' set status flag
  mblnHasFields = True
  
  EnableOK
  
  ' return to field name combo
  cboFieldName.SetFocus

End Sub


Private Sub cmd_Click(Index As Integer)
' add the index or unload the form
On Error GoTo ProcError

  Screen.MousePointer = vbHourglass
  
  Select Case Index
    Case cmdOK
      ' add the index
      CreateIndex
      ' set cancel flag
      mblnCancel = False
      Unload Me
    Case cmdCancel
      ' set cancel flag and unload
      mblnCancel = True
      Unload Me
  End Select

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub CreateIndex()
' create the index
' called only from cmd(cmdOK) click

  Dim td As TableDef
  Dim idx As Index
  Dim fld As Field
  Dim intListIndex As Integer
  
  ' get a reference to the tabledef and
  ' create the index
  Set td = mdb.TableDefs(cboTableDefName.Text)
  Set idx = td.CreateIndex(txtIndexName.Text)
  
  ' add the fields
  For intListIndex = 0 To lstFields.ListCount - 1
    lstFields.ListIndex = intListIndex
    Set fld = idx.CreateField(lstFields.Text)
    idx.Fields.Append fld
    Set fld = Nothing
  Next  ' item in list
  
  ' set primary or unique flags
  If chkPrimary = 1 Then
    idx.Primary = True
  ElseIf chkUnique = 1 Then
    idx.Unique = True
  End If
  
  ' append the index
  td.Indexes.Append idx

End Sub