Author | Message | Time |
---|---|---|
R.a.B.B.i.T | Okay, a while back I wrote a class to handle my queues my new bots. I was wondering if anyone has any ideas on how to make it better than it is. *Note: I added the headers today, everything else has remained unchanged for ~3 months [code]'--------------------------------------------------------------------------------------- ' Module : clsQueue ' DateTime : 11/20/2004 14:41 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Queue handler, very useful :) ' Notes : All these handy comments, error handlers, and line numbers were ' made with the help of MZTools (http://www.mztools.com/) '--------------------------------------------------------------------------------------- Option Explicit Private QList() As String '--------------------------------------------------------------------------------------- ' Procedure : Clear ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Reset the queue manually '--------------------------------------------------------------------------------------- Public Sub Clear() On Error GoTo Clear_Error ReDim QList(0) On Error GoTo 0 Exit Sub Clear_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : GetDelay ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Get the delay which should be used before sending the message '--------------------------------------------------------------------------------------- Public Function GetDelay() As Long Dim buf As Long, buffer$ On Error GoTo GetDelay_Error buffer = QList(LBound(QList)) buf = Len(buffer) * 100 On Error GoTo 0 Exit Function GetDelay_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Function '--------------------------------------------------------------------------------------- ' Procedure : Add ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Add a message to the queue, setting Force = True moves everything else ' up by 1 index and inserts the new message at slot 0 '--------------------------------------------------------------------------------------- Public Sub Add(ByVal Message As String, Optional ByVal Force As Boolean = False) On Error GoTo Add_Error If Force Then Shift QList(0) = Message Else If QList(UBound(QList)) <> "" Then ReDim Preserve QList(UBound(QList) + 1) End If QList(UBound(QList)) = Message End If On Error GoTo 0 Exit Sub Add_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : Del ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Delete a message based on what it is '--------------------------------------------------------------------------------------- Public Sub Del(ByVal Message As String) Dim i& On Error GoTo Del_Error For i = LBound(QList) To UBound(QList) DoEvents If QList(i) = Message Then QList(i) = vbNullString GoTo EndSub End If Next i Exit Sub EndSub: ClearNull On Error GoTo 0 Exit Sub Del_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : DelIndex ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Delete the message in slot INDEX regardless of the data in that slot '--------------------------------------------------------------------------------------- Public Sub DelIndex(ByVal Index As Integer) On Error GoTo DelIndex_Error If Index <= UBound(QList) And Index >= LBound(QList) Then QList(Index) = vbNullString ClearNull End If EndSub: ClearNull On Error GoTo 0 Exit Sub DelIndex_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : Shift ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Shift the queue X places north. Useful for forcing multiple messages at ' one time '--------------------------------------------------------------------------------------- Public Sub Shift(Optional ByVal Offset As Integer = 1) Dim TempQ() As String Dim i As Integer On Error GoTo Shift_Error For i = LBound(QList) To UBound(QList) DoEvents ReDim Preserve TempQ(i + Offset) TempQ(i + Offset) = QList(i) Next i For i = LBound(TempQ) To UBound(TempQ) DoEvents If i > UBound(QList) Then ReDim Preserve QList(i) End If QList(i) = TempQ(i) Next i On Error GoTo 0 Exit Sub Shift_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : ClearNull ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Remove all blank entries to help reduce clutter and search time (in larger ' arrays) '--------------------------------------------------------------------------------------- Private Sub ClearNull() Dim TempQ() As String On Error GoTo ClearNull_Error ReDim TempQ(0) Dim i As Long For i = LBound(QList) To UBound(QList) DoEvents If TempQ(UBound(TempQ)) <> vbNullString Then ReDim Preserve TempQ(UBound(TempQ) + 1) If QList(i) <> vbNullString Then TempQ(UBound(TempQ)) = QList(i) Next i ReDim QList(0) For i = LBound(TempQ) To UBound(TempQ) DoEvents If QList(UBound(QList)) <> vbNullString Then ReDim Preserve QList(UBound(QList) + 1) If TempQ(i) <> vbNullString Then QList(UBound(QList)) = TempQ(i) Next i On Error GoTo 0 Exit Sub ClearNull_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : GetCount ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Get the total number of items in the queue '--------------------------------------------------------------------------------------- Public Function GetCount() As Integer On Error GoTo GetCount_Error GetCount = UBound(QList) + 1 On Error GoTo 0 Exit Function GetCount_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Function '--------------------------------------------------------------------------------------- ' Procedure : GetLBound ' DateTime : 11/20/2004 14:44 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Get the LBound of the queue array '--------------------------------------------------------------------------------------- Public Function GetLBound() As Long On Error GoTo GetLBound_Error GetLBound = LBound(QList) On Error GoTo 0 Exit Function GetLBound_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Function '--------------------------------------------------------------------------------------- ' Procedure : GetUBound ' DateTime : 11/20/2004 14:45 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Get the UBound of the queue array '--------------------------------------------------------------------------------------- Public Function GetUBound() As Long On Error GoTo GetUBound_Error GetUBound = UBound(QList) On Error GoTo 0 Exit Function GetUBound_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Function '--------------------------------------------------------------------------------------- ' Procedure : GetItem ' DateTime : 11/20/2004 14:45 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Get the data in slot X '--------------------------------------------------------------------------------------- Public Function GetItem(ByVal Index As Integer) As String On Error GoTo GetItem_Error GetItem = QList(Index) On Error GoTo 0 Exit Function GetItem_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Function '--------------------------------------------------------------------------------------- ' Procedure : disp ' DateTime : 11/20/2004 14:45 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Mainly for debugging; print the entire queue into the Immediate window ' along with its index value '--------------------------------------------------------------------------------------- Public Sub disp() Dim i As Integer On Error GoTo disp_Error For i = LBound(QList) To UBound(QList) DoEvents Debug.Print i & " " & QList(i) Next i On Error GoTo 0 Exit Sub disp_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : Class_Initialize ' DateTime : 11/20/2004 14:45 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Reset the queue array when the class is loaded '--------------------------------------------------------------------------------------- Private Sub Class_Initialize() On Error GoTo Class_Initialize_Error ReDim QList(0) On Error GoTo 0 Exit Sub Class_Initialize_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub '--------------------------------------------------------------------------------------- ' Procedure : Class_Terminate ' DateTime : 11/20/2004 14:45 ' Author : R.a.B.B.i.T)DK( ' www.clandke.net ' Purpose : Destroy the queue array when it the class is no longer being used '--------------------------------------------------------------------------------------- Private Sub Class_Terminate() On Error GoTo Class_Terminate_Error Erase QList On Error GoTo 0 Exit Sub Class_Terminate_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub[/code] | November 20, 2004, 7:57 PM |
K | [code] ReDim Preserve QList(UBound(QList) + 1) [/code] When you need to resize your array, think ahead; don't keep re-allocating (space + 1); allocate more space than you need, usually 2*space. This way you won't have to be continually re-allocating / copying memory and your class will be more efficient. | November 21, 2004, 1:55 AM |
R.a.B.B.i.T | ClearNull would immediately change that, though, and cut off all empty slots. | November 21, 2004, 6:49 PM |
Myndfyr | Nice code documentation! :) +1 | November 21, 2004, 7:51 PM |
FrOzeN | lol Newby is alwayed bugged me about using ''" and " " he always says use vbNullString and Space(1) 's instead so thats only thing i can suggest for that.. :p | November 26, 2004, 1:00 PM |
KkBlazekK | [code]Public Sub Clear() On Error GoTo Clear_Error ReDim QList(0) On Error GoTo 0 Exit Sub Clear_Error: Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext End Sub[/code] Wouldn't [code] Erase QList [/code] be a better solution? Whats the difference between them? | November 26, 2004, 8:48 PM |
R.a.B.B.i.T | Erase deletes the index, and I would get an "Index out of bounds" error the next time I tried to manipulate the queue. ReDim just clears all indicies besides the ones I specify (in this case, only 0), and resets all data in the array to NULLs. | December 1, 2004, 1:08 AM |