Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Table Structure"
'ResMe Converted To A Property: Const BUTTON1 = "&Add Field"
'ResMe Converted To A Property: Const BUTTON2 = "&Remove Field"
'ResMe Converted To A Property: Const BUTTON3 = "Add &Index"
'ResMe Converted To A Property: Const BUTTON4 = "Re&move Index"
'ResMe Converted To A Property: Const BUTTON5 = "&Build the Table"
'ResMe Converted To A Property: Const BUTTON6 = "&Close"
'ResMe Converted To A Property: Const BUTTON7 = "&Print Structure"
'ResMe Converted To A Property: Const Label1 = "Table &Name:"
'ResMe Converted To A Property: Const Label2 = "&Field List:"
'ResMe Converted To A Property: Const LABEL3 = "Inde&x List:"
'ResMe Converted To A Property: Const MSG1 = "Enter New Field Parameters, Press 'Close' when finished"
'ResMe Converted To A Property: Const MSG2 = "Enter New Index Parameters, Press 'Close' when finished"
'ResMe Converted To A Property: Const MSG3 = "Adding the New Table to the Database"
'ResMe Converted To A Property: Const MSG4 = "Remove Index?"
'ResMe Converted To A Property: Const MSG5 = "Opening Design Form"
'ResMe Converted To A Property: Const MSG6 = "Printing Table Structure"
'ResMe Converted To A Property: Const MSG7 = "Remove Field?"
'ResMe Converted To A Property: Const MSG8 = "Close without saving?"
'>>>>>>>>>>>>>>>>>>>>>>>>

Dim msCurrField As String
Dim mfldCurrFld As Field
Dim msCurrIndex As String
Dim mindCurrInd As Index
Dim mnFldCount As Integer
Dim mnIndCount As Integer
Dim mbTableNameChanged As Boolean

Sub cboFieldType_Change()
  If mfldCurrFld.Type < 9 Then
    cboFieldType.ListIndex = mfldCurrFld.Type - 1
  Else
    cboFieldType.ListIndex = mfldCurrFld.Type - 2
  End If
End Sub

Sub cboFieldType_Click()
  If cboFieldType.ListIndex = -1 Then Exit Sub
  If mfldCurrFld.Type < 9 Then
    cboFieldType.ListIndex = mfldCurrFld.Type - 1
  Else
    cboFieldType.ListIndex = mfldCurrFld.Type - 2
  End If
End Sub

Private Sub chkAllowZeroLen_Click()
  On Error GoTo AZErr
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  mfldCurrFld.AllowZeroLength = IIf(chkAllowZeroLen.Value = vbChecked, True, False)
  Exit Sub
  
AZErr:
  ShowError
End Sub


Private Sub chkRequired_Click()
  On Error GoTo RQErr
  If mfldCurrFld Is Nothing Then Exit Sub
  
  mfldCurrFld.Required = IIf(chkRequired.Value = vbChecked, True, False)
  Exit Sub
  
RQErr:
  ShowError
End Sub

Private Sub cmdAddField_Click()
  MsgBar MSG1, False
  frmAddField.Show vbModal
  MsgBar vbNullString, False
End Sub

Private Sub cmdAddIndex_Click()
  MsgBar MSG2, False
  frmAddIndex.Show vbModal
  MsgBar vbNullString, False
End Sub

Private Sub cmdAddTable_Click()
  On Error GoTo ATErr

  Dim i As Integer

  If DupeTableName(gtdfTableDef.Name) Then
    Screen.MousePointer = vbDefault
    Exit Sub
  End If
  
  Screen.MousePointer = vbHourglass
  MsgBar MSG3, True

  'append the tabledef
  gdbCurrentDB.TableDefs.Append gtdfTableDef

  RefreshTables Nothing

  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Unload Me
  Exit Sub

ATErr:
  ShowError
End Sub

