Simple and fast, lightweight HashList-Class (no APIs)

Hi Guys,

I was hoping to be able to use this as a faster string,string value pair kind of thing than scripting.dictionary so I altered the code to be string,string and for me it is never faster than scripting.dictionary with the data I am using.

The attached zip contains the demo project and a file called connect.log which is a text file containing the data. The project reads the text file and loads the key/values into two arrays.

It then populates both the dictionary and the clsHashList from the array entries.

It can then get each item using the array entry as the key

There are about 8500 items in the connect.log file.

For me (slow dev box) the results are (timed by timegettime)


Dictionay Load 19 ms
Get each dictionary item 19ms

Load Hash 26ms
Get each hash item 33ms

I need to check each key against another dictionary in my production app rather than returning all key/value pairs hence the approach.

What can I do to speed this up if anything? Everybody else in the thread seems to get much better performance vs dictionary.

cheers

Have you tried it compiled?
Because it seems you have tested it from the IDE with an uncompiled Hash library

Compiled for fast code with all optimizations on.

Did you use cHashD.zip from post #1 or did you use the code between the code blocks in the post?

I used the code blocks. I guess that was a mistake on my behalf?

I don't know, but all the speed tests were done using the code provided in the cHashD.zip file

See the remarks in the original post:

Quote:

---

Originally Posted by Schmidt

..

Edit: Whilst the above Demo was more a "Concept-Showcase"... below is a performance-optimized version,
acting more like the MS-Scripting-Dictionary now (with a Param-wise inversed Add-Method, but feel free
to change it at will - the code-volume is still bearable with about 230 lines in cHashD).
In the meantime I've also added support for Integer-, Double- and Object-Keys - but I think I'll leave it at that -
since the Class is easy understandable and expandable...
Attachment 140909

Performance of Case-Insensitive-TextcompareMode for Scripting-Dictionary and cHashD
http://www.vbforums.com/images/ieimages/2016/08/1.png

Performance of Binary-TextcompareModes for Scripting-Dictionary and cHashD
http://www.vbforums.com/images/ieimages/2016/08/1.png

Olaf

---

I have modified the class to be string,string so no use of variants.

Would the code below be correct for adding remove? I am not sure I have it correct..

EDIT - Actually I think this is completely wrong. I am not sure how to implement remove.

Code:

---

Public Function Remove(key As String) As Boolean

10        On Error GoTo errorHandler
         
          Dim HashValue As Long, UB As Long, index As Long

20        HashValue = CalcHash(key)

30        index = FindIndex(key, HashTable(HashValue))
     
40        If index >= 0 Then
     
50          mKeys(index) = ""

60          With HashTable(HashValue)
         
70                If .Count > 0 Then
                 
80                  .DataIndexes(.Count) = 0
             
90                  .Count = .Count - 1
         
100                End If
                 
110          End With
       
120          mCount = mCount - 1
         
130      Else

140          Err.Raise 32811
       
150      End If

160      Exit Function
         
errorHandler:

170      errorDisplay Err.description, "hash_Remove", Erl
         
180      Resume endofitall
         
endofitall:

End Function

---

There's an additional zip-file download (with integrated Remove) in post #30:
https://www.vbforums.com/attachment....7&d=1590156833

Olaf

Quote:

---

Originally Posted by Schmidt

There's an additional zip-file download (with integrated Remove) in post #30:
https://www.vbforums.com/attachment....7&d=1590156833

Olaf

---

Please excuse if its me being stupid, but when I use the above object to store arrays, collections or other cHashDs then I get an error with the Keys and Items method.

The statement which appear to be causing the issue is

Code:

---

Do While s.Values(j) = NoEntry

---

I haven't yet tested the Pairs method.

Quote:

---

Originally Posted by freeflow

Please excuse if its me being stupid, but when I use the above object to store arrays, collections or other cHashDs then I get an error with the Keys and Items method.

The statement which appear to be causing the issue is

Code:

---

Do While s.Values(j) = NoEntry

---

I haven't yet tested the Pairs method.

---

A "complete example" would be nice (which demonstrates the issue).
From a your short snippet (as it is), I can only recommend:
- to store the resut of the Values-method in its own (TmpValsArr) variable
- and then loop over that TmpValsArr instead
.. you're currently copying the whole Values-Array again and again (in each iteration)

HTH

Olaf

OKk here you go. The code below respect that Items and Keys return an Array of Variants rather than a variant containing an array.

Code:

---

Public Sub TestcHashDItems()
    Debug.Print "Retrieving Items from cHashD"
    ' Using CHashD with remove
    Dim myItems As Variant
    Dim mycHashD As cHashD
    Set mycHashD = New cHashD
    '############################################################################
    ' Test NUmbers
    '############################################################################
    mycHashD.Add "One", 10
    mycHashD.Add "Two", 20
    mycHashD.Add "Three", 30
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Items
    Debug.Print
    Debug.Print "Items are 'Integers'"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting 10,20,30    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test Strings
    '############################################################################
    Set mycHashD = New cHashD
    mycHashD.Add "One", "Hello"
    mycHashD.Add "Two", "There"
    mycHashD.Add "Three", "World"
 
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Items
    Debug.Print
    Debug.Print "Items are Strings"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting Hello There World    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test Arrays
    '############################################################################
    mycHashD.Clear
    mycHashD.Add "One", Array(1, 2, 3)
    mycHashD.Add "Two", Array(4, 5, 6)
    mycHashD.Add "Three", Array(7, 8, 9)
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Items  ' At this point the debug window in Twinbasic is showing myitems contains "Hello There World"
    Debug.Print
    Debug.Print "Items are arrays"
    If Err.Number <> 0 Then
        Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting 1 5 9    Found  " ; myItems(0)(0), myItems(1)(1), myItems(2)(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test collection objects
    '############################################################################
    Dim myColl As Collection
    Set myColl = New Collection
    myColl.Add "Item1"
    myColl.Add "Item2"
    myColl.Add "Item3"
   
    Set mycHashD = New cHashD
    mycHashD.Add "One", myColl
    mycHashD.Add "Two", myColl
    mycHashD.Add "Three", myColl
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Items
    Debug.Print
    Debug.Print "Items are Collections"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting Item1 Item2 Item 3    Found" ; myItems(0)(1), myItems(1)(2), myItems(2)(3)
    End If
    On Error GoTo 0
   
   
         
    '############################################################################
    ' Test cHashD objects
    '############################################################################
    Dim myTest As cHashD
    Set myTest = New cHashD
    myTest.Add "TestOne", "Item1"
    myTest.Add "TestTwo", "Item2"
    myTest.Add "TestThree", "Item3"
   
    Set mycHashD = New cHashD
    mycHashD.Add "One", myTest
    mycHashD.Add "Two", myTest
    mycHashD.Add "Three", myTest
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Items
    Debug.Print
    Debug.Print "Items are cHashDs"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting Item1 Item2 Item3    Found  " ; myItems(0)("TestOne"), myItems(1)("TestTwo"), myItems(2)("TestThree")
    End If
    On Error GoTo 0
   
 End Sub
 
 Public Sub TestcHashDKeys()
    Debug.Print "Retreiving Keys from cHashD"
    Debug.Print
    ' Using CHashD with remove
    Dim myItems As Variant
    Dim mycHashD As cHashD
    Set mycHashD = New cHashD
    '############################################################################
    ' Test NUmbers
    '############################################################################
    mycHashD.Add "One", 10
    mycHashD.Add "Two", 20
    mycHashD.Add "Three", 30
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Keys
    Debug.Print
    Debug.Print "Items are 'Integers'"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting One Two Three    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test Strings
    '############################################################################
    Set mycHashD = New cHashD
    mycHashD.Add "One", "Hello"
    mycHashD.Add "Two", "There"
    mycHashD.Add "Three", "World"
 
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Keys
    Debug.Print
    Debug.Print "Items are Strings"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting One Two Three    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test Arrays
    '############################################################################
    mycHashD.Clear
    mycHashD.Add "One", Array(1, 2, 3)
    mycHashD.Add "Two", Array(4, 5, 6)
    mycHashD.Add "Three", Array(7, 8, 9)
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Keys
    Debug.Print
    Debug.Print "Items are arrays"
    If Err.Number <> 0 Then
        Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting One Two Three    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
    '############################################################################
    ' Test collection objects
    '############################################################################
    Dim myColl As Collection
    Set myColl = New Collection
    myColl.Add "Item1"
    myColl.Add "Item2"
    myColl.Add "Item3"
   
    Set mycHashD = New cHashD
    mycHashD.Add "One", myColl
    mycHashD.Add "Two", myColl
    mycHashD.Add "Three", myColl
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Keys
    Debug.Print
    Debug.Print "Items are Collections"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting One Two Three    Found  " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
   
         
    '############################################################################
    ' Test cHashD objects
    '############################################################################
    Dim myTest As cHashD
    Set myTest = New cHashD
    myTest.Add "TestOne", "Item1"
    myTest.Add "TestTwo", "Item2"
    myTest.Add "TestThree", "item"
   
    Set mycHashD = New cHashD
    mycHashD.Add "One", myTest
    mycHashD.Add "Two", myTest
    mycHashD.Add "Three", myTest
   
    On Error Resume Next
    myItems = Array(Empty, Empty, Empty)
    myItems = mycHashD.Keys
    Debug.Print
    Debug.Print "Items are cHashDs"
    If Err.Number <> 0 Then
            Debug.Print "Error:", Err.Description
    Else
        Debug.Print "Expecting One Two Three Found " ; myItems(0), myItems(1), myItems(2)
    End If
    On Error GoTo 0
   
 End Sub

