DelphiLab - Thumbinals - просмотр эскизов изображений

Thumbinals - просмотр эскизов изображений

Написал Snowy

09.09.2007

Для данного примера нужно:
1. Бросить на форму TListView
2. Бросит на форму TImageList
3. У TImageList прописать в Width и Height размеры эскизов (например 64 и 64)
4. У TListView выбрать в свойстве LageImages, брошенный на форму TImageList
Далее добавляем следующий код:

uses jpeg{, GifImage}{, PngImage};
 
procedure FillListView(path: string; mask: string = '*.jpg');
var
  sr:  TSearchRec;
  img: TPicture;
  bmp: TBitmap;
  pic: TBitMap;
begin
  img := TPicture.Create;
  bmp := TBitMap.Create;
  pic := TBitMap.Create;
  With Form1 do
  if FindFirst(path + mask, $20, sr) = 0 then
  begin
    repeat
      if (sr.Attr and $20) = $20 then
      begin
        try
          img.LoadFromFile(path + sr.Name);
        except
          Continue;
        end;
        bmp.Assign(img.Graphic);
        pic.Width := ImageList1.Width;
        pic.Height:= ImageList1.Height;
        pic.Canvas.StretchDraw(Rect(0,0,pic.Width, pic.Height), bmp);
        ImageList1.Add(pic, nil);
        with ListView1.Items.Add do begin
          Caption := sr.Name;
          ImageIndex := ListView1.Items.Count-1;
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  img.Free; bmp.Free; pic.Free;
end;

Заполняется лист следующим образом:

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form1.ListView1.Clear;
  FillListView('C:\', '*.jpg');
  FillListView('C:\', '*.bmp');
  //FillListView('C:\', '*.gif'); // тебует установки TGifImage
  //FillListView('C:\', '*.png'); // тебует установки TPngImage
end;