CollectionPlus ! (See VERSION 2)

'***************************************************************
' CLASS
'***************************************************************
'SEE MY NEW VERSION
'Create a New Class and name it CollectionPlus (optional)
'Copy/Paste the following Code
'Creer une nouvelle Class et nommez-la CollectionPlus
'Copier/Coller toutes les prochaines lignes
Option Explicit
Dim theCollection As New Collection
Private m_Delim As String
Const DefaultDelim As String = ","
Public Event Erreur(ByVal FunctionName As String, ByVal Number As Long, ByVal Description As String, ByVal DataError As String)
Private Sub Class_Initialize()
 m_Delim = DefaultDelim
End Sub
Private Sub Class_Terminate()
 Set theCollection = Nothing
End Sub
Public Sub Add(Item As Variant, Optional ByVal Key As Variant, Optional ByVal Before As Variant, Optional ByVal After As Variant)
 On Error GoTo err_Occur
 theCollection.Add Item, Key, Before, After
 On Error GoTo 0
err_Continu:
 Exit Sub
err_Occur:
 RaiseEvent Erreur("Add", Err.Number, Err.Description, "")
 Resume err_Continu
End Sub
Public Sub RemoveKey(ByVal Key As String)
 On Error GoTo err_Occur
 theCollection.Remove Key
 On Error GoTo 0
err_Continu:
 Exit Sub
err_Occur:
 RaiseEvent Erreur("RemoveKey", Err.Number, Err.Description, Key)
 Resume err_Continu
End Sub
Public Sub Remove(ByVal IndexOrKey As Variant)
 On Error GoTo err_Occur
 theCollection.Remove IndexOrKey
 On Error GoTo 0
err_Continu:
 Exit Sub
err_Occur:
 RaiseEvent Erreur("Remove", Err.Number, Err.Description, IndexOrKey)
 Resume err_Continu
End Sub
Public Sub RemoveIndex(ByVal Index As Long)
 On Error GoTo err_Occur
 If Index <= theCollection.Count Then
 theCollection.Remove Index
 Else
 RaiseEvent Erreur("RemoveIndex", 9, "Subscript out of range, Max=" + CStr(theCollection.Count), Index)
 End If
 On Error GoTo 0
err_Continu:
 Exit Sub
err_Occur:
 MsgBox Err.Number
 RaiseEvent Erreur("RemoveIndex", Err.Number, Err.Description, Index)
 Resume err_Continu
End Sub
Public Sub RemoveAll()
 If theCollection.Count = 0 Then Exit Sub
 Dim element As Variant
 For Each element In theCollection
 theCollection.Remove 1
 Next element
End Sub
Public Property Get Count() As Long
 On Error GoTo err_Occur
 Count = theCollection.Count
 On Error GoTo 0
err_Continu:
 Exit Function
err_Occur:
 RaiseEvent Erreur("Count", Err.Number, Err.Description, "")
 Resume err_Continu
End Property
Public Function Item(ByVal IndexOrKey As Variant) As Variant
 On Error GoTo err_Occur
 Item = theCollection.Item(IndexOrKey)
 On Error GoTo 0
err_Continu:
 Exit Function
err_Occur:
 RaiseEvent Erreur("Item", Err.Number, Err.Description, IndexOrKey)
 Resume err_Continu
End Function
Public Function IfItemIsThere(ByVal Index As Long) As Boolean
 Dim temp As Variant
 On Error GoTo err_Occur
 temp = theCollection.Item(Index)
 On Error GoTo 0
 IfItemIsThere = True
err_Continu:
 Exit Function
err_Occur:
 IfItemIsThere = False
 Resume err_Continu
End Function
Public Function IfKeyIsThere(ByVal Key As String) As Boolean
 Dim temp As Variant
 On Error GoTo err_Occur
 temp = theCollection.Item(Key)
 On Error GoTo 0
 IfKeyIsThere = True
err_Continu:
 Exit Function
err_Occur:
 IfKeyIsThere = False
 Resume err_Continu
End Function
Public Property Get DelimStringDataError() As String
 DelimStringDataError = m_Delim
End Property
Public Property Let DelimStringDataError(ByVal NewDelim As String)
 m_Delim = NewDelim
End Property
'***************************************************************
' FORM
'***************************************************************
'Copy/Paste this lines in a Form called frmMain
'Copier/Coller ces lignes dans une Form nommer frmMain
Option Explicit
'The Declaration for Handle the Error Event of Collection Plus
Dim WithEvents myCol As CollectionPlus
Private Sub Form_Load()
 'Initialize Collection
 Set myCol = New CollectionPlus
End Sub
Private Sub Form_Unload(Cancel As Integer)
 Set myCol = Nothing
 Set frmMain = Nothing
 End