---

Output is

Code:

---


Retrieving Items from cHashD

Items are 'Integers'
Expecting 10,20,30    Found  10          20            30

Items are Strings
Expecting Hello There World    Found  Hello            There        World

Items are arrays
Error:        Type mismatch

Items are Collections
Error:        Application-defined or object-defined error

Items are cHashDs
Expecting Item1 Item2 Item3    Found  Item1            Item2        Item3
(time taken: 2.7723064s)
Executing 'NewProject.Pootle.TestcHashDKeys'...
Retreiving Keys from cHashD
2

Items are 'Integers'
Expecting One Two Three    Found  One    Two          Three

Items are Strings
Expecting One Two Three    Found  One    Two          Three

Items are arrays
Error:        Type mismatch

Items are Collections
Error:        Application-defined or object-defined error

Items are cHashDs
Expecting One Two Three Found One        Two          Three
(time taken: 0.0009554s)

---

Quote:

---

Originally Posted by freeflow

OKk here you go.

---

Thanks, I see what you mean now...

Easy Fixes (for the faster cHashD-Zip, linked in Post #30):

1) Replace the "NoEntry"-Const-line with this line:
Private Const NoEntry As Variant = Empty

2) Replace all "Do While" lines (in Keys-, Items- and Pairs- Props) with this one:
Do While IsEmpty(mKeys(j)): j = j + 1: Loop

