VPF::Просмотр файла в виде Эскиза как в Windows

alexeykaa

Дата 22.1.2006, 10:46 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 21.1.2006

Репутация: нет
Всего: нет

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

Демо

Дата 22.1.2006, 13:26 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: нет
Всего: 50

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

--------------------

Snowy

Дата 23.1.2006, 12:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

Кидаешь на форму 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 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484

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

Код


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;

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »