Programming Tool Box/SIMS_2.iso/bp_6_93/bonus/dmsrc/faddindx.txt

Text File | 1995-02-26 | 4KB | 144 lines

Sub cAdd_Click (Index As Integer)
    Dim PlMn As String

    PlMn = "+"
    If Index = 1 Then PlMn = "-"

    cFields.AddItem PlMn & cFieldList.List(cFieldList.ListIndex)
    cFieldList.RemoveItem cFieldList.ListIndex

    cFieldList.ListIndex = -1
    For I = 0 To 1
        cAdd(I).Enabled = False
    Next I
    If cFields.ListCount > 0 And cIndexName <> "" Then
        cDone.Enabled = True
        cDone.Default = True
    End If
    cFieldList.SetFocus
End Sub

Sub cCancel_Click ()
'Close Dialog
Unload fAddIndex
End Sub

Sub cDone_Click ()
    Dim idx As New Index
    Dim tempFields As String
    Dim temp As String
    Dim I As Integer
    Dim AddErr As Integer

    On Error Resume Next

    'Set up index properties
    idx.Name = cIndexName
    idx.Primary = -cPrimary
    idx.Unique = -cUnique
    tempFields = ""
    For I = 0 To cFields.ListCount - 1
        temp = cFields.List(I)
        temp = Left$(temp, 1) & "[" & Right$(temp, Len(temp) - 1) & "]"
        tempFields = tempFields + temp + ";"
    Next I
    If Len(tempFields) > 255 Then
        MsgBox "Too many fields in Index.  Remove some and try again.", 64, "Data Manager"
    Else
        'Remove the last semicolon
        idx.Fields = Left$(tempFields, Len(tempFields) - 1)

        'Append to the Index Collection
        gDatabase.TableDefs(cTableName).Indexes.Append idx
        AddErr = Err
        If AddErr <> 0 Then
            MsgBox "Error Adding Index: " + Chr$(13) + Error$, 64, "Data Manager"
        End If

        If AddErr = 3283 Then 'Primary Key already exists
            'cPrimary = 0
        ElseIf AddErr = 3277 Then 'Too many fields in list
            cFields.ListIndex = 0
        Else
            'Close Dialog
            Unload fAddIndex
        End If
    End If
End Sub

Sub cFieldList_Click ()
    If cFieldList.ListIndex <> -1 Then
        cAdd(0).Enabled = True
        cAdd(1).Enabled = True
        cRemove.Enabled = False
        cFields.ListIndex = -1
        cAdd(0).Default = True
    End If
End Sub

Sub cFieldList_DblClick ()
    'Add the item
    cAdd_Click (0)
End Sub

Sub cFields_Click ()
    If cFields.ListIndex <> -1 Then
        cFieldList.ListIndex = -1
        cRemove.Enabled = True
        cAdd(0).Enabled = False
        cAdd(1).Enabled = False
    End If
End Sub

Sub cFields_DblClick ()
    'Remove the item
    cRemove_Click
End Sub

Sub cIndexName_Change ()
    If cFields.ListCount > 0 And cIndexName <> "" Then
        cDone.Enabled = True
        cDone.Default = True
    Else
        cDone.Enabled = False
    End If
End Sub

Sub cRemove_Click ()
    Dim temp As String
    temp = cFields.List(cFields.ListIndex)
    cFields.RemoveItem cFields.ListIndex

    cFieldList.AddItem Right$(temp, Len(temp) - 1)

    If cFields.ListCount <= 0 Then
        cDone.Enabled = False
    End If
    cFieldList.ListIndex = 0
    cFieldList.SetFocus
End Sub

Sub Form_Activate ()
    Dim I As Integer
    Dim TD As Tabledef
    Dim FieldCount As Integer

    On Error Resume Next

    Screen.MousePointer = 11
    Set TD = gDatabase.TableDefs(cTableName.Caption)
    FieldCount = TD.Fields.Count
    If FieldCount > 0 Then 'it should be
        For I = 0 To FieldCount - 1
            If TD.Fields(I).Type <= 10 Then  'not ole or memo
                cFieldList.AddItem TD.Fields(I).Name
            End If
        Next I
    End If
    Screen.MousePointer = 0
    'enable buttons
    cDone.Enabled = False

End Sub