Ver Mensaje Individual
  #2  
Antiguo 04-07-2024
Wellnic Wellnic is offline
Miembro
 
Registrado: mar 2007
Posts: 70
Reputación: 20
Wellnic Va por buen camino
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.
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?...
__________________
Programando habitualmente con Lazarus

Última edición por Wellnic fecha: 04-07-2024 a las 12:25:56.
Responder Con Cita