home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
bp_6_93
/
bonus
/
dmsrc
/
faddindx.txt
< prev
next >
Wrap
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