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

Question

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

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

Answer 1

Чтобы установить водяной знак в списке, вам необходимо использовать сообщение 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; 

Натяжные Watermark

элемент управления ListView изначально не поддерживает растяжения растрового изображения по всему фону. Для этого вам нужно сделать 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; 

Answer 2

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