Как установить фоновое изображение для TListview в Delphi XE? - PullRequest
Новая
       28

Как установить фоновое изображение для TListview в Delphi XE?

1 голос
/ 21 октября 2010

Как мне установить фоновое изображение в TListview в Delphi XE ??

Я хочу создать приложение, подобное Windows Explorer.

Ответы [ 2 ]

8 голосов
/ 21 октября 2010

Чтобы установить водяной знак в просмотре списка, вам нужно использовать сообщение LVM_SETBKIMAGE и переопределить стандартное сообщение WM_ERASEBKGND в TListView. Listview становится владельцем дескриптора растрового изображения, поэтому вам нужно использовать ReleaseHandle в TBitmap, а не просто Handle.

Если вы хотите, чтобы он был выровнен по верхнему левому углу, а не по правому нижнему углу, как в Проводнике, используйте LVBKIF_SOURCE_HBITMAP вместо LVBKIF_TYPE_WATERMARK для значения ulFlags. 

uses
  CommCtrl, ...;

type
  TListView = class(ComCtrls.TListView)
  protected
    procedure WndProc(var Message: TMessage);
      override;
  end;

  TForm4 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  end;

procedure TListView.WndProc(var Message: TMessage);
begin
  if Message.Msg = WM_ERASEBKGND then
    DefaultHandler(Message)
  else
    inherited WndProc(Message);
end;

procedure TForm4.FormCreate(Sender: TObject);
var
  Img: TImage;
  BkImg: TLVBKImage;
begin
  FillChar(BkImg, SizeOf(BkImg), 0);
  BkImg.ulFlags := LVBKIF_TYPE_WATERMARK;
  // Load image and take ownership of the bitmap handle
  Img := TImage.Create(nil);
  try
    Img.Picture.LoadFromFile('C:\Watermark.bmp');
    BkImg.hbm := Img.Picture.Bitmap.ReleaseHandle;
  finally
    Img.Free;
  end;
  // Set the watermark
  SendMessage(ListView1.Handle, LVM_SETBKIMAGE, 0, LPARAM(@BkImg));
end;

растянутый водяной знак

Представление списка изначально не поддерживает растягивание растрового изображения по всему фону. Для этого вам нужно сделать StretchBlt в ответ на WM_ERASEBKGND самостоятельно. 

type
  TMyListView = class(TListView)
  protected
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    Watermark: TBitmap;
  end;

procedure TMyListView.CreateHandle;
begin
  inherited;
  // Set text background color to transparent
  SendMessage(Handle, LVM_SETTEXTBKCOLOR, 0, CLR_NONE);
end;

procedure TMyListView.CreateParams(var Params: TCreateParams);
begin
  inherited;
  // Invalidate every time the listview is resized
  Params.Style := Params.Style or CS_HREDRAW or CS_VREDRAW;
end;

procedure TMyListView.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
  StretchBlt(Msg.DC, 0, 0, Width, Height, Watermark.Canvas.Handle,
    0, 0, Watermark.Width, Watermark.Height, SrcCopy);
  Msg.Result := 1;
end;
1 голос
/ 22 октября 2010

Tlistview это хорошо, но если вы хотите больше.Я предлагаю вам обновить с VirtualStringTree (VirtualTreeView) очень гибко, вы можете настроить его практически все, что вы хотите, и больше всего бесплатно.

...