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

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

Snowy

Для данного примера нужно:
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;

Эта запись была добавлена в Пятница, 9 мая, 2008 - 7:17 В разделы ImageList, Компоненты. Вы можете подписаться на получение новых комментариев RSS 2.0 feed. Both comments and pings are currently closed.