Private Sub cmdClose_Click()
  If mbTableNameChanged Then
    RefreshTables Nothing
  End If
  If cmdAddTable.Visible And cmdAddTable.Enabled Then
    If MsgBox(MSG8, vbYesNo + vbQuestion, Me.Caption) = vbYes Then
      Unload Me
      MsgBar vbNullString, False
    End If
  Else
    Unload Me
    MsgBar vbNullString, False
  End If
End Sub

Sub lstFields_Click()
  On Error GoTo FErr

  If lstFields.ListIndex = -1 Then Exit Sub
  
  msCurrField = lstFields.Text
  Set mfldCurrFld = gtdfTableDef.Fields(msCurrField)
    
  'only enable these fields if there is a current field in an Access db
  txtFieldName.Enabled = (gsDataType = gsMSACCESS)
  txtValidationText.Enabled = (gsDataType = gsMSACCESS)
  txtValidationRule.Enabled = (gsDataType = gsMSACCESS)
  txtDefaultValue.Enabled = (gsDataType = gsMSACCESS)
  chkRequired.Enabled = (gsDataType = gsMSACCESS)
  chkAllowZeroLen.Enabled = (gsDataType = gsMSACCESS)
  txtOrdinalPos.Enabled = (gsDataType = gsMSACCESS)
  
  'unlock the name field
  txtFieldName.Locked = False
  txtFieldName.Text = mfldCurrFld.Name
  txtOrdinalPos.Text = mfldCurrFld.OrdinalPosition
  If mfldCurrFld.Type < 9 Then
    cboFieldType.ListIndex = mfldCurrFld.Type - 1
  Else
    cboFieldType.ListIndex = mfldCurrFld.Type - 2
  End If
  txtFieldSize.Text = mfldCurrFld.Size
  txtCollatingOrder.Text = mfldCurrFld.CollatingOrder
  chkFixedField.Value = IIf((mfldCurrFld.Attributes And dbFixedField) = dbFixedField, 1, 0)
  chkVariable.Value = IIf((mfldCurrFld.Attributes And dbVariableField) = dbVariableField, 1, 0)
  chkAutoInc.Value = IIf((mfldCurrFld.Attributes And dbAutoIncrField) = dbAutoIncrField, 1, 0)
  
  If gsDataType = gsMSACCESS Then
    txtValidationText.Text = mfldCurrFld.ValidationText
    txtValidationRule.Text = mfldCurrFld.ValidationRule
    txtDefaultValue.Text = mfldCurrFld.DefaultValue
    chkRequired.Value = IIf(mfldCurrFld.Required, 1, 0)
    chkAllowZeroLen.Value = IIf(mfldCurrFld.AllowZeroLength, 1, 0)
  End If
  
  Exit Sub
  
FErr:
  ShowError
End Sub

Sub lstIndexes_Click()
  On Error GoTo IErr

  If lstIndexes.ListIndex = -1 Then Exit Sub
  
  msCurrIndex = lstIndexes.Text
  Set mindCurrInd = gtdfTableDef.Indexes(msCurrIndex)
    
  txtIndexName.Text = mindCurrInd.Name
  txtFields.Text = mindCurrInd.Fields
  chkRequiredInd.Value = IIf(mindCurrInd.Required, 1, 0)
  chkUnique.Value = IIf(mindCurrInd.Unique, 1, 0)
  chkIgnoreNull.Value = IIf(mindCurrInd.IgnoreNulls, 1, 0)
  
  If gsDataType = gsMSACCESS Then
    chkPrimary.Value = IIf(mindCurrInd.Primary, 1, 0)
    chkForeign.Value = IIf(mindCurrInd.Foreign, 1, 0)
  End If
  
  Exit Sub
  
IErr:
  ShowError
End Sub

Private Sub txtCollatingOrder_LostFocus()
  If mfldCurrFld Is Nothing Then Exit Sub
  
  'reset it because it is readonly
  txtCollatingOrder.Text = mfldCurrFld.CollatingOrder
