Wątkowe ładowanie ikon w Delphi

Korzystanie z Delphi 2009, próbując stworzyć program uruchamiający. Żeby było „żwawe”, naprawdę chciałbym załadować ikony w wątku w tle.

Użyłem znalezionego tutaj rozwiązania:Czy ikony 48x48 lub 64x64 można uzyskać z Vista Shell?

Działa to dobrze, jeśli NIE działa w wątku. Jak tylko umieściłem go w wątku, niektóre ikony nie są „pobierane” lub stanowią rodzajową ikonę. Próbowałem nawet serializować wątki (czyniąc je nieaktualnymi, w efekcie), ale daje to takie same wyniki.

Pytanie brzmi: jak załadować ikony (z tymi samymi dostępnymi opcjami, co przykład połączony) w wątku?

/ Lars

Edycja: Dodano kilka podstawowych sprawdzeń błędów w GetIconFromFile

if SHGetFileInfo( PChar( aFile ),
                FILE_ATTRIBUTE_NORMAL,
                SFI,
                SizeOf( TSHFileInfo ),
                SHGFI_ICON
                  or SHGFI_LARGEICON
                  or SHGFI_SHELLICONSIZE
                  or SHGFI_SYSICONINDEX
                  or SHGFI_TYPENAME
                  or SHGFI_DISPLAYNAME ) <> 0 then
begin
  if not Assigned( aIcon ) then
    aIcon := TIcon.Create;
  aImgList := GetImageListSH( SHIL_FLAG );
  aIndex := SFI.iIcon;
  if aImgList <> 0 then
    aIcon.Handle := ImageList_GetIcon( aImgList, aIndex, ILD_NORMAL );
end;

To nie robi żadnych różnic. Nadal otrzymuję kilka ogólnych ikon (ale tylko wtedy, gdy jest to wywoływane w wątku)

Edit2: Kod wątku (bardzo prosty):

procedure TIconLoader.Execute;
var
  Item : TGridItem;
  I : TIcon;
begin
  inherited;

  while not terminated do
  begin
    Item := nil;
    if assigned(FOnNeedGridItem) then
    begin
      Synchronize(
          procedure
          begin
            FOnNeedGridItem(Self, Item);
          end
      );
    end;

    if assigned(Item) then
    begin
      GetIconFromFile(Item.FFilename, I, SHIL_EXTRALARGE);
      Synchronize(
          procedure
          begin
            Item.SetIcon(I);
          end
      );
//      I.Free;
    end
    else
      Terminate;
  end;
end;

questionAnswers(3)

yourAnswerToTheQuestion