Title: Background image in a TListView
Question: How can I put a background image in a TListView?
Answer:
unit RVListView;
interface
uses
SysUtils, Classes, Controls, ComCtrls, Messages, Windows, Graphics;
type
TBitmapPos = (bpTopLeft, bpTopRight, bpBottomLeft,
bpBottomRight, bpTile, bpCenter);
TRVListView = class(TListView)
private
FTag: Integer;
FBitmap: TBitmap;
FBitmapPos: TBitmapPos;
procedure SetBitmap(const Value: TBitmap);
procedure SetBitmapPos(const Value: TBitmapPos);
procedure OnBitmapChange(Sender: TObject);
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
protected
procedure Paint; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Bitmap: TBitmap read FBitmap write SetBitmap;
property BitmapPos: TBitmapPos read FBitmapPos write SetBitmapPos;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Rendez-vous', [TRVListView]);
end;
{ TRVListView }
constructor TRVListView.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
//Initialize some variables
FTag := 0;
FBitmap := TBitmap.Create;
FBitmap.OnChange := OnBitmapChange;
FBitmapPos := bpBottomRight;
end;
destructor TRVListView.Destroy;
begin
FBitmap.Free; //Free the background image
inherited Destroy;
end;
procedure TRVListView.OnBitmapChange(Sender: TObject);
begin
Invalidate; //Call a refresh
end;
procedure TRVListView.Paint;
var
X : LongInt;
Y : LongInt;
W : LongInt;
H : LongInt;
R : TRect;
DC: HDC;
begin
if not Assigned(FBitmap) then
exit;
R := GetClientRect;
W := FBitmap.Width;
H := FBitmap.Height;
DC := GetDC(Self.Handle); //Get an handle to the TListView
//Draw the bitmap at a specific position
if FBitmapPos = bpTopLeft then
begin
BitBlt(DC,0,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
end
else if FBitmapPos = bpTopRight then
begin
BitBlt(DC,R.Right - W,0,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
end
else if FBitmapPos = bpBottomLeft then
begin
BitBlt(DC,0,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
end
else if FBitmapPos = bpBottomRight then
begin
BitBlt(DC,R.Right - W,R.Bottom - H,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
end
else if FBitmapPos = bpTile then
begin
Y := R.Top;
while Y Height do
begin
X := R.Left;
while X Width do
begin
BitBlt(DC,X,Y,W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
Inc(X,W);
end;
Inc(Y,H);
end;
end
else if FBitmapPos = bpCenter then
begin
BitBlt(DC,(R.Right - R.Left - W) div 2,(R.Bottom - R.Top - H) div 2,
W,H,FBitmap.Canvas.Handle,0,0,SrcAnd);
end;
ReleaseDC(Self.Handle,DC); //Release the handle
//This condition is necessary to prevent flickering
if FTag = 0 then
begin
Invalidate;
FTag := 1;
end
else
FTag := 0;
end;
procedure TRVListView.SetBitmap(const Value: TBitmap);
begin
FBitmap.Assign(Value);
end;
procedure TRVListView.SetBitmapPos(const Value: TBitmapPos);
begin
if FBitmapPos Value then
begin
FBitmapPos := Value;
Invalidate;
end;
end;
procedure TRVListView.WMPaint(var Message: TWMPaint);
begin
inherited;
Paint;
end;
end.