Miniaturas de Windows

[Wellnic]

Hola, qué hay

¿Sabéis de algún componente en Lazarus que me permita ver las miniaturas del explorador de Windows?
Se supone que estas miniaturas se van almacenando en los archivos con extensión .db del directorio
%userprofile%\AppData\Local\Microsoft\Windows\Explorer y ahora me ha entrado la curiosidad de
ver lo que guarda Windows a mis espaldas, pero me encuentro algo perezoso y no me siento con ganas
de picar mucho código...

[Wellnic]

Hace unos días encontré por casualidad el Thumbs cache viewer mientras pergeñaba mi propio programa para ver las miniaturas que me oculta Windows. Me salió
este churro que funciona cuando quiere y un poco cuando le da la gana Debería ponerlo en "Código sin utilidad", pero no encuentro el hilo aquel.

uses
  Windows, Classes, SysUtils, Forms, Controls, StdCtrls, ExtCtrls,
  ComCtrls, CheckLst, FileUtil, Win32TaskbarProgress;
type

  { TForm1 }

  TForm1 = class(TForm)
    ListBox1: TListBox;
    ProgressBar1: TProgressBar;
    ScrollBox1: TScrollBox;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private

  public

  end;

Const mw= 'F:\db\';
  //directorio donde copio las miniaturas  ubicadas en
  //%USERPROFILE%\AppData\Local\Microsoft\Windows\Explorer
  //ya que el 10 no siempre está de humor para revelarme
  //mis secretos directamente

var
  Form1: TForm1;
  imagen, miniaturas: TMemoryStream;
  mosaico: Array of TImage;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
Var d, i: Integer;
   fb: TSearchRec;
   nf:String;

begin
Screen.HintFont.size:= 10;
GlobalTaskbarProgress:= TWin7TaskProgressBar.Create;
miniaturas:= TMemoryStream.Create; imagen:= TMemoryStream.Create;
ListBox1.Enabled:= False;
ScrollBox1.HorzScrollBar.Visible:= False;
ScrollBox1.Left:= ListBox1.Width+ 10;
ScrollBox1.Width:= GetSystemMetrics(SM_CXSCREEN)- ScrollBox1.Left;
d:= FindFirst(mw+ '*.db',faanyfile, fb);
While d= 0 Do
  Begin
  nf:=fb.Name;
  if (fb.Size> 100) And (nf.Contains('idx')= False)Then ListBox1.Items.Append(ExtractFileNameWithoutExt(fb.Name));
  d:= FindNext(fb);
  end;
FindClose(fb);
ListBox1.Enabled:= True;
StatusBar1.Panels[0].Text:= IntToStr(ListBox1.Count)+ ' ficheros';
end;

procedure TForm1.FormResize(Sender: TObject);
begin
ScrollBox1.Height:= Height- 60;
ListBox1.Height:= Height- 60;//(Left: 7  Width: 240)
ProgressBar1.Top:= Height- 45;
end;

Procedure TForm1.ListBox1Click(Sender: TObject);
const nm= 7888;//número arbitrario
Var  m: Byte;
     fm: String;
     mys: Boolean;
     x, y, my: Integer;
     mp, p, tc, ti: UInt32;

Begin
SetLength(mosaico, nm); For mp:= 0 To nm- 1 Do If Assigned(mosaico[mp]) Then mosaico[mp].Free Else Break;
ListBox1.Enabled:= False;
//fm:= GetEnvironmentVariable('USERPROFILE')+ '\AppData\Local\Microsoft\Windows\Explorer\'+ ListBox1.Items[ListBox1.ItemIndex]+'.db';
fm:= mw+ ListBox1.Items[ListBox1.ItemIndex]+'.db';
StatusBar1.Panels[1].Text:= IntToStr(FileSize(fm));
miniaturas.Position:= 0; miniaturas.LoadFromFile(fm);
ProgressBar1.Max:= miniaturas.Size; ProgressBar1.Visible:= True;
GlobalTaskbarProgress.Max:= miniaturas.Size;
p:= 24; x:= 0; y:= 0; my:= 0; mys:= ssShift In GetKeyShiftState;
For mp:= 0 To nm Do
  Begin
  miniaturas.Seek(p+ 4, soBeginning);tc:= miniaturas.ReadDWord; if ((p+ tc)= miniaturas.Size) Or (GetKeyState(VK_ESCAPE)< 0) Then Break;
  mosaico[mp]:= TImage.Create(ScrollBox1);
  mosaico[mp].Parent:= ScrollBox1;
  mosaico[mp].Left:= x; mosaico[mp].Top:= y;
  miniaturas.Seek(8, soCurrent); m:= 56+ miniaturas.ReadByte;
  If mys= True Then
    Begin
    Inc(m, 2);
    If m In [120, 88, 104] Then Dec(m, 2);
    End;
  miniaturas.Seek(7, soCurrent); ti:= miniaturas.ReadDWord;
  miniaturas.Seek(p+ m, soBeginning);
  mosaico[mp].ShowHint:= True;
  mosaico[mp].Hint:= 'Cache Entry Offset: '+ IntToStr(p)+ #13+ 'Data Offset: '+ IntToStr(miniaturas.Position);
  imagen.Position:=0; imagen.CopyFrom(miniaturas,ti);
  imagen.Position:= 0;
  mosaico[mp].Picture.LoadFromStream(imagen);
  Application.ProcessMessages;
  mosaico[mp].AutoSize:=True; If (y+ mosaico[mp].Height)> my Then my:= y+ mosaico[mp].Height;
  If (x+ mosaico[mp].Width)> (ScrollBox1.Width- 20) Then
    Begin
    x:= 0; mosaico[mp].Left:= x;
    y:= my+ 5; mosaico[mp].Top:= y;
    end;
  Inc(x, mosaico[mp].Width+ 5);
  Inc(p, tc); ProgressBar1.Position:= p; GlobalTaskbarProgress.Progress:= p;
  End;
StatusBar1.Panels[2].Text:= 'Se han encontrado '+ IntToStr(mp)+ ' miniaturas';
ProgressBar1.Position:= p+ tc;
ListBox1.Enabled:= True;
End;

Lo que no acierto a comprender es por qué se va haciendo cada vez más el remolón a medida que aumentan las miniaturas en pantalla. ¿Es por el Scrollbox,
por los TImage?...