End Sub

Private Sub txtDefaultValue_LostFocus()
  On Error GoTo DVErr
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  If mfldCurrFld.DefaultValue <> txtDefaultValue.Text Then
    If Len(txtDefaultValue.Text) > 0 Then
      mfldCurrFld.DefaultValue = txtDefaultValue.Text
    End If
  End If
  Exit Sub
  
DVErr:
  ShowError
End Sub

Private Sub txtFieldName_LostFocus()
  On Error GoTo FNErr
  
  Dim i As Integer
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  'change the name if the user changed it
  If mfldCurrFld.Name <> txtFieldName.Text Then
    If Len(txtFieldName.Text) > 0 Then
      For i = 0 To lstFields.ListCount - 1
        If lstFields.List(i) = mfldCurrFld.Name Then
          lstFields.RemoveItem i
          lstFields.AddItem txtFieldName.Text, i
          Exit For
        End If
      Next
      mfldCurrFld.Name = txtFieldName.Text
    End If
  End If
  Exit Sub
  
FNErr:
  ShowError
End Sub

Sub txtFields_LostFocus()
  If mindCurrInd Is Nothing Then Exit Sub
  
  'reset it because it is readonly
  txtFields.Text = mindCurrInd.Fields
End Sub

Private Sub txtFieldSize_LostFocus()
  If mfldCurrFld Is Nothing Then Exit Sub
  
  'reset it because it is readonly
  txtFieldSize.Text = mfldCurrFld.Size
End Sub

Private Sub txtIndexName_LostFocus()
  On Error GoTo IDNErr
  
  Dim i As Integer
  
  If mindCurrInd Is Nothing Then Exit Sub
  
  'change the name if the user changed it
  If mindCurrInd.Name <> txtIndexName.Text Then
    If Len(txtIndexName.Text) > 0 And gsDataType = gsMSACCESS Then
      For i = 0 To lstIndexes.ListCount - 1
        If lstIndexes.List(i) = mindCurrInd.Name Then
          lstIndexes.RemoveItem i
          lstIndexes.AddItem txtIndexName.Text, i
          Exit For
        End If
      Next
      mindCurrInd.Name = txtIndexName.Text
    End If
  End If
  Exit Sub
  
IDNErr:
  ShowError
End Sub

Private Sub txtOrdinalPos_LostFocus()
  On Error GoTo OPErr
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  If mfldCurrFld.OrdinalPosition <> txtOrdinalPos.Text Then
    If Len(txtFieldName.Text) > 0 And gsDataType = gsMSACCESS Then
      mfldCurrFld.OrdinalPosition = txtOrdinalPos.Text
    End If
  End If
  Exit Sub
  
OPErr:
  ShowError
End Sub

Private Sub txtTableName_Change()
  If gbAddTableFlag Then
    If Len(txtTableName.Text) > 0 And lstFields.ListCount > 0 Then
      cmdAddTable.Enabled = True
    Else
      cmdAddTable.Enabled = False
    End If
    gtdfTableDef.Name = txtTableName.Text
  End If
End Sub

Private Sub txtTableName_LostFocus()
  On Error GoTo TBNErr
  
  Dim i As Integer
  
  'change the name if the user changed it
  If gtdfTableDef.Name <> txtTableName.Text Then
    If Len(txtTableName.Text) > 0 And gsDataType = gsMSACCESS Then
      'find and rename the entry in the tables form list
      gtdfTableDef.Name = txtTableName.Text
      mbTableNameChanged = True
    End If
  End If
  Exit Sub
  
TBNErr:
  ShowError
End Sub

Private Sub txtTableName_KeyPress(KeyAscii As Integer)
  If txtTableName.TabStop = False Then
    KeyAscii = 0   'throw away the key
  End If
End Sub

