frmcreatetabledef.frm

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

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmCreateTableDef 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Create TableDef"
   ClientHeight    =   4320
   ClientLeft      =   2340
   ClientTop       =   3375
   ClientWidth     =   7125
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   7125
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmd 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   465
      Index           =   1
      Left            =   5760
      TabIndex        =   12
      Top             =   3690
      Width           =   1185
   End
   Begin VB.CommandButton cmd 
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   465
      Index           =   0
      Left            =   4410
      TabIndex        =   11
      Top             =   3690
      Width           =   1185
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "&Add"
      Height          =   465
      Left            =   5490
      TabIndex        =   9
      Top             =   1080
      Width           =   1185
   End
   Begin VB.Frame fraFields 
      Caption         =   "Fields"
      Height          =   2895
      Left            =   90
      TabIndex        =   2
      Top             =   630
      Width           =   6945
      Begin ComctlLib.ListView lvwFields 
         Height          =   1545
         Left            =   180
         TabIndex        =   10
         Top             =   1170
         Width           =   6585
         _ExtentX        =   11615
         _ExtentY        =   2725
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         _Version        =   327680
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         BorderStyle     =   1
         Appearance      =   1
         MouseIcon       =   "frmCreateTableDef.frx":0000
         NumItems        =   0
      End
      Begin VB.TextBox txtFieldSize 
         Height          =   315
         Left            =   4140
         TabIndex        =   8
         Text            =   "50"
         Top             =   630
         Width           =   735
      End
      Begin VB.ComboBox cboFieldDataType 
         Height          =   315
         Left            =   2160
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   630
         Width           =   1815
      End
      Begin VB.TextBox txtFieldName 
         Height          =   315
         Left            =   180
         TabIndex        =   4
         Top             =   630
         Width           =   1815
      End
      Begin VB.Label lblFieldSize 
         Caption         =   "Field &Size"
         Height          =   195
         Left            =   4140
         TabIndex        =   7
         Top             =   360
         Width           =   915
      End
      Begin VB.Label lblFieldType 
         Caption         =   "&Data Type"
         Height          =   195
         Left            =   2160
         TabIndex        =   5
         Top             =   360
         Width           =   1815
      End
      Begin VB.Label lblFieldName 
         Caption         =   "&Name"
         Height          =   195
         Left            =   180
         TabIndex        =   3
         Top             =   360
         Width           =   1815
      End
   End
   Begin VB.TextBox txtTableDefName 
      Height          =   375
      Left            =   1440
      TabIndex        =   1
      Top             =   90
      Width           =   2265
   End
   Begin VB.Label lblTableDefName 
      Caption         =   "&Table Name"
      Height          =   285
      Left            =   270
      TabIndex        =   0
      Top             =   180
      Width           =   1005
   End
End
Attribute VB_Name = "frmCreateTableDef"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' database object
Private mdb As Database

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

' Event procedures

Private Sub Form_Load()
' setup form
On Error GoTo ProcError
  
  Screen.MousePointer = vbHourglass
  
  ' setup fields controls
  cmdAdd.Enabled = False
  
  ' fill the data types combo
  With cboFieldDataType
    ' Note: not all field types are
    ' included here
    .Clear
    .AddItem "Boolean"
    .AddItem "Counter"
    .AddItem "Date/Time"
    .AddItem "Long Integer"
    .AddItem "Text"
    .AddItem "Memo"
  End With
  cboFieldDataType.Text = "Text"

  ' setup list view
  lvwFields.View = lvwReport
  With lvwFields.ColumnHeaders
    .Add , "Name", "Name"
    .Item("Name").Width = 2000
    .Add , "Type", "Data Type"
    .Add , "Size", "Size"
  End With

  ' disable the entire fields frame
  fraFields.Enabled = False

  ' disable OK button
  cmd(cmdOK).Enabled = False

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

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

End Sub

Private Sub cboFieldDataType_Click()

  If cboFieldDataType.Text = "Text" Then
    lblFieldSize.Enabled = True
    txtFieldSize.Enabled = True
  Else
    txtFieldSize.Text = ""
    lblFieldSize.Enabled = False
    txtFieldSize.Enabled = False
  End If

