[MaMu]

La verdad es que no entiendo como pasarlo a modo virtual, ya que quiciera probarlo puesto a que quiero trabajaron con centenares de imagenes.

Con un Form, un Button, un ImageList, un ListView y un Image, les dejo mi codigo para visualizar como thumbnails las imagenes jpg contenidas en una carpeta.

Alguien me ayuda a como pasarlo a modo virtual??? quizas asi me de cuenta.
Les agradezco de antemano. Me baje los ejemplos, y aun asi no he conseguido pararlo a virtual, me resulto interesante el comentario de "KeyBoy"

Aqui les va mi codigo, a ver si me ayudan a modificarlo:

Código Delphi [-]
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ImgList;
type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    Image1: TImage;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  lista: TStrings;
  
implementation
{$R *.dfm}
uses ActiveX, ShlObj, ComObj;
type
 IExtractImage = interface ['{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}']
   function GetLocation(pszPathBuffer: LPWSTR; cchMax: DWORD; 
var pdwPriority: DWORD; const prgSize: SIZE; dwRecClrDepth: DWORD; 
var pdwFlags: DWORD): HRESULT; stdcall;
  function Extract(var phBmpImage: HBITMAP): HRESULT; stdcall;
 end;
function GetThumbnail(lpPathName, lpFileName: PWideChar; Width, Height: Integer): TBitmap;
var
 Desktop, Folder: IShellFolder;
 ItemIDList: PItemIDList;
 Flags, Priority: Cardinal;
 ExtractImage: IExtractImage;
 Res: HRESULT;
 hBitmap: Windows.HBITMAP;
 Buffer: array[0..MAX_PATH-1] of WideChar;
 Size: TSize;
begin
 Result := nil;
 SHGetDesktopFolder(Desktop);
 if LongBool(Desktop.ParseDisplayName(0, nil, lpPathName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Desktop.BindToObject(ItemIDList, nil, IShellFolder, Folder);
 CoTaskMemFree(ItemIDList);
 if LongBool(Folder.ParseDisplayName(0, nil, lpFileName, PDWORD(0)^, ItemIDList, PDWORD(0)^)) then Exit;
 Folder.GetUIObjectOf(0, 1, ItemIDList, IExtractImage, nil, ExtractImage);
 CoTaskMemFree(ItemIDList);
 if not Assigned(ExtractImage) then Exit; // TODO
 Size.cx := Width; Size.cy := Height; Priority := 0;
 Flags := $28{IEIFLAG_SCREEN+IEIFLAG_OFFLINE};
 Res := ExtractImage.GetLocation(Buffer, SizeOf(Buffer), Priority, Size, 24{pf32bit}, Flags);
 if (Res = NOERROR) or (Res = E_PENDING{IEIFLAG_ASYNC}) then
  begin
   if not LongBool(ExtractImage.Extract(hBitmap)) then
    begin
     Result := TBitmap.Create;
     Result.Handle := hBitmap;
    end;
  end;
end;

procedure BuscarArchivos(const directorio, mascara: string;
  atributos: Integer; var listado: TStrings);
  // Procedimiento anidado
  //
  procedure Buscar(const subdirectorio: string);
  var
    regBusqueda: TSearchRec;
  begin
    // Buscar en el directorio
    if FindFirst(subdirectorio + mascara,atributos,regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if (regBusqueda.Attr and faDirectory = 0)
            or (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
                listado.Add(subdirectorio + regBusqueda.Name);
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;
    // Buscar en los subdirectorios
    if FindFirst(subdirectorio + '*', atributos
      or faDirectory, regBusqueda) = 0 then
    begin
      try
        repeat
          Application.ProcessMessages;
          if ((regBusqueda.Attr and faDirectory) <> 0)
            and (regBusqueda.Name <> '.')
              and (regBusqueda.Name <> '..') then
                Buscar(subdirectorio + regBusqueda.Name + '\');
        until FindNext(regBusqueda) <> 0;
      except
        FindClose(regBusqueda);
      end;
      FindClose(regBusqueda);
    end;
  end;
begin
  Buscar(IncludeTrailingPathDelimiter(directorio));
end;

procedure TForm1.Button1Click(Sender: TObject);
var AItem: TListItem;
    i,w:integer;
    directorio,archivo:array[0..255] of WideChar;
    a,d:string;
    ar,di:PWideChar;
begin
  ListView1.Clear;
  ImageList1.Clear;
  lista := TStringList.Create;
  lista.Clear;
  BuscarArchivos('C:\Documents and Settings\Admin\Mis documentos\Mis imágenes', '*.jpg', faAnyFile, lista);
  for w:=0 to Lista.Count-1 do
    begin
      a:=ExtractFileName(Lista.Strings[w]);
      ar:=StringToWideChar((a),archivo,255);
      d:=ExtractFilePath(Lista.Strings[w]);
      di:=StringToWideChar(d,directorio,255);
      try
        Image1.Picture.Assign(GetThumbnail(di,ar, 96, 96));
        ImageList1.Add(Image1.Picture.Bitmap,nil);
      except
        on E: Exception do
          begin
            ShowMessage('Error: '+E.Message);
            EXIT;
          end;
       end;
    end;
  ListView1.Items.BeginUpdate;
  for i:=0 to Lista.Count-1 do
    begin
      AItem := ListView1.Items.Add;
      AItem.Caption := ExtractFileName(Lista.Strings[i]);
      AItem.SubItems.Add(Lista.Strings[i]);
      AItem.ImageIndex:=i;
    end;
  ListView1.Items.EndUpdate;   
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Lista.Free;
end;
end.

Muchas Gracias y Saludos