Private Sub cmdRemoveIndex_Click()
  On Error GoTo DELErr

  If lstIndexes.ListIndex < 0 Then Exit Sub
  
  If MsgBox(MSG4, vbYesNo + vbQuestion) = vbYes Then
    If gbAddTableFlag = False Then
      gtdfTableDef.Indexes.Delete lstIndexes.Text
    End If
    'refresh the list of indexes
    lstIndexes.RemoveItem lstIndexes.ListIndex
  End If
  
  'clear out the properties
  txtIndexName.Text = vbNullString
  txtFields.Text = vbNullString
  chkRequiredInd.Value = vbUnchecked
  chkUnique.Value = vbUnchecked
  chkIgnoreNull.Value = vbUnchecked
  chkPrimary.Value = vbUnchecked
  chkForeign.Value = vbUnchecked
  
  Exit Sub

DELErr:
  ShowError
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016147
  End If
End Sub

Private Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmTblStruct_Auto_Init
  On Error GoTo LoadErr
  
  Dim fld As Field
  Dim idx As Index
  
  Me.Caption = FORMCAPTION
  cmdAddField.Caption = BUTTON1
  cmdRemoveField.Caption = BUTTON2
  cmdAddIndex.Caption = BUTTON3
  cmdRemoveIndex.Caption = BUTTON4
  cmdAddTable.Caption = BUTTON5
  cmdClose.Caption = BUTTON6
  cmdPrint.Caption = BUTTON7
  lblLabels(0).Caption = Label1
  lblLabels(1).Caption = Label2
  lblLabels(2).Caption = LABEL3
  
  Screen.MousePointer = vbHourglass
  MsgBar MSG5, True
  
  cboFieldType.AddItem "Boolean"
  cboFieldType.AddItem "Byte"
  cboFieldType.AddItem "Integer"
  cboFieldType.AddItem "Long"
  cboFieldType.AddItem "Currency"
  cboFieldType.AddItem "Single"
  cboFieldType.AddItem "Double"
  cboFieldType.AddItem "Date/Time"
  cboFieldType.AddItem "Text"
  cboFieldType.AddItem "Binary"
  cboFieldType.AddItem "Memo"
  
  If gbAddTableFlag Then
    Set gtdfTableDef = gdbCurrentDB.CreateTableDef()
    mnFldCount = 0
    mnIndCount = 0
    cmdAddTable.Visible = True
  Else
    cmdPrint.Visible = True
    Set gtdfTableDef = gdbCurrentDB.TableDefs(StripConnect(gnodDBNode2.Text))
    txtTableName.Text = gtdfTableDef.Name
    ListItemNames gtdfTableDef.Fields, lstFields, False
    mnFldCount = lstFields.ListCount
    lstFields.ListIndex = 0
    ListItemNames gtdfTableDef.Indexes, lstIndexes, False
    mnIndCount = lstIndexes.ListCount
    If mnIndCount > 0 Then lstIndexes.ListIndex = 0
  End If
  
  If gsDataType <> gsMSACCESS Then
    'can't change table names on non-mdbs
    If gbAddTableFlag = False Then txtTableName.Locked = True
    'can't remove fields on non-mdb tables
    If gbAddTableFlag = False Then cmdRemoveField.Enabled = False
    'disable other properties that are not changable on non-mdb tables
    txtFieldName.Locked = True
    chkRequired.Enabled = False
    chkAllowZeroLen.Enabled = False
    
    txtIndexName.Locked = True
    txtFields.Locked = True
  End If
  
  Screen.MousePointer = vbDefault
  MsgBar vbNullString, False
  Exit Sub

LoadErr:
  ShowError
  Unload Me
End Sub