End Sub

Private Sub cmd_Click(Index As Integer)
On Error GoTo ProcError

  Screen.MousePointer = vbHourglass

  Select Case Index
    Case cmdOK
      ' add the table
      AddTable
    Case cmdCancel
      ' just unload the form
  End Select

  Unload Me

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

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

End Sub

Private Sub cmdAdd_Click()
' add to the listview
On Error GoTo ProcError

  Screen.MousePointer = vbHourglass

  Dim li As ListItem
  Dim strFieldName As String
  Dim strFieldDataType As String

  strFieldName = txtFieldName.Text
  strFieldDataType = cboFieldDataType.Text
  
  Set li = lvwFields.ListItems.Add _
    (, strFieldName, strFieldName)
  With li
    .SubItems(1) = strFieldDataType
    ' only add size if applicable
    If strFieldDataType = "Text" Then
      .SubItems(2) = txtFieldSize.Text
    Else
      .SubItems(2) = "N/A"
    End If
  End With

  ' prep for new entry
  txtFieldName.Text = ""
  txtFieldName.SetFocus
  
  ' enable the OK button
  cmd(cmdOK).Enabled = True

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

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

End Sub

Private Sub txtTableDefName_Change()
' Enable/disable controls

  cmd(cmdOK).Enabled = False
  fraFields.Enabled = False

  If Len(txtTableDefName) > 0 Then
    fraFields.Enabled = True
    If lvwFields.ListItems.Count > 0 Then
      cmd(cmdOK).Enabled = True
    End If
  End If

End Sub

Private Sub txtFieldName_Change()

  If Len(txtFieldName.Text) > 0 Then
    cmdAdd.Enabled = True
  Else
    cmdAdd.Enabled = False
  End If

End Sub

Private Sub txtFieldSize_Change()
' validate the field size value

  Dim blnBadData As Boolean
  Dim strFieldSize As String
  Dim intFieldSize As Integer
  
  blnBadData = False
  
  ' ignore if cboFieldDataType is anything but text
  If cboFieldDataType.Text = "Text" Then
    strFieldSize = txtFieldSize.Text
    ' do tests
    If Not IsNumeric(strFieldSize) Then
      MsgBox "The Field Size must be a number."
      blnBadData = True
    Else
      intFieldSize = CInt(strFieldSize)
      If (intFieldSize < 1) Or (intFieldSize > 255) Then
        MsgBox _
          "The Field Size must be a number between 1 and 255."
      End If
      blnBadData = True
    End If
    If blnBadData Then
      txtFieldSize.SetFocus
    End If
  End If

End Sub

' private general procedures
Private Sub AddTable()

  Dim li As ListItem
  
  Dim td As TableDef
  Dim fld As Field
  Dim lngType As Long
  
  Dim strFieldName As String
  Dim strFieldDataType As String
  
  Set td = mdb.CreateTableDef(txtTableDefName.Text)
  
  ' add the fields
  For Each li In lvwFields.ListItems
    ' get the name
    strFieldName = li.Text
    ' get the data type
    strFieldDataType = li.SubItems(1)
    Select Case strFieldDataType
      Case "Boolean"
        lngType = dbBoolean
      Case "Counter"
        lngType = dbLong
      Case "Date/Time"
        lngType = dbDate
      Case "Long Integer"
        lngType = dbLong
      Case "Text"
        lngType = dbText
      Case "Memo"
        lngType = dbMemo
    End Select
    ' check field type
    If lngType = dbText Then
      ' text, create with size
      Set fld = td.CreateField _
        (strFieldName, dbText, CInt(li.SubItems(2)))
    Else
      ' other, create without size
      Set fld = td.CreateField(strFieldName, lngType)
      If strFieldDataType = "Counter" Then
        fld.Attributes = fld.Attributes Or dbAutoIncrField
      End If
    End If
    td.Fields.Append fld
    Set fld = Nothing
  Next  ' ListItem
  
  ' append the tabledef
  mdb.TableDefs.Append td

End Sub

' public properties
Public Property Set Database(db As DAO.Database)

  Set mdb = db

End Property