| Wellnic |
04-07-2024 12:15:49 |
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 :D Debería ponerlo en "Código sin utilidad", pero no encuentro el hilo aquel.
Código:
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?... |