Private Sub cmdPrint_Click()
  On Error GoTo PRTErr
  
  'this routine simply prints the currently
  'selected table's definition

  Dim i As Integer
  Dim sTmp As String

  MsgBar MSG6, True
  Printer.Print
  Printer.Print
  Printer.Print
  Printer.Print "Database: " & gsDBName
  Printer.Print
  Printer.Print
  Printer.Print "Table Definition for " & txtTableName
  Printer.Print
  Printer.Print
  Printer.Print "Fields: (Name - Type - Size)"
  Printer.Print String(60, "-")
  For i = 0 To lstFields.ListCount - 1
    lstFields.ListIndex = i
    sTmp = txtFieldName.Text & " - "
    sTmp = sTmp & cboFieldType.Text & " - "
    sTmp = sTmp & txtFieldSize.Text
    Printer.Print sTmp
  Next
  Printer.Print
  Printer.Print
  Printer.Print "Indexes (Name - Fields - Unique)"
  Printer.Print String(60, "-")
  For i = 0 To lstIndexes.ListCount - 1
    sTmp = txtIndexName.Text & " - "
    sTmp = sTmp & txtFields.Text & " - "
    sTmp = sTmp & IIf(chkUnique = 1, "True", "False")
    Printer.Print sTmp
  Next
  Printer.NewPage
  Printer.EndDoc
  MsgBar vbNullString, False
  Exit Sub
  
PRTErr:
  ShowError
End Sub

Private Sub cmdRemoveField_Click()
  On Error GoTo RFErr

  If lstFields.ListIndex < 0 Then Exit Sub

  If MsgBox(MSG7, vbYesNo + vbQuestion) = vbYes Then
    'clear out the field property values
    txtFieldName.Text = vbNullString
    txtOrdinalPos.Text = vbNullString
    cboFieldType.ListIndex = -1
    cboFieldType.Text = vbNullString
    txtFieldSize.Text = vbNullString
    txtCollatingOrder.Text = vbNullString
    chkFixedField.Value = vbUnchecked
    chkVariable.Value = vbUnchecked
    chkAutoInc.Value = vbUnchecked
    txtValidationText.Text = vbNullString
    txtValidationRule.Text = vbNullString
    txtDefaultValue.Text = vbNullString
    chkRequired.Value = vbUnchecked
    chkAllowZeroLen.Value = vbUnchecked
    'remove from the tabledef structure
    gtdfTableDef.Fields.Delete lstFields.Text
    'remove from my list
    lstFields.RemoveItem lstFields.ListIndex
  End If
  If lstFields.ListCount = 0 Then
    'no fields so disable the build button
    cmdAddTable.Enabled = False
  End If
  
  Exit Sub

RFErr:
  ShowError
End Sub


Private Sub txtValidationRule_LostFocus()
  On Error GoTo VRErr
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  If mfldCurrFld.ValidationRule <> txtValidationRule.Text Then
    If Len(txtValidationRule.Text) > 0 And gsDataType = gsMSACCESS Then
      mfldCurrFld.ValidationRule = txtValidationRule.Text
    End If
  End If
  Exit Sub
  
VRErr:
  ShowError
End Sub

Private Sub txtValidationText_LostFocus()
  On Error GoTo VTErr
  
  If mfldCurrFld Is Nothing Then Exit Sub
  
  If mfldCurrFld.ValidationText <> txtValidationText.Text Then
    If Len(txtValidationText.Text) > 0 And gsDataType = gsMSACCESS Then
      mfldCurrFld.ValidationText = txtValidationText.Text
    End If
  End If
  Exit Sub
  
VTErr:
  ShowError
End Sub


'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "Table Structure"
Property Get FORMCAPTION As String
    FORMCAPTION = "Table Structure"
End Property

'This was: Const BUTTON1 = "&Add Field"
Property Get BUTTON1 As String
    BUTTON1 = "&Add Field"
End Property

'This was: Const BUTTON2 = "&Remove Field"
Property Get BUTTON2 As String
    BUTTON2 = "&Remove Field"
End Property

'This was: Const BUTTON3 = "Add &Index"
Property Get BUTTON3 As String
    BUTTON3 = "Add &Index"
End Property

'This was: Const BUTTON4 = "Re&move Index"
Property Get BUTTON4 As String
    BUTTON4 = "Re&move Index"
