нарисованные эскизы в tlistbox - PullRequest
2 голосов
/ 24 марта 2011

В DelphiXE я использую tFileOpenDialog, чтобы выбрать папку, а затем перечисляю все файлы * .jpg в этой папке в tListBox.Я разрешаю перетаскивать элементы списка в списке для пользовательской сортировки, чтобы я мог отобразить их по порядку позже.

Я хотел бы иметь возможность рисовать миниатюру изображения рядом симя файла, поэтому при просмотре файлов в представлении «Список», где у вас есть соответствующий значок, расположенный слева от имени файла в той же строке, экран похож на Windows Explorer.

Я нашел несколько старых примеров, которыезаставьте меня поверить, что это возможно с помощью tListBox.onDrawItem, но я не смог заставить его работать.

Какой наилучший подход можно использовать для достижения этой цели с помощью tListBox или каким-либо другим способом?

Спасибо за вашу помощь.


Обновление: вместо этого я работаю над использованием tListView, как и предлагалось.

Я пытался преобразовать примерыот Кена и Андреаса, чтобы использовать реальные изображения вместо динамически создаваемых образцов растровых изображений.Я смог заставить работать основы, но без изменения размера я получаю только верхний левый угол изображения 64 * 64.На данный момент я работаю только с JPG.imagecount - это просто количество моего списка имен файлов в моем списке, на данный момент я не перенес первоначальное создание списка в представление списка.

Это делается с помощью этого кода:

procedure TfrmMain.CreateThumbnails;
var
  i: Integer;
  FJpeg: TJpegImage;
  R: TRect;
begin
  for i := 0 to imageCount - 1 do
  begin
    FJpeg := TJpegImage.Create;
    thumbs[i] := TBitmap.Create;
    FJpeg.LoadFromFile(Concat(imgFolderlabel.caption,
      photoList.Items.Strings[i]));
    thumbs[i].Assign(FJpeg);
    thumbs[i].SetSize(64, 64); 
  end;
  imgListView.LargeImages := ImageList1;
  FJpeg.Free;
end;

Чтобы также правильно изменить размеры и растянуть изображение в пределах эскиза, я пытаюсь реализовать здесь некоторый код: http://delphi.about.com/od/graphics/a/resize_image.htm

Новый код выглядит следующим образом:

<code>
procedure TfrmMain.CreateThumbnails;
var
  i: Integer;
  FJpeg: TJpegImage;
  R: TRect;
begin
  for i := 0 to imageCount - 1 do
  begin
      FJpeg := TJpegImage.Create;
      thumbs[i] := TBitmap.Create;
      FJpeg.LoadFromFile(Concat(imgFolderlabel.caption,
        photoList.Items.Strings[i]));
      thumbs[i].Assign(FJpeg);<br>
      //resize code
      R.Left := 0;
      R.Top := 0;
      // proportional resize
      if thumbs[i].Width > thumbs[i].Height then
      begin
        R.Right := 64;
        R.Bottom := (64 * thumbs[i].Height) div thumbs[i].Width;
      end
      else
      begin
        R.Bottom := 64;
        R.Right := (64 * thumbs[i].Width) div thumbs[i].Height;
      end;
      thumbs[i].Canvas.StretchDraw(R, thumbs[i]);
      // resize image
      //thumbs[i].Width := R.Right;
      //thumbs[i].Height := R.Bottom;<br>
      thumbs[i].SetSize(64, 64); //all images must be same size for listview<br>
  end;
  imgListView.LargeImages := ImageList1;
  FJpeg.Free;
end;

Это дает мне коллаж из миниатюр изображений с их именами файлов и работает хорошо.

Спасибо.

Ответы [ 2 ]

4 голосов
/ 24 марта 2011

Не ответ, а альтернатива (используя код Андреаса для создания массива изображений в качестве отправной точки). Удалите TListView и TImageList в новой форме, вырежьте весь код из редактора от interface до чуть выше финального end. с помощью этого:

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

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    ListView1: TListView;
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    procedure CreateListItems;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  N = 50;
  THUMB_WIDTH = 32;
  THUMB_HEIGHT = 32;
  THUMB_PADDING = 4;

var
  thumbs: array[0..N-1] of TBitmap;

procedure CreateThumbnails;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    thumbs[i] := TBitmap.Create;
    thumbs[i].SetSize(THUMB_WIDTH, THUMB_HEIGHT);
    thumbs[i].Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
    thumbs[i].Canvas.FillRect(Rect(0, 0, THUMB_WIDTH, THUMB_HEIGHT));
  end;
end;


procedure TForm1.CreateListItems;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    with ListView1.Items.Add do
    begin
      Caption := 'Item ' + IntToStr(i);
      ImageIndex := i;
    end;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  i: Integer;
begin
  CreateThumbnails;
  for i := 0 to N - 1 do
    ImageList1.Add(thumbs[i], nil);
  ListView1.LargeImages := ImageList1;
  CreateListItems;
end;

enter image description here

1 голос
/ 24 марта 2011

OnDrawItem - хороший путь.

Простой пример:

const
  N = 50;
  THUMB_WIDTH = 64;
  THUMB_HEIGHT = 64;
  THUMB_PADDING = 4;

var
  thumbs: array[0..N-1] of TBitmap;

procedure CreateThumbnails;
var
  i: Integer;
begin
  for i := 0 to N - 1 do
  begin
    thumbs[i] := TBitmap.Create;
    thumbs[i].SetSize(THUMB_WIDTH, THUMB_HEIGHT);
    thumbs[i].Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255));
    thumbs[i].Canvas.FillRect(Rect(0, 0, THUMB_WIDTH, THUMB_HEIGHT));
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
var
  i: integer;
begin
  with ListBox1.Items do
  begin
    BeginUpdate;
    for i := 0 to N - 1 do
      Add(Format('This is item %d.', [i]));
    EndUpdate;
  end;
  ListBox1.ItemHeight := 2*THUMB_PADDING + THUMB_HEIGHT;
  CreateThumbnails;
end;

procedure TForm4.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  dc: HDC;
  s: string;
  r: TRect;
begin
  dc := TListBox(Control).Canvas.Handle;
  s := TListBox(Control).Items[Index];
  FillRect(dc, Rect, GetStockObject(WHITE_BRUSH));
  BitBlt(dc,
    Rect.Left + THUMB_PADDING,
    Rect.Top + THUMB_PADDING,
    THUMB_WIDTH,
    THUMB_HEIGHT,
    thumbs[Index].Canvas.Handle,
    0,
    0,
    SRCCOPY);
  r := Rect;
  r.Left := Rect.Left + 2*THUMB_PADDING + THUMB_WIDTH;
  DrawText(dc,
    PChar(s),
    length(s),
    r,
    DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
end;

В реальном сценарии массив thumbs будет содержать фактические большие пальцы изображения.В этом примере, однако, «миниатюры» состоят из одноцветных квадратов.

http://privat.rejbrand.se/listviewthumbs.png

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...