Реализация миниатюр Windows через TListView - PullRequest
0 голосов
/ 28 октября 2018

Я использую Delphi XE3 и хочу реализовать стиль миниатюр Windows для отображения списка изображений с помощью элемента управления TListView.

Что мне нужно, как показано ниже:

enter image description here

Изображения отображаются в виде миниатюр, под каждым изображением есть подпись.И когда я нажимаю на изображение, изображение вместе с подписью будет отображаться как выбранное ...

Чтобы улучшить производительность, я не хочу загружать все изображения в список изображений заранее, вместо этого яхотите загрузить изображение, когда оно должно быть отображено.Поэтому я думаю об использовании OnCustomDrawItem и OnAdvancedCustomDrawItem.

Ниже приведена очень простая версия моего плана (я установил стиль представления списка как vsIcon):

    procedure TForm1.FormCreate(Sender: TObject);
    var
      ListItem1: TListItem;
    begin
      ListItem1 := ListView1.Items.Add;

      ListItem1.Caption := 'Chrysanthemum';
    end;

    procedure TForm1.ListView1AdvancedCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
      var DefaultDraw: Boolean);
    var
      JPEG: TJPEGImage;
      R: TRect;
    begin
    {
      R := Item.DisplayRect(drBounds);

      JPEG := TJPEGImage.Create;

      JPEG.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum (2).jpg');

      Sender.Canvas.StretchDraw(R, JPEG);
    }
    end;

    procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    var
      JPEG: TJPEGImage;
      R: TRect;
    begin
      R := Item.DisplayRect(drBounds);

      JPEG := TJPEGImage.Create;

      JPEG.LoadFromFile('C:\Users\Public\Pictures\Sample Pictures\Chrysanthemum (2).jpg');

      Sender.Canvas.StretchDraw(R, JPEG);
    end;

Норезультат неудовлетворительный, как показано ниже:

  1. Я не могу найти способ установить размер каждого значка.(Все иконки будут иметь одинаковый размер).

  2. Я пытаюсь поместить коды в OnCustomDrawItem и OnAdvancedCustomDrawItem.Я не могу понять много различий между этими двумя.Единственное основное отличие в том, что в версии Advancedxxx, заголовок редактируемый.Я не могу понять, почему.

  3. Подпись не отображается под изображением, вместо этого она находится в середине изображения, что нежелательно.Как это исправить?

Спасибо

1 Ответ

0 голосов
/ 07 ноября 2018

Прикрепленный код загружает изображения (в данном случае значки) в TImageList, который назначен свойству LargeImages в TListView, только когда соответствующий значок фактически отображается в представлении списка.Главное - установить для свойства OwnerData представления списка значение TRUE и создать обработчик событий для событий OnData.Параллельно элементам в просмотре списка программа поддерживает список элементов в просмотре списка, который синхронизирован с фактическим списком в просмотре списка, в данном случае TStringList.В его свойстве Objects я храню индекс связанного ресурса значков, если он уже был загружен и добавлен в TImageList.Если ресурс значков не был загружен, это происходит в функции LoadIconFromFile, и индекс значка в TImageList сохраняется в TStringList.

Фактическое рисование значков и текста в TListViewполностью обрабатывается самим элементом управления, код не обрабатывает ни OnDraw, ни какие-либо OnCustomDraw* события.Просто установите размер изображения в TImageList равным размеру растровых изображений, которые вы хотите отобразить, и создайте их соответствующим образом.

Старые версии Delphi содержат пример проекта VirtualListView.dpr, который очень полезно понять, когдаразличные OnData* события запускаются и как их правильно использовать.

unit MainFormU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Icons_LV: TListView;
    Label1: TLabel;
    Large_IL: TImageList;
    procedure Icons_LVData(Sender: TObject; Item: TListItem);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FileList : TStringList;

    procedure FillListView;
    function LoadIconFromFile (const sFileName: String;
                               out iIndex: Integer) : Boolean;
  end;

var Form1 : TForm1;

implementation

{$R *.dfm}

uses ShellApi;

const
  cWinSysDir = 'c:\windows\system32\';

procedure TForm1.FormCreate (Sender: TObject);
begin
  FileList := TStringList.Create;
  FillListView;
end;

procedure TForm1.FormDestroy (Sender: TObject);
begin
  FileList.Free;
end;

procedure TForm1.Icons_LVData (Sender: TObject; Item: TListItem);

var iIndex : Integer;

begin
  if (Item.Index >= FileList.Count) then
    exit;

  Item.Caption := FileList [Item.Index];

  if (FileList.Objects [Item.Index] = TObject (-1)) then
  begin
    if not (LoadIconFromFile (cWinSysDir + Item.Caption, iIndex)) then
      iIndex := 0;

    FileList.Objects [Item.Index] := TObject (iIndex);
  end { if }
  else iIndex := Integer (FileList.Objects [Item.Index]);

  Item.ImageIndex := iIndex
end;

procedure TForm1.FillListView;

var SR : TSearchRec;

begin
  FillChar (SR, SizeOf (TSearchRec), #0);

  if (FindFirst (cWinSysDir + '*.exe', faAnyFile, SR) = 0) then
    repeat
      FileList.AddObject (SR.Name, TObject ((-1)));
    until (FindNext (SR) <> 0);

  FindClose (SR);
  Icons_LV.Items.Count := FileList.Count;
end;

function TForm1.LoadIconFromFile (const sFileName: String;
                                  out iIndex: Integer) : Boolean;

var
  hIcon : Windows.HICON;
  Icon : TIcon;

begin
  Result := false;

  if (ExtractIcon (MainInstance, PChar (sFileName), UInt ((-1))) > 0) then
  begin
{$IFDEF DEBUG}
    OutputDebugString (PChar (Format ('LoadIconFromFile "%s"', [sFileName])));
{$ENDIF}
    hIcon := ExtractIcon (MainInstance, PChar (sFileName), 0);

    if (hIcon <> 0) then
    begin
      Icon := TIcon.Create;
      Icon.Handle := hIcon;
      iIndex := Large_IL.AddIcon (Icon);
      Icon.Free;
      Result := true;
    end; { if }
  end { if }
end;

end.

Полный пример доступен для скачивания здесь .

...