End Sub
Private Sub cmdTestCol_Click()
 'The Add,Item,Remove and Count are same as Collection
 myCol.Add "My Item", "My Key" ' ,"Before Key","After Key" [Optional]
 myCol.Add "Second"
 
 'Verify my Items
 MsgBox "Have Item 1 : " + CStr(myCol.IfItemIsThere(1)) + vbCrLf + vbCrLf + _
 "Have Key 'My Key' : " + CStr(myCol.IfKeyIsThere("My Key")) + vbCrLf + vbCrLf + _
 "Have Item 3 : " + CStr(myCol.IfItemIsThere(3)), _
 vbInformation + vbSystemModal, "CollectionPlus"
 
 'An Error Event Occur (without Crash !)
 myCol.Remove 5
 
 'This gonna Delete "Second" (Like Collection)
 myCol.RemoveKey ""
 
 'Get Count
 MsgBox "Collection Count: " + CStr(myCol.Count), vbInformation + vbSystemModal, "CollectionPlus"
 
 'Now Remove All Items
 myCol.RemoveAll
 
End Sub
'Error Event of CollectionPlus
Private Sub myCol_Erreur(ByVal FunctionName As String, ByVal Number As Long, ByVal Description As String, ByVal DataError As String)
 MsgBox "FunctionName: " + FunctionName + vbCrLf + "Number: " + CStr(Number) + vbCrLf + _
 "Description: " + Description + vbCrLf + "DataError: " + DataError, _
 vbInformation + vbSystemModal, "Error Event CollectionPlus !"
End Sub

<table cellpadding="3" cellspacing="0" width="600" align="center" border="0" bgcolor="#EEEEEE">
<tr>
<td align="right" valign="middle" height="2" width="30%" bgcolor="#EEEEEE"><b><font face="MS Sans Serif, Geneva, Arial, Helvetica" size="2">URL:</font></b></td>
<td align="left" valign="middle" height="2" width="70%" colspan="3" bgcolor="#EEEEEE"><input type="text" size="50" maxlength="500" value="http://www.planet-source-code.com/" name="/zeal/directory/EditWebsiteFormHandler.websiteEdit.url"><input type="hidden" name="_D:/zeal/directory/EditWebsiteFormHandler.websiteEdit.url" value=" "></td>
</tr>
<tr>
<td align="right" valign="middle" width="30%" bgcolor="#EEEEEE"><font face="MS Sans Serif, Geneva, Arial, Helvetica" size="2"><b>Title:</b></font></td>
<td align="left" valign="middle" width="70%" colspan="3" bgcolor="#EEEEEE"><input type="text" size="50" maxlength="255" value="Planet Source Code" name="/zeal/directory/EditWebsiteFormHandler.websiteEdit.title"><input type="hidden" name="_D:/zeal/directory/EditWebsiteFormHandler.websiteEdit.title" value=" "></td>
</tr>
<tr>
<td align="right" valign="top" width="30%" bgcolor="#EEEEEE"><font face="MS Sans Serif, Geneva, Arial, Helvetica" size="2"><b>Slogan:</b></font><br><font face="MS Sans Serif, Geneva, Arial, Helvetica" size="1">(No more than 500 characters)</font></td>
<td align="left" valign="middle" width="70%" colspan="3" bgcolor="#EEEEEE"><textarea cols="43" rows="2" onKeyUp=f1(this) onKeyDown=f1(this) onFocus=f1(this) onChange=f1(this) name="/zeal/directory/EditWebsiteFormHandler.websiteEdit.slogan"></textarea><input type="hidden" name="_D:/zeal/directory/EditWebsiteFormHandler.websiteEdit.slogan" value=" "></td>
</tr>
<script language="JavaScript1.1">
<!--
function f1(a){
x = 500 - a.value.length;
if (x < 0) { a.value = a.value.substring(0,500); x = 0; }
document.u1.width=350*(500-x)/500;
document.u1.alt=500-x+" chars used";
document.u2.width=350*x/500;
document.u2.alt=x+" chars available";
}
if ((navigator.appName.indexOf("Microsoft") != -1) && (parseInt(navigator.appVersion) >= 4)) {
document.write('<tr><td align="right" width="30%" bgcolor="#EEEEEE">&nbsp;</td><td align="left" width="70%" bgcolor="#EEEEEE" colspan="3">');
document.write('<table cellpadding="0" cellspacing="0" border="0" width="350">');
document.write('<tr>');
document.write('<td bgcolor="#0000ff" width="0"><img src="/images/trans.gif" name="u1" height="5" width="0"></td>');
document.write('<td bgcolor="#cccccc" width="350"><img src="/images/trans.gif" name="u2" height="5" width="350"></td>');
document.write('</tr>');
document.write('</table>');
document.write('</td></tr>');
}
else {
document.write(' ');
}
//--></script>
</table>
PASTE THE FOLLOWING CODE IN THE "PAINT" EVENT OF YOUR FORM.
==================================================
Graphics g=e.Graphics;
			Single intWidthdx;
			Single intIncrement=255/this.Width; 
			Single intRedDx=0;
			if(intIncrement==0)
			{
				intIncrement+=(float)0.1;
			}
			for(intWidthdx=0;intWidthdx<this.Width;intWidthdx+=intIncrement)
			{
				//intRedDx=intWidthdx;
				if(intWidthdx>255)
				{
					intRedDx=255-(intWidthdx%255);
				}
				else
				{
					intRedDx=intWidthdx;
				}
				g.FillRectangle(new SolidBrush(Color.FromArgb((int)intRedDx,10,80)),intWidthdx,0					
					,intIncrement,this.Height ); 
			}