End Property

'This was: Const BUTTON5 = "&Build the Table"
Property Get BUTTON5 As String
    BUTTON5 = "&Build the Table"
End Property

'This was: Const BUTTON6 = "&Close"
Property Get BUTTON6 As String
    BUTTON6 = "&Close"
End Property

'This was: Const BUTTON7 = "&Print Structure"
Property Get BUTTON7 As String
    BUTTON7 = "&Print Structure"
End Property

'This was: Const Label1 = "Table &Name:"
Property Get Label1 As String
    Label1 = "Table &Name:"
End Property

'This was: Const Label2 = "&Field List:"
Property Get Label2 As String
    Label2 = "&Field List:"
End Property

'This was: Const LABEL3 = "Inde&x List:"
Property Get LABEL3 As String
    LABEL3 = "Inde&x List:"
End Property

'This was: Const MSG1 = "Enter New Field Parameters, Press 'Close' when finished"
Property Get MSG1 As String
    MSG1 = "Enter New Field Parameters, Press 'Close' when finished"
End Property

'This was: Const MSG2 = "Enter New Index Parameters, Press 'Close' when finished"
Property Get MSG2 As String
    MSG2 = "Enter New Index Parameters, Press 'Close' when finished"
End Property

'This was: Const MSG3 = "Adding the New Table to the Database"
Property Get MSG3 As String
    MSG3 = "Adding the New Table to the Database"
End Property

'This was: Const MSG4 = "Remove Index?"
Property Get MSG4 As String
    MSG4 = "Remove Index?"
End Property

'This was: Const MSG5 = "Opening Design Form"
Property Get MSG5 As String
    MSG5 = "Opening Design Form"
End Property

'This was: Const MSG6 = "Printing Table Structure"
Property Get MSG6 As String
    MSG6 = "Printing Table Structure"
End Property

'This was: Const MSG7 = "Remove Field?"
Property Get MSG7 As String
    MSG7 = "Remove Field?"
End Property

'This was: Const MSG8 = "Close without saving?"
Property Get MSG8 As String
    MSG8 = "Close without saving?"
End Property


Private Sub frmTblStruct_Auto_Init()
'This routine initializes all User Interface control properties on frmTblStruct.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    Me.Caption = "Table Structure"
    chkUnique.Caption = "Unique"
    chkRequiredInd.Caption = "Required"
    chkIgnoreNull.Caption = "IgnoreNull"
    chkPrimary.Caption = "Primary"
    chkForeign.Caption = "Foreign"
    chkRequired.Caption = "Required"
    chkAllowZeroLen.Caption = "AllowZeroLength"
    chkAutoInc.Caption = "AutoIncrement"
    chkVariable.Caption = "VariableLength"
    chkFixedField.Caption = "FixedLength"
    cmdAddTable.Caption = "&Build the Table"
    cmdClose.Caption = "&Close"
    cmdPrint.Caption = "&Print Structure"
    cmdRemoveIndex.Caption = "Re&move Index"
    cmdAddIndex.Caption = "Add &Index"
    cmdAddField.Caption = "&Add Field"
    cmdRemoveField.Caption = "&Remove Field"
    lblLabels(24).Caption = "Name: "
    lblLabels(20).Caption = "Name: "
    lblLabels(23).Caption = "Fields: "
    lblLabels(10).Caption = "DefaultValue: "
    lblLabels(9).Caption = "ValidationRule: "
    lblLabels(8).Caption = "ValidationText: "
    lblLabels(7).Caption = "OrdinalPosition: "
    lblLabels(5).Caption = "Size: "
    lblLabels(4).Caption = "Type: "
    lblLabels(22).Caption = "CollatingOrder: "
    lblLabels(2).Caption = " Index List: "
    lblLabels(1).Caption = "Field List: "
    lblLabels(0).Caption = "Table Name: "
End Sub