Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Звук, графика и видео > Просмотр файла в виде Эскиза как в Windows

Автор: alexeykaa 22.1.2006, 10:46

Добрый день. Подскажите пожалуйста, кто знает как програмно в Delphi реализовать просмотр файла в виде Эскиза, так как это реализовано в Windows (через меню в Проводнике: Вид->Эскизы страниц). То есть зная полный путь файла получить картинку в которой содержится эскиз содержимого файла.

Автор: Демо 22.1.2006, 13:26

Если при открытии файлов, то TOpenDialog

Автор: Snowy 23.1.2006, 12:54

Кидаешь на форму ImageList.
Выставляешь у него параметры Winth и Height - это будут размеры эскизов (например 64 и 64 поставь)
Кидаешь на форму ListView.
Ничего в нем не меняешь, кроме параметра LargeImages. LargeImages выбираешь ListView1.
Вот процедура заполнения:

Код


procedure FillListView(path: string);
var
  sr:  TSearchRec;
  bmp: TBitMap;
  pic: TBitMap;
begin
  bmp:=TBitMap.Create;
  pic:=TBitMap.Create;
  Form1.ListView1.Clear;
  With Form1 do
  if FindFirst(path+'*.bmp', $20, sr) = 0 then
  begin
    repeat
      if (sr.Attr and $20) = $20 then
      begin
        bmp.LoadFromFile(path + sr.Name);
        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;
  bmp.Free; pic.Free;
end;

Пример использования:

Код


procedure TForm1.Button1Click(Sender: TObject);
begin
  FillListView('C:\');
end;

Работает, правда, только с bmp. Но можно прикрутить аналогично и другие форматы.

Автор: Snowy 25.9.2006, 12:35

Дополню решение - теперь для любого подключенного формата:

Код


uses jpeg{, GifImage};

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;

P.S. не забыть подключить модули для чтения указанного типа файлов.
Пример:

Код


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