And that's it - all your Tests should pass now...
(I've applied that fix also to the RC6-built-in cHashD in preparation for the next release)

Quote:

---

Originally Posted by freeflow

The code below respect that Items and Keys return an Array of Variants rather than a variant containing an array.

---

Currently no, to respect the Items() and Keys() return-type -
(and increase performance in enumerations and indexed access) -
you should define the myItems-Variable in your TestCode:
- not as: Dim myItems As Variant
- but as: Dim myItems() As Variant

HTH

Olaf

Olaf, many thanks for taking the time to look at this. First my apologies, I edited my code and forgot to post the final version hence the mixup with Variant().

I can confirm that implementing your recommended changes means that the class now works as expected when storing arrays and collections.

I have noticed in cHashDWithRemove that there is no call to releaseArray in the terminate event. Is this correct or an oversight?

cheers

Quote:

---

Originally Posted by vbwins

I have noticed in cHashDWithRemove that there is no call to releaseArray in the terminate event. Is this correct or an oversight?

---

There should be an appropriate Flag I've set at creation-time of the safe-array ...
which should suppress "automatic cleanup-attempts of the runtime on Class_Terminate"

But it certainly won't hurt, when you put an explicit ReleaseArray call there, "just to make sure"...

Olaf

Thanks Olaf. Is that the create on the stack flag?

Quote:

---

Originally Posted by vbwins

Thanks Olaf. Is that the create on the stack flag?

---

Yes, as described in a comment in Class_Initialize():

Code:

---

Private Sub Class_Initialize()
  saW.cDims = 1:  saW.cbElements = 2
  saW.cLocks = 1: saW.fFeatures = &H11 'FADF_AUTO=&H1 || FADF_FIXEDSIZE=&H10
  ...

---

The FADF_AUTO is the Stack-relevant flag...
https://docs.microsoft.com/en-us/win...aidl-safearray

Olaf

Attached is a version where values are Long and Keys are String.
It uses a bit less memory and should be also a faster.

Also the parameters in the Add method were swapped to meet the VB.Collection.
Is there any reason why in cHash they have different order?

I see you are using copyMemory to set your keys and values. In my testing for small bits of memory the call overhead is more than just using a native var = var

cheers

Good point, I just changed VariantCopy and VariantCopyInt without thinking much.
Not sure why it used those APIs in the first place instead of just VB's copying.

Quote:

---

Originally Posted by Eduardo-

Is there any reason why in cHash they have different order?

---

Often you only store a key in a dictionary or a hash, so making the key the 1st parameter is more logical.

Quote:

---

Originally Posted by Arnoutdv

Often you only store a key in a dictionary or a hash, so making the key the 1st parameter is more logical.

---

I now see that the MS's dictionary object have the parameters "inverted" too.
You have to provide the second parameter "Item" anyway, it is not optional, so I don't see why MS "broke" collection's order.

PS: I get the point @Arnould that in dictionaries becomes more important the key, but still think that it would have been better to keep compatibility with Collections.

That can cause trouble in code when moving from collections to dictionaries since both parameters are Variant and the developer could not realize about the change.

Quote:

---

Originally Posted by Eduardo-

Good point, I just changed VariantCopy and VariantCopyInt without thinking much.
Not sure why it used those APIs in the first place instead of just VB's copying.

---

It used these APIs, to avoid an "IsObject()"-check (followed by Set in case the Key or Item were of type Object).

Olaf

I updated the class, thanks Olaf and vbwins.

I found a bug in cHashDStr, and since it will be left here in the forum for anybody to download I want to fix it.
In the Remove method, the line:

Code:

---

mValues(Idx) = NoEntry

---

causes an overflow error, since it is now Long.
What do you suggest to use now with Long instead of NoEntry?

OK, updated the upload, there is no perfect solution. Now -&H7FFFFFFF is a reserved value (not allowed).

Quote:

---

Originally Posted by Eduardo-

OK, updated the upload, there is no perfect solution. Now -&H7FFFFF is a reserved value (not allowed).

---

Is the sentinel value missing couple of F's like in MAX_INT = &H7FFFFFFF or this is on purpose?

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

Is the sentinel value missing couple of F's like in MAX_INT = &H7FFFFFFF or this is on purpose?

cheers,
</wqw>

---

Yes wqweto, I had missed a couple of F's. Thanks.

HOW TO USE RC6.cHashD?
DIM A AS NEW cHashD? CAN't use this

'Set Rc6cHashD_OldProc = New cHashD
Set Rc6cHashD_OldProc = New_c.HashD


The normal way is to call it like this: New cHashD
dim web1 as new rc6.cwebview
Most components can use the NEW ** method, but this one is not.
Although this rc6.chashd is not CHASHD.CLS, it is not off topic.

I call the same function to process the subclassed messages of multiple controls, so I need to obtain the original message processing address according to the handle value each time. Is there any way to make it faster?
If you can write a dedicated key-value object, it will be better if it is only for numbers. The faster the speed, the better, and you don't need to deal with duplicate data and other issues.

[The speed of the test is not necessarily accurate and is for reference only. This is just using ranges based on dictionaries with only 2 elements. If it is 1000, 100,000 data, the speed ranking may be completely different. The slower one here may be the fastest in big data.]

'0.0412 milliseconds, 24,300 times per second --GetProp(Hwnd, StrPtr_m_OldProc)
'0.0068 milliseconds, 147,100 times, AllUsedTime=17.0919 'ClsHashList
'0.0036 milliseconds, 277,800 times, AllUsedTime=21.0183 cHashD2 (vb6 class)
'0.0029 milliseconds, 344,800 times per second, AllUsedTime=5.589 --Collection(Hwnd & "")
'0.0027 milliseconds, 370,400 times per second, AllUsedTime=9.9265 'clsTrickHashTable
'0.0022 milliseconds, 454,500 times per second, AllUsedTime=10.0871 RC6.cCollection
'0.0008 milliseconds, 1.25 million times, AllUsedTime=1.3141 = Dictionary(Hwnd)-Dc_OldProc

Code:

---

m_OldProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf ControlCallBack)
Private Function ControlCallBack(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim m_OldProc As Long
    MsgCount = MsgCount + 1
        Dim C1 As Currency, C2 As Currency, U1 As Currency
       
        QueryPerformanceCounter C1
        m_OldProc = Dc_OldProc(Hwnd)
        QueryPerformanceCounter C2
       
        'm_OldProc = clsTrickHashTable_OldProc(Hwnd)
        'm_OldProc = ClsHashList_OldProc.Item(Hwnd & "")
        'm_OldProc = Rc6cHashD_OldProc(Hwnd)
        'm_OldProc = Rc6C_OldProc("" & Hwnd)
       
       
        'm_OldProc = ListOldProc(Hwnd & "")
        'GetProp(Hwnd, StrPtr_m_OldProc)
        'GetProp(Hwnd, StrPtr("m_OldProc"))

---

Quote:

---

Originally Posted by xiaoyao

HOW TO USE RC6.cHashD?
DIM A AS NEW cHashD? CAN't use this

---

Code:

---

Dim oHash As cHashD
Set oHash = New_c.HashD

---

Remember that all RC6 classes should be initialized with New_c, e.g.
New_c.Collection
New_c.StringBuilder
New_c.ArrayList(...)

You can view RC6.cConstructor in VB6-ObjectBrowser to get the initialization definition parameters for the classes.

Quote:

---

Originally Posted by Eduardo-

Attached is a version where values are Long and Keys are String.
It uses a bit less memory and should be also a faster.

Also the parameters in the Add method were swapped to meet the VB.Collection.
Is there any reason why in cHash they have different order?

---

Very good improvement.

Although Olaf provides the source code of cHashD, I would like RC6 to provide two cHashD forks:
(1) cStrVarHashD (String-Variant)
(2) cStrLngHashD (String-Long)

This not only allows RC6 users to more concisely emulate C# generics, but also allows me to avoid the biggest trouble/annoyance, which is that vbTextCompare is not valid for me in VB6-IDE environment.

Also, my parsers needs high-performance HashD, and optimized cStrLngHashD and cStrVarHashD are very important to me.

Quote:

---

Originally Posted by Schmidt

Update: The latest version is contained in the Zip below, with the following benefits:
- better performance
- RemoveByIndex and Remove (by Key) is now included
- variable Keys (incl. Objects), which can also be mixed

Here's the result of a performance-comparison to the MS-Scripting.Dictionary (native compiled, all options checked):
http://www.vbforums.com/images/ieimages/2020/05/1.png

Ok, here the Zip with the new version (including the little PerformanceTest).
Attachment 177177

Olaf

---

if i change to only for long type Dictionary object ,
Will it be faster to add BYVAL to the parameter?

Code:

---

Public Sub Add(Key As Long, Item As Long)
Public Sub Add(byval Key As Long, byval Item As Long)

Public Function Exists( Key As Long) As Boolean
  Exists = FindIndex(Key) >= 0
End Function

Public Function Exists(ByVal Key As Long) As Boolean
  Exists = FindIndex(Key) >= 0
End Function

---

Quote:

---

Originally Posted by xiaoyao

if i change to only for long type Dictionary object ,
Will it be faster to add BYVAL to the parameter?

Code:

---

Public Sub Add(Key As Long, Item As Long)
Public Sub Add(byval Key As Long, byval Item As Long)

Public Function Exists( Key As Long) As Boolean
  Exists = FindIndex(Key) >= 0
End Function

Public Function Exists(ByVal Key As Long) As Boolean
  Exists = FindIndex(Key) >= 0
End Function

---

---

Aren't you the one who posts pointless micro-benchmarks everywhere?

So what about writing one, to answer your own question? ;)

