|
-
May 27th, 2001, 08:03 PM
#1
Thread Starter
Member
Remove an item from a array;here is my code, does anybody know a better way?
Private Sub cmdDelete_Click()
On Error Resume Next
Dim X As Integer
Dim e As Integer
If Label3.Caption = 0 Then
MsgBox "For your information, there are no addresses of any sort." & vbCrLf & "If you wish to delete a address please add one!"
GoTo idiot
End If
Dim dnum As Integer 'the number of the array element to be erased
Dim fnl As Integer'size of the orginal array
Dim contain() As address'create a container array for the items not to be erased
dnum = Label1.Caption'gets the file number to be erased
fnl = Label3.Caption'gets the size of the array
ReDim contain(fnl - 1)
For X = 1 To fnl
If X <> dnum Then
contain(X).name = database(X + e).name
contain(X).phone = database(X + e).phone
contain(X).notes = database(X + e).notes
contain(X).lname = database(X + e).lname
contain(X).email = database(X + e).email
contain(X).add = database(X + e).add
End If
If X = dnum Then
contain(dnum).name = database(X + 1).name
contain(dnum).lname = database(X + 1).lname
contain(dnum).phone = database(X + 1).phone
contain(dnum).notes = database(X + 1).notes
contain(dnum).email = database(X + 1).email
contain(dnum).add = database(X + 1).add
e = 1
End If
Next X
Erase database
ReDim database(fnl - 1)
For X = 1 To fnl - 1
database(X).name = contain(X).name
database(X).lname = contain(X).lname
database(X).phone = contain(X).phone
database(X).email = contain(X).email
database(X).notes = contain(X).notes
database(X).add = contain(X).add
Next X
Erase contain
txtName.Text = database(1).name
txtPhone.Text = database(1).phone
txtNotes.Text = database(1).notes
txtLname.Text = database(1).lname
txtEmail.Text = database(1).email
txtAdd.Text = database(1).add
Label1.Caption = 1
Label3.Caption = fnl - 1
datasize = Label3.Caption
idiot:
End Sub
-
May 27th, 2001, 08:16 PM
#2
Registered User
I didn't try and read all the code, but here is an optimised routine that deletes an element in an array of Longs uses the CopyMemory API function you can modify this code to make it work with other data types by simply modifying the first "As Long" clause in the parameter list
Code:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)
Sub DeleteArrayItemLong(arr() As Long, index As Long)
' note that we Let VB evaluate the size of Each item using LenB()
If index < UBound(arr) Then
CopyMemory arr(index), arr(index + 1), _
(UBound(arr) - index) * LenB(arr(index))
End If
arr(index) = Empty
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|