MODIFIED SOURCE CODE FOR ADDFIELD.FRM
Made on Tuesday, Apr 8, 2003 at 9:43 AM
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Add Field"
'ResMe Converted To A Property: Const BUTTON1 = "&OK"
'ResMe Converted To A Property: Const BUTTON2 = "&Close"
'ResMe Converted To A Property: Const MSG1 = " Already exists!"
'>>>>>>>>>>>>>>>>>>>>>>>>
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 And Shift = 0 Then
DisplayTopic 2016117
End If
End Sub
Sub Form_Load()
'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
Call frmAddField_Auto_Init
Me.Caption = FORMCAPTION
cmdOK.Caption = BUTTON1
cmdClose.Caption = BUTTON2
'WAS: cboFieldType.AddItem "Boolean"
cboFieldType.AddItem LoadResString(S71_Boolean)
cboFieldType.ItemData(cboFieldType.NewIndex) = dbBoolean
cboFieldType.AddItem "Byte"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbByte
cboFieldType.AddItem "Integer"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbInteger
cboFieldType.AddItem "Long"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbLong
cboFieldType.AddItem "Currency"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbCurrency
cboFieldType.AddItem "Single"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbSingle
cboFieldType.AddItem "Double"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbDouble
cboFieldType.AddItem "Date/Time"
cboFieldType.ItemData(cboFieldType.NewIndex) = dbDate
'WAS: cboFieldType.AddItem "Text"
cboFieldType.AddItem LoadResString(S538_Text)
cboFieldType.ItemData(cboFieldType.NewIndex) = dbText
'WAS: cboFieldType.AddItem "Binary"
cboFieldType.AddItem LoadResString(S69_Binary)
cboFieldType.ItemData(cboFieldType.NewIndex) = dbLongBinary
'WAS: cboFieldType.AddItem "Memo"
cboFieldType.AddItem LoadResString(S319_Memo)
cboFieldType.ItemData(cboFieldType.NewIndex) = dbMemo
SetDefaults
'need to disable controls that don't apply
'to non Microsoft Access tables
If gsDataType <> gsMSACCESS Then
optFixedField.Enabled = False
chkAutoInc.Enabled = False
optVariable.Enabled = False
txtValidationText.Enabled = False
txtValidationRule.Enabled = False
txtDefaultValue.Enabled = False
chkRequired.Enabled = False
chkAllowZeroLen.Enabled = False
End If
End Sub
Private Sub txtFieldName_Change()
'activate the ok button only if the
'name field has something in it
cmdOK.Enabled = (Len(txtFieldName.Text) > 0)
End Sub
Private Sub cboFieldType_Click()
Dim nFldType As Integer
'call function to set size and type of field
txtFieldSize.Text = SetFldProperties(cboFieldType.ItemData(cboFieldType.ListIndex))
txtFieldSize.Enabled = False
nFldType = cboFieldType.ItemData(cboFieldType.ListIndex)
'enable appropriate controls for each field type
If gsDataType <> gsMSACCESS Then
If nFldType = dbText Then
'allow entry of field length
txtFieldSize.Enabled = True
'default field size from Access UI
txtFieldSize.Text = "50"
End If
'only do the stuff below for MDB dbs
Exit Sub
End If
If nFldType = dbText Then
'allow entry of field length
txtFieldSize.Enabled = True
'default field size from Access UI
txtFieldSize.Text = "50"
'avaiable for memo and text
chkAllowZeroLen.Enabled = True
'avaiable for text only
optVariable.Enabled = True
optFixedField.Enabled = True
'disable these controls
chkAutoInc.Enabled = False
chkAutoInc.Value = vbUnchecked
ElseIf nFldType = dbMemo Then
'avaiable for memo and text
chkAllowZeroLen.Enabled = True
'disable these controls
optVariable.Enabled = False
optFixedField.Enabled = False
chkAutoInc.Enabled = False
'set the value to 0
optVariable.Value = False
optFixedField.Value = False
chkAutoInc.Value = vbUnchecked
ElseIf nFldType = dbLong Then
'enable this one for counter type fields
chkAutoInc.Enabled = True
'disable these controls
chkAllowZeroLen.Enabled = False
optVariable.Enabled = False
optFixedField.Enabled = False
'set the value to 0
chkAllowZeroLen.Value = vbUnchecked
optVariable.Value = False
optFixedField.Value = False
Else
'disable these for all other types
chkAllowZeroLen.Enabled = False
optVariable.Enabled = False
optFixedField.Enabled = False
chkAutoInc.Enabled = False
'set the value to 0
chkAllowZeroLen.Value = vbUnchecked
optVariable.Value = False
optFixedField.Value = False
chkAutoInc.Value = vbUnchecked
End If
End Sub
Private Sub cmdOK_Click()
On Error GoTo OkayErr
Dim fld As Field 'local field structure
Dim i As Integer
'get a fresh field object
Set fld = gtdfTableDef.CreateField()
'fill the field structure
With fld
.Name = txtFieldName.Text
.Type = cboFieldType.ItemData(cboFieldType.ListIndex)
.Size = txtFieldSize.Text
If Len(txtOrdinalPos.Text) > 0 Then .OrdinalPosition = txtOrdinalPos.Text
If gsDataType = gsMSACCESS Then
.Required = IIf(chkRequired.Value = vbChecked, -1, 0)
If .Type = dbText Then
'this only applies to text
.AllowZeroLength = IIf(chkAllowZeroLen.Value = vbChecked, -1, 0)
End If
If optFixedField.Value Then
.Attributes = .Attributes Or dbFixedField
End If
If .Type = dbLong Then
'only applies to long type
If chkAutoInc.Value = vbChecked Then
.Attributes = .Attributes Or dbAutoIncrField
End If
End If
If optVariable.Value Then
.Attributes = .Attributes Or dbVariableField
End If
.ValidationText = txtValidationText.Text
.ValidationRule = txtValidationRule.Text
.DefaultValue = txtDefaultValue.Text
End If
End With
'check for a dupe
If ObjectExists(gtdfTableDef.Fields, fld.Name) Then
'WAS: MsgBox "'" & fld.Name & "'" & MSG1
MsgBox LoadResString(S3_) & fld.Name & LoadResString(S3_) & MSG1
txtFieldName.SelStart = 0
txtFieldName.SelLength = Len(txtFieldName.Text)
txtFieldName.SetFocus
Exit Sub
End If
'try to append the field
gtdfTableDef.Fields.Append fld
'must've been successful, so...
'add the item to the list
frmTblStruct.lstFields.AddItem txtFieldName
'make the new item active
frmTblStruct.lstFields.ListIndex = frmTblStruct.lstFields.NewIndex
'enable the add table button if needed
If frmTblStruct.cmdAddTable.Visible Then
frmTblStruct.cmdAddTable.Enabled = True
End If
'clear the name and allow entry of another
SetDefaults
txtFieldName.SetFocus
Exit Sub
OkayErr:
ShowError
End Sub
Private Sub SetDefaults()
txtFieldName.Text = vbNullString
If gsDataType = gsMSACCESS Then
optFixedField.Value = False
chkAutoInc.Value = vbUnchecked
optVariable.Value = True
chkRequired.Value = vbUnchecked
chkAllowZeroLen.Value = vbChecked
Else
optFixedField.Value = False
chkAutoInc.Value = 2
optVariable.Value = False
chkRequired.Value = 2
chkAllowZeroLen.Value = 2
End If
cboFieldType.ListIndex = 8 'default to text
txtFieldSize.Text = 50 'default to 50
txtValidationText.Text = vbNullString
txtValidationRule.Text = vbNullString
txtDefaultValue.Text = vbNullString
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 = "Add Field"
Property Get FORMCAPTION As String
'WAS: FORMCAPTION = "Add Field"
FORMCAPTION = LoadResString(S35_Add_Field)
End Property
'This was: Const BUTTON1 = "&OK"
Property Get BUTTON1 As String
BUTTON1 = "&OK"
End Property
'This was: Const BUTTON2 = "&Close"
Property Get BUTTON2 As String
'WAS: BUTTON2 = "&Close"
BUTTON2 = LoadResString(S94_Close)
End Property
'This was: Const MSG1 = " Already exists!"
Property Get MSG1 As String
'WAS: MSG1 = " Already exists!"
MSG1 = LoadResString(S44_Already_exists)
End Property
Private Sub frmAddField_Auto_Init()
'This routine initializes all User Interface control properties on frmAddField.
'This section of code was automatically generated by the ResMe String Extraction Utility.
'WAS: Me.Caption = "Add Field"
Me.Caption = LoadResString(S35_Add_Field)
'WAS: optVariable.Caption = "VariableField"
optVariable.Caption = LoadResString(S578_VariableField)
'WAS: optFixedField.Caption = "FixedField"
optFixedField.Caption = LoadResString(S254_FixedField)
'WAS: chkAutoInc.Caption = "AutoIncrField"
chkAutoInc.Caption = LoadResString(S65_AutoIncrField)
'WAS: chkAllowZeroLen.Caption = "AllowZeroLength"
chkAllowZeroLen.Caption = LoadResString(S43_AllowZeroLength)
'WAS: chkRequired.Caption = "Required"
chkRequired.Caption = LoadResString(S458_Required)
'WAS: cmdOK.Caption = "&OK"
cmdOK.Caption = LoadResString(S355_OK)
'WAS: cmdClose.Caption = "&Close"
cmdClose.Caption = LoadResString(S94_Close)
'WAS: lblLabels(0).Caption = " Name: "
lblLabels(0).Caption = LoadResString(S328_Name)
'WAS: lblLabels(2).Caption = " Type: "
lblLabels(2).Caption = LoadResString(S553_Type)
'WAS: lblLabels(3).Caption = " Size: "
lblLabels(3).Caption = LoadResString(S500_Size)
'WAS: lblLabels(4).Caption = "OrdinalPosition: "
lblLabels(4).Caption = LoadResString(S395_OrdinalPosition)
'WAS: lblLabels(5).Caption = "ValidationText: "
lblLabels(5).Caption = LoadResString(S568_ValidationText)
'WAS: lblLabels(6).Caption = "ValidationRule: "
lblLabels(6).Caption = LoadResString(S567_ValidationRule)
'WAS: lblLabels(7).Caption = "DefaultValue: "
lblLabels(7).Caption = LoadResString(S155_DefaultValue)
End Sub