Olaf

You misunderstand. It's all for practical use.Relatively speaking, many methods do not have a great impact on speed.
With GetPropA(hwnd,"key") can only be read 20,000 times per second.


Other general dictionary objects can reach 300000 to 2 million times.

My simple use is, for example, in a timer callback or a subclassing callback.There are multiple objects calling back to this address. There is a parameter hwnd, or the address of the timer.I just want to make a distinction, so either get it from the specified object or read it from the array.

Just now I thought of a way to make it possible to use XOR faster, so that no objects are needed.

Code:

---

If FindIndex(Key) <> -1 Then
If FindIndex(Key) >=0 Then

---

These two different comparison methods may also have different CPU speeds, although the impact is hardly 1%.
If I know how to write faster, 10-30 ways for VB6 to improve the running speed, there will always be better results.
Although some people say that if you pursue the speed of operation so much, it is better to write it in vc++ or GO language.
But that's another topic, isn't it?

The Fourth World War did not happen here, everyone is just exchanging technology, I hope there will be no quarrel.

TimerEx for vb6,vba, Timer in vb6 Class-VBForums
https://www.vbforums.com/showthread....12#post5608612

Code:

---

lngTimerID = SetTimer(0, 0, m_Interval, AddressOf TimerExProc)
 TimerExClass.Add Me, lngTimerID & ""

