MODIFIED SOURCE CODE FOR ADDFIELD.FRM

Made on Tuesday, Apr 8, 2003 at 9:43 AM

http://www.resourcemining.com

ADDFIELD.FRM contained 24 resource strings and 10 non-user interface strings.

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