File: VirtualIconThread.pas

package info (click to toggle)
mysql-query-browser 1.1.6-1sarge0
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 36,320 kB
  • ctags: 24,680
  • sloc: pascal: 203,479; xml: 136,561; ansic: 47,502; cpp: 28,926; sh: 12,433; objc: 4,823; java: 1,849; php: 1,485; python: 1,225; sql: 1,128; makefile: 872
file content (729 lines) | stat: -rw-r--r-- 23,604 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
unit VirtualIconThread;

// Version 1.2.0
//   The contents of this file are subject to the Mozilla Public License
// Version 1.1 (the "License"); you may not use this file except
// in compliance with the License. You may obtain a copy of the
// License at
//
// http://www.mozilla.org/MPL/
//
//   Software distributed under the License is distributed on an
// " AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or
// implied. See the License for the specific language governing rights
// and limitations under the License.
//
//
//   Alternatively, the contents of this file may be used under
// the terms of the GNU General Public License Version 2 or later
// (the "GPL"), in which case the provisions of the GPL are applicable
// instead of those above. If you wish to allow use of your version of
// this file only under the terms of the GPL and not to allow others to
// use your version of this file under the MPL, indicate your decision
// by deleting the provisions above and replace them with the notice and
// other provisions required by the GPL. If you do not delete the provisions
// above, a recipient may use your version of this file under either the
// MPL or the GPL.
//
// The initial developer of this code is Jim Kueneman <jimdk@mindspring.com>
//
//----------------------------------------------------------------------------

interface

{$include ..\Include\Compilers.inc}
{$include ..\Include\VSToolsAddIns.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  ShlObj, ShellAPI, ActiveX, VirtualShellUtilities, VirtualNamespace,
  VirtualResources;


const
  SAFETLYVALVEMAX = 20;  // Number of times PostMessage it tried if it fails (very unlikely)

type
  PVirtualThreadIconInfo = ^TVirtualThreadIconInfo;
  TVirtualThreadIconInfo = packed record
    PIDL: PItemIDList;    // PIDL to the object that requested the image index
    IconIndex: integer;   // Extracted Icon Index
    LargeIcon: Boolean;   // Extract the large Icon or Small Icon
    Control: TWinControl; // The window that needs the icon
    UserData: Pointer;    // In VET and VLVEx this is the node. The value in this field is used as the test in ClearPendingItem(TestItem: Pointer) so true is if UserData = TestItem
    UserData2: Pointer;   // User definable
    Tag: integer;         // In VLVEx this is the item index
    MessageID: LongWord;  // The WM_xxx Message to send the control
  end;


  TWMVTSetIconIndex = packed record
    Msg: Cardinal;
    IconInfo: PVirtualThreadIconInfo;
  end;

type
  { Thread to extract images without slowing down VET }
  TVirtualImageThread = class(TThread)
  private
    FQueryList: TThreadList;
    FImageThreadEvent: THandle;
//    FMalloc: IMalloc;
    FExtractedIconIndex: integer;

  protected
    procedure AddNewItem(Control: TWinControl; WindowsMessageID: LongWord; PIDL: PItemIDList; LargeIcon: Boolean;
      UserData: Pointer; Tag: integer);
    procedure ClearPendingItem(Control: TWinControl; TestItem: Pointer;
      MessageID: LongWord; const Malloc: IMalloc);
    procedure ClearPendingItems(Control: TWinControl; MessageID: LongWord; const Malloc: IMalloc);
    function CopyPIDL(APIDL: PItemIDList; const Malloc: IMalloc): PItemIDList;
    procedure Execute; override;
    function ExtractIconImage(APIDL: PItemIDLIst): Integer;
    procedure ExtractInfo(PIDL: PItemIDList; Info: PVirtualThreadIconInfo); virtual;
    procedure ExtractedInfoLoad(Info: PVirtualThreadIconInfo); virtual; // Load Info before being sent to Control(s)
    procedure InsertNewItem(Control: TWinControl; WindowsMessageID: LongWord; PIDL: PItemIDList;
        LargeIcon: Boolean; UserData: Pointer; Tag: integer);
    procedure InvalidateExtraction; virtual; // Called if after extraction the item can't be dispatched
    function NextID(APIDL: PItemIDList): PItemIDList;
    function PIDLSize(APIDL: PItemIDList): Integer;
    procedure ReleaseItem(Item: PVirtualThreadIconInfo; const Malloc: IMalloc); virtual;
    procedure SetEvent;
    function StripLastID(IDList: PItemIDList; var Last_CB: Word; var LastID: PItemIDList): PItemIDList;

    property ExtractedIconIndex: integer read FExtractedIconIndex write FExtractedIconIndex;
    property ImageThreadEvent: THandle read FImageThreadEvent write FImageThreadEvent;
 //   property Malloc: IMalloc read FMalloc write FMalloc;
    property QueryList: TThreadList read FQueryList;

  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;
  end;

  IVirtualImageThreadManager = interface(IUnknown)
  ['{F6CDCFE6-4294-4169-A6ED-D1E24F3152AC}']
    procedure AddNewItem(Control: TWinControl;  WindowsMessageID: LongWord; PIDL: PItemIDList;
      LargeIcon: Boolean; UserData: Pointer; Tag: integer);
    procedure ClearPendingItems(Control: TWinControl; MessageID: LongWord; const Malloc: IMalloc);
    procedure ClearPendingItem(Control: TWinControl; TestItem: Pointer; MessageID: LongWord; const Malloc: IMalloc);
    procedure InsertNewItem(Control: TWinControl; WindowsMessageID: LongWord; PIDL: PItemIDList;
        LargeIcon: Boolean; UserData: Pointer; Tag: integer);
    function LockThread: TList;
    procedure RegisterControl(Control: TWinControl);
    procedure ReleaseItem(Item: PVirtualThreadIconInfo; const Malloc: IMalloc);
    procedure SetThreadPriority(Priority: TThreadPriority);
    procedure UnLockThread;
    procedure UnRegisterControl(Control: TWinControl);
  end;

  TVirtualImageThreadManager = class(TInterfacedObject, IVirtualImageThreadManager)
  private
    FControlList: TThreadList;
    FImageThread: TVirtualImageThread;
    FThreadPriority: TThreadPriority;
  protected
    procedure ReleaseImageThread;
    function RegisteredControl(Control: TWinControl): Boolean;

    property ControlList: TThreadList read FControlList write FControlList;
    property ImageThread: TVirtualImageThread read FImageThread write FImageThread;
    property ThreadPriority: TThreadPriority read FThreadPriority write FThreadPriority;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddNewItem(Control: TWinControl;  WindowsMessageID: LongWord; PIDL: PItemIDList;
      LargeIcon: Boolean; UserData: Pointer; Tag: integer);
    procedure ClearPendingItems(Control: TWinControl; MessageID: LongWord; const Malloc: IMalloc);
    procedure ClearPendingItem(Control: TWinControl; TestItem: Pointer; MessageID: LongWord; const Malloc: IMalloc);
    procedure InsertNewItem(Control: TWinControl; WindowsMessageID: LongWord; PIDL: PItemIDList;
        LargeIcon: Boolean; UserData: Pointer; Tag: integer);
    function LockThread: TList;
    procedure RegisterControl(Control: TWinControl);
    procedure ReleaseItem(Item: PVirtualThreadIconInfo; const Malloc: IMalloc);
    procedure SetThreadPriority(Priority: TThreadPriority);
    procedure UnLockThread;
    procedure UnRegisterControl(Control: TWinControl);
  end;

function ImageThreadManager: IVirtualImageThreadManager;

implementation

var
  ImageManager: IVirtualImageThreadManager = nil;

function ImageThreadManager: IVirtualImageThreadManager;
begin
  if not Assigned(ImageManager) then
    ImageManager := TVirtualImageThreadManager.Create as IVirtualImageThreadManager;
  Result := ImageManager
end;

{ TVirtualImageThread }

procedure TVirtualImageThread.AddNewItem(Control: TWinControl; WindowsMessageID: LongWord;
  PIDL: PItemIDList; LargeIcon: Boolean; UserData: Pointer; Tag: integer);
var
  List: TList;
  Info: PVirtualThreadIconInfo;
begin
  List := QueryList.LockList;
  try
    Info := AllocMem(SizeOf(TVirtualThreadIconInfo));
    Info.Control := Control;
    Info.PIDL := PIDLMgr.CopyPIDL(PIDL);
    Info.LargeIcon := LargeIcon;
    Info.UserData := UserData;
    Info.Tag := Tag;
    Info.MessageID := WindowsMessageID;
    List.Add(Info);
    SetEvent
  finally
    QueryList.UnlockList;
  end
end;

procedure TVirtualImageThread.ClearPendingItem(Control: TWinControl; TestItem: Pointer;
  MessageID: Longword; const Malloc: IMalloc);
// This method makes one big assumption.  It assumes that the TestItem is equal to the
// PVirtualThreadIconInfo.UserData field.
var
  List: TList;
  i : integer;
  Msg: TMsg;
begin
  // Lock the thread from dispatching any more messages
  List := QueryList.LockList;
  try
    // Since we have the list locked we can pick any messages that are in
    // message queue that are pending.  They may reference the Item we are
    // now deleting! By handling this message while the list is locked we
    // can be sure all pending icon updates are done before we delete a Item.
    if Control.HandleAllocated then
    begin
      // First flush out any pending messages and let them be processed
      while PeekMessage(Msg, Control.Handle, MessageID, MessageID, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg)
      end;
    end;


    for i := 0 to List.Count - 1 do
    begin
      if (PVirtualThreadIconInfo(List[i])^.Control = Control) then
      begin
        if (TestItem = PVirtualThreadIconInfo(List[i])^.UserData)  then
        begin
          ReleaseItem(PVirtualThreadIconInfo(List[i]), Malloc);
          List[i] := nil
        end
      end
    end;
    List.Pack;
  finally
    QueryList.UnlockList;
  end
end;

procedure TVirtualImageThread.ClearPendingItems(Control: TWinControl; MessageID: LongWord; const Malloc: IMalloc);
var
  List: TList;
  i : integer;
  Msg: TMsg;
begin
  // Lock the thread from dispatching any more messages
  List := QueryList.LockList;
  try
    // Since we have the list locked we can pick any messages that are in
    // message queue that are pending.  They may reference the Item we are
    // now deleting! By handling this message while the list is locked we
    // can be sure all pending icon updates are done before we delete a Item.
    if Control.HandleAllocated then
    begin
      // First flush out any pending messages and let them be processed
      while PeekMessage(Msg, Control.Handle, MessageID, MessageID, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg)
      end;
    end;


    for i := 0 to List.Count - 1 do
    begin
      if (PVirtualThreadIconInfo(List[i])^.Control = Control) then
      begin
        ReleaseItem(PVirtualThreadIconInfo(List[i]), Malloc);
        List[i] := nil
      end
    end;
    List.Pack;
  finally
    QueryList.UnlockList;
  end
end;

function TVirtualImageThread.CopyPIDL(APIDL: PItemIDList; const Malloc: IMalloc): PItemIDList;
// Copies the PIDL and returns a newly allocated PIDL. It is not associated
// with any instance of TPIDLManager so it may be assigned to any instance.
var
  Size: integer;
begin
  if Assigned(APIDL) then
  begin
    Size := PIDLSize(APIDL);
    Result := Malloc.Alloc(Size);
    if Result <> nil then
      CopyMemory(Result, APIDL, Size);
  end else
    Result := nil
end;

constructor TVirtualImageThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  { NEED A UNIQUE EVENT FOR EACH THREAD IDIOT!!!}
  ImageThreadEvent := CreateEvent(nil, True, False, '');
  FQueryList := TThreadList.Create;
end;

destructor TVirtualImageThread.Destroy;
begin
  inherited;
  { Important to keep resources valid until after the inherited Destroy returns. }
  { The Execute method is terminated during a WaitFor called in this destructor. }
  { During that time Execute may still reference these resources.                }
  FQueryList.Free;
  if ImageThreadEvent <> 0 then
    CloseHandle(ImageThreadEvent);  
end;

procedure TVirtualImageThread.Execute;
var
  Index: Integer;
  List: TList;
  SafetyValve: integer;
  Info: PVirtualThreadIconInfo;
  PIDL: PItemIDList;
  Malloc: IMalloc;
begin
  CoInitialize(nil);
  try
    SHGetMalloc(Malloc); // Create in the context of the thread
    while not Terminated do
    begin
      WaitForSingleObject(ImageThreadEvent, INFINITE);
      if not Terminated then
      begin
        // Ok everyone .... breath
        Sleep(1);

        // Get the next waiting node
        List := QueryList.LockList;
        try
          Info := nil;
          // Grab the last item but don't remove it from the list yet.
          // If we remove it then if a control flushs pending queries before
          // we dispatch it we will send it to a control that is not ready.
          // If there are not items in the list then we are done so reset
          // local varaibles and reset the event so WaitForSingleObject waits again
          if List.Count > 0 then
          begin
            Index := List.Count - 1;
            Info := PVirtualThreadIconInfo(List.Items[Index]);
            // We can't use the actual Info object as it my be deleted on us
            PIDL := CopyPIDL(Info.PIDL, Malloc);
          end
          else begin
            Index := -1;
            PIDL := nil;
            ResetEvent(ImageThreadEvent); // Reset ourselves when there are no more images
          end;
        finally
          QueryList.UnlockList
        end;

        // Check again to see if we are terminated
        if Assigned(PIDL) then
        try
          // Call the long processing method if necessary.
          ExtractInfo(PIDL, Info);

          // Ok the slow extraction is done time to dispatch it
          List := QueryList.LockList;
          try
            // Free the temp PIDL
            if PIDL <> nil then
              Malloc.Free(PIDL);

            // Check to see if there are any items in the list or if items have
            // been deleted first. If they are the item will be left if the queue
            // and it will have to be done again
            if (List.Count > 0) and (Index < List.Count) then
            begin
              // See if the node was deleted and removed from the list or the
              // contexts were shifted
              if List[Index] = Info then
              begin
                ExtractedInfoLoad(Info);
                // No it is still there so we can remove it
                List.Delete(Index);
                // Note: It is possible by the time the VET gets this TMessage
                // the node can be destroyed so main thread locks the list
                // the PeekMessage's to remove all WM_VTSETICONINDEX before
                // freeing node.
                // Can't SendMessage because the main thread may be blocked
                // waiting for the list and SendMessage will deadlock.

                // Here again accessing a TWinControl is not thread safe but
                // we are only reading the properties
                if Info.Control.HandleAllocated then
                begin
                  SafetyValve := 0;
                  while not PostMessage(Info.Control.Handle, Info.MessageID, Integer(Info), 0) and (SafetyValve < SAFETLYVALVEMAX) do
                  begin
                    Inc(SafetyValve);
                    Sleep(1);
                  end;
                  if SafetyValve >= SAFETLYVALVEMAX then
                    ReleaseItem(Info, Malloc)
                end else
                  ReleaseItem(Info, Malloc)
              end else
                InvalidateExtraction
            end else
              InvalidateExtraction
          finally
            QueryList.UnlockList;
          end
        except
          // Don't let exceptions escape the thread
        end
      end
    end
  finally
    // Make sure WaitFor is in the Wait Function before the thread really ends
    Sleep(100);
    Malloc := nil;
    CoUninitialize;
  end;
end;

procedure TVirtualImageThread.ExtractedInfoLoad(Info: PVirtualThreadIconInfo);
// This is called from within a locked list so it is safe to maniulate
begin
  Info.IconIndex := ExtractedIconIndex;
end;

function TVirtualImageThread.ExtractIconImage(APIDL: PItemIDLIst): integer;

  function GetIconByIShellIcon(PIDL: PItemIDList; var Index: integer): Boolean;
  var
    Flags: Longword;
    OldCB: Word;
    Old_ID: PItemIDList;
    {$IFNDEF VIRTUALNAMESPACES}
    Desktop,
    {$ENDIF}
    Folder: IShellFolder;
    ShellIcon: IShellIcon;
  begin
    Result := False;
    StripLastID(PIDL, OldCB, Old_ID);
    try
      {$IFDEF VIRTUALNAMESPACES}
      Old_ID.mkid.cb := OldCB;
      Folder := NamespaceExtensionFactory.BindToVirtualParentObject(PIDL);
      {$ELSE}
      SHGetDesktopFolder(Desktop);
      Desktop.BindToObject(PIDL, nil, IShellFolder, Pointer(Folder));
      Old_ID.mkid.cb := OldCB;
      {$ENDIF}
      if Assigned(Folder) then
        if Folder.QueryInterface(IShellIcon, ShellIcon) = S_OK then
        begin
          Flags := 0;
          Result := ShellIcon.GetIconOf(Old_ID, Flags, Index) = NOERROR
      end
    finally
      {$IFNDEF VIRTUALNAMESPACES}
      Old_ID.mkid.cb := OldCB
      {$ENDIF}
    end
  end;

  procedure GetIconBySHGetFileInfo(APIDL: PItemIDList; var Index: Integer);
  var
    Flags: integer;
    Info: TSHFILEINFO;
  begin
    Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_SHELLICONSIZE;
    Flags := Flags or SHGFI_SMALLICON;
    if SHGetFileInfo(PChar(APIDL), 0, Info, SizeOf(Info), Flags) <> 0 then
      Index := Info.iIcon
    else
      Index := 0
  end;

begin
  if not GetIconByIShellIcon(APIDL, Result) then
    GetIconBySHGetFileInfo(APIDL, Result);
end;

procedure TVirtualImageThread.ExtractInfo(PIDL: PItemIDList; Info: PVirtualThreadIconInfo);
// Use the passed PIDL to figure out what what to extract
begin
  ExtractedIconIndex := ExtractIconImage(PIDL);
end;

procedure TVirtualImageThread.InsertNewItem(Control: TWinControl;
  WindowsMessageID: LongWord; PIDL: PItemIDList; LargeIcon: Boolean;
  UserData: Pointer; Tag: integer);
var
  List: TList;
  Info: PVirtualThreadIconInfo;
begin
  List := QueryList.LockList;
  try
    Info := AllocMem(SizeOf(TVirtualThreadIconInfo));
    Info.Control := Control;
    Info.PIDL := PIDLMgr.CopyPIDL(PIDL);
    Info.LargeIcon := LargeIcon;
    Info.UserData := UserData;
    Info.Tag := Tag;
    Info.MessageID := WindowsMessageID;
    List.Insert(0, Info);
    SetEvent
  finally
    QueryList.UnlockList;
  end
end;

procedure TVirtualImageThread.InvalidateExtraction;
begin

end;

function TVirtualImageThread.NextID(APIDL: PItemIDList): PItemIDList;
begin
  Result := APIDL;
  if Assigned(APIDL) then
    Inc(PChar(Result), APIDL^.mkid.cb);
end;

function TVirtualImageThread.PIDLSize(APIDL: PItemIDList): integer;
// Returns the total Memory in bytes the PIDL occupies.
begin
  Result := 0;
  if Assigned(APIDL) then
  begin
    Result := SizeOf( Word);  // add the null terminating last ItemID
    while APIDL.mkid.cb <> 0 do
    begin
      Result := Result + APIDL.mkid.cb;
      APIDL := NextID(APIDL);
    end;
  end;
end;

procedure TVirtualImageThread.ReleaseItem(Item: PVirtualThreadIconInfo; const Malloc: IMalloc);
begin
  if Assigned(Item) then
  begin
    if Assigned(Item.PIDL) then
      Malloc.Free(Item.PIDL);
    FreeMem(Item)
  end
end;

procedure TVirtualImageThread.SetEvent;
begin
  Windows.SetEvent(ImageThreadEvent);
end;

function TVirtualImageThread.StripLastID(IDList: PItemIDList;
  var Last_CB: Word; var LastID: PItemIDList): PItemIDList;
var
  MarkerID: PItemIDList;
begin
  Last_CB := 0;
  LastID := nil;
  Result := IDList;
  MarkerID := IDList;
  if Assigned(IDList) then
  begin
    while IDList.mkid.cb <> 0 do
    begin
      MarkerID := IDList;
      IDList := NextID(IDList);
    end;
    Last_CB := MarkerID.mkid.cb;
    LastID := MarkerID;
    MarkerID.mkid.cb := 0;
  end;
end;

{ TVirtualImageThreadManager }

procedure TVirtualImageThreadManager.AddNewItem(Control: TWinControl; WindowsMessageID: LongWord;
  PIDL: PItemIDList; LargeIcon: Boolean; UserData: Pointer; Tag: integer);
begin
  if Assigned(ImageThread) then
  begin
    Assert(RegisteredControl(Control), 'Trying to add Image Thread Item to a unregistered control');
    ImageThread.AddNewItem(Control, WindowsMessageID, PIDL, LargeIcon, UserData, Tag)
  end
end;

procedure TVirtualImageThreadManager.ClearPendingItem(Control: TWinControl;
  TestItem: Pointer; MessageID: LongWord; const Malloc: IMalloc);
// Looks for the matching TestItem in the Item field of the record as a flag to delete
// the record
begin
  if Assigned(ImageThread) then
  begin
    if RegisteredControl(Control) then
    begin
      ImageThread.ClearPendingItem(Control, TestItem, MessageID, Malloc)
    end else
      Assert(True=False, 'Trying to clear pending Image Thead Items from an unregistered control');
  end
end;

procedure TVirtualImageThreadManager.ClearPendingItems(Control: TWinControl; MessageID: LongWord; const Malloc: IMalloc);
begin
  if Assigned(ImageThread) then
  begin
    if RegisteredControl(Control) then
    begin
      ImageThread.ClearPendingItems(Control, MessageID, Malloc)
    end else
      Assert(True=False, 'Trying to clear pending Image Thead Items from an unregistered control');
  end
end;

constructor TVirtualImageThreadManager.Create;
begin
  ControlList := TThreadList.Create;
  ThreadPriority := tpNormal;
end;

destructor TVirtualImageThreadManager.Destroy;
begin
  ReleaseImageThread;
  ControlList.Free;
  inherited;
end;

function TVirtualImageThreadManager.LockThread: TList;
begin
  if Assigned(ImageThread) then
    Result := ImageThread.QueryList.LockList
  else
    Result := nil
end;

procedure TVirtualImageThreadManager.InsertNewItem(Control: TWinControl;
  WindowsMessageID: LongWord; PIDL: PItemIDList; LargeIcon: Boolean;
  UserData: Pointer; Tag: integer);
begin
  if Assigned(ImageThread) then
  begin
    Assert(RegisteredControl(Control), 'Trying to add Image Thread Item to a unregistered control');
    ImageThread.InsertNewItem(Control, WindowsMessageID, PIDL, LargeIcon, UserData, Tag)
  end
end;

procedure TVirtualImageThreadManager.RegisterControl(Control: TWinControl);
var
  List: TList;
begin
  List := ControlList.LockList;
  try
    List.Add(Control);
    if not Assigned(ImageThread) then
    begin
      ImageThread := TVirtualImageThread.Create(False);
      ImageThread.Priority := ThreadPriority;
    end
  finally
    ControlList.UnlockList
  end
end;

function TVirtualImageThreadManager.RegisteredControl( Control: TWinControl): Boolean;
var
  List: TList;
begin
  if Assigned(Control) then
  begin
    List := ControlList.LockList;
    try
      Result := List.IndexOf(Control) > -1
    finally
      ControlList.UnlockList
    end
  end else
    Result := False;
end;

procedure TVirtualImageThreadManager.ReleaseItem(Item: PVirtualThreadIconInfo; const Malloc: IMalloc);
begin
  ImageThread.ReleaseItem(Item, Malloc)
end;

procedure TVirtualImageThreadManager.ReleaseImageThread;
begin
  if Assigned(ImageThread) then
  begin
    ImageThread.Priority := tpNormal; // So D6 shuts down faster.
    ImageThread.Terminate;
    ImageThread.SetEvent;
    ImageThread.WaitFor;
    FreeAndNil(FImageThread)
  end
end;

procedure TVirtualImageThreadManager.SetThreadPriority(
  Priority: TThreadPriority);
begin
  ThreadPriority := Priority;
  if Assigned(ImageThread) then
   ImageThread.Priority := ThreadPriority
end;

procedure TVirtualImageThreadManager.UnLockThread;
begin
  if Assigned(ImageThread) then
    ImageThread.QueryList.UnLockList
end;

procedure TVirtualImageThreadManager.UnRegisterControl(Control: TWinControl);
var
  List: TList;
  Index: integer;
begin
  List := ControlList.LockList;
  try
    Index := List.IndexOf(Control);
    if Index > -1 then
    begin
      List.Delete(Index);
      if List.Count = 0 then
        ReleaseImageThread;
      end
  finally
    ControlList.UnlockList
  end
end;

initialization

finalization
  ImageManager := nil;

end.