Public TimerExClass As New Collection

Public Sub TimerExProc(ByVal Hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Dim Ex As TimerEx
    Set Ex = TimerExClass(idEvent & "")
    Ex.TimerProc()
End Sub

---

Multiple different objects call back to the same function in the module, how to distinguish who is the caller, and then use:
Object.Method X(***) simulates an event execution to the calling form.
For example form1.Timer_Tick(), form2.Timer_Tick()

Set Ex = TimerExClass(idEvent & "")
Set Ex = TimerExClass(hwnd & "")
Most of the callbacks have a handle as a parameter, and then what method is used to get the form or VB class1 object from the handle



Generally, I like to use Collection objects, and later I found a SetPropA method, which hardly requires writing any redundant code.
The price is that it can only read 20,000 times per second in the VB6 IDE, which is relatively slow.
VB6.Collection, 300,000 times per second
RC6.cCollection, about 600,000 times per second.
Using the "Dictionary" object can reach 2 million times per second,

Because VB6, Collection, does not support using integers as key values, so it can only be Collection1.add(m_OldProc,hwnd & "")
In this case where only integers are needed as keys, coercion to strings will definitely cause some performance loss.

It was only after discovering this huge difference that we tested different dictionary objects.
This is mainly used for queries with a very small amount of data. Generally, there are no more than 10 timers or subclassed callbacks, which are usually 2-3 objects.
Compared with the query of tens of thousands of data, it is better to use Dictionary and other methods.
The data volume is small and the data volume is large, and different object components are used, and the speed is also very different.

Code:

---

m_OldProc = SetWindowLong(Hwnd, GWL_WNDPROC, AddressOf ControlCallBack)
 SetPropA Hwnd, "m_OldProc", m_OldProc

Function ControlCallBack(ByVal Hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        dim m_OldProc as long
        m_OldProc=GetPropA(Hwnd,"m_OldProc")
        'm_OldProc=Dictionary(Hwnd)
    ControlCallBack = CallWindowProc(m_OldProc, Hwnd, Msg, wParam, lParam)
end function

---

I wrote a key-value object module for a small amount of data

(Only for the primary key is a number, and the data is also an integer type) If you need other types, please modify it yourself
The code is short enough that it should be easy to change.

Code:

---

Private DataArr() As Long, KeyArr() As Long, UB As Long
Private ArrSize As Long, AddSize As Long

Sub IntData(Optional AddSizeA As Long = 100)
    UB = -1
    AddSize = AddSizeA
    ReDim KeyArr(AddSize)
    ReDim DataArr(AddSize)
End Sub
Public Property Get Item(ByVal Key As Long) As Long
    Dim ID As Long: ID = FindIndex(Key)
    If ID = -1 Then Exit Property
    Item = DataArr(ID)
End Property

Sub Add(Key As Long, Val As Long)
    If FindIndex(Key) <> -1 Then Exit Sub
    UB = UB + 1
    KeyArr(UB) = Key
    DataArr(UB) = Val
End Sub

Function FindIndex(ByVal Key As Long) As Long
Dim i As Long
For i = 0 To UB
    If KeyArr(i) = Key Then
        FindIndex = i
        Exit Function
    End If
Next
FindIndex = -1
End Function

---

Quote:

---

Originally Posted by vbwins

Hi Guys,

I was hoping to be able to use this as a faster string,string value pair kind of thing than scripting.dictionary so I altered the code to be string,string and for me it is never faster than scripting.dictionary with the data I am using.

cheers

---

In some special cases, sometimes only the string type is required for Key primary key information.
Sometimes the primary key is of integer type, but each value item is all of object type.
Sometimes for the sake of efficiency, it is a good way to simplify the modification from a dictionary object with source code.

Quote:

---

Originally Posted by xiaoyao

The Fourth World War did not happen here, everyone is just exchanging technology, I hope there will be no quarrel.

---

Please post "your technology" in your own threads -
instead of spamming this one (which is about cHashD) -
with unrelated information, nobody want's to read.

I asked you a concrete question in #75 - and you did not answer it (instead you posted your usual nonsense about "all your current activities and plans").
A reasonable and on-topic dialog with you is impossible as it seems...

Olaf