Title: Bitmap in TListBox background, part 2
Question: How does one display a bitmap or other graphic in the
background of the TListBox component.
Answer:
Like I said in one of my responses, one must override the WM_ERASEBKGRND
message and a few other things.
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TBitmapListBox = class(TCustomListBox)
private
FBitmap : TBitmap;
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
procedure WMHScroll(var Message : TWMCommand); message WM_HSCROLL;
procedure WMVScroll(var Message : TWMCommand); message WM_VSCROLL;
procedure WMKeyDown(var Message : TWMCommand); message WM_KEYDOWN;
protected
procedure DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState); override;
public
constructor Create(AComponent : TComponent); override;
destructor Destroy; override;
published
property Align;
property Anchors;
property BiDiMode;
property BorderStyle;
property Color;
property Columns;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ExtendedSelect;
property Font;
property ImeMode;
property ImeName;
property IntegralHeight;
property ItemHeight;
property Items;
property MultiSelect;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property TabWidth;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnDrawItem;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
tblb : TBitmapListBox;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
{ TBitmapListBox }
constructor TBitmapListBox.Create(AComponent: TComponent);
var
FileStream : TFileStream;
begin
inherited;
FileStream := TFileStream.Create('c:\TEMP\RANDOMNN.BMP', fmOpenRead);
FBitmap := TBitmap.Create;
FBitmap.LoadFromStream(FileStream);
FileStream.Free;
Style := lbOwnerDrawFixed;
end;
destructor TBitmapListBox.Destroy;
begin
FBitmap.Free;
inherited;
end;
// Blt picture to the listbox background
procedure TBitmapListBox.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
BitBlt(Message.DC, 0, 0, Width, Height, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;
// Called to draw an item
procedure TBitmapListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
Flags: Longint;
begin
// Put code in here to allow owner drawing of items
BitBlt(Canvas.Handle, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, FBitmap.Canvas.Handle, Rect.Left,
Rect.Top, SRCCOPY);
if Index begin
Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER);
if not UseRightToLeftAlignment then
Inc(Rect.Left, 2)
else
Dec(Rect.Right, 2);
Canvas.Brush.Style := bsClear;
DrawText(Canvas.Handle, PChar(Items[Index]), Length(Items[Index]), Rect,
Flags);
end;
end;
// Override to force a repaint of the entire control, otherwise
// the bitmap gets corrupte
procedure TBitmapListBox.WMHScroll(var Message: TWMCommand);
begin
LockWindowUpdate(Self.Handle);
inherited;
Invalidate;
LockWindowUpdate(0);
end;
// Override to force a repaint of the entire control, otherwise
// the bitmap gets corrupte
procedure TBitmapListBox.WMVScroll(var Message: TWMCommand);
begin
LockWindowUpdate(Self.Handle);
inherited;
Invalidate;
LockWindowUpdate(0);
end;
// Override to force a repaint of the entire control, otherwise
// the bitmap gets corrupt (only when a scroll happens)
procedure TBitmapListBox.WMKeyDown(var Message: TWMCommand);
var
OldTop : integer;
begin
OldTop := TopIndex;
LockWindowUpdate(Self.Handle);
inherited;
// Should be able to figure out a better way of only invalidating when
// necessary, but I wasn't able to figure out the case when a user hits a letter
// like, 'm' in this example
// if OldTop TopIndex then
Invalidate;
LockWindowUpdate(0);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
i : integer;
begin
tblb := TBitmapListBox.Create(Self);
with tblb do
begin
Parent := Self;
Left := 4;
Top := 4;
Width := 640;
Height := 480;
for i := 0 to 500 do
Items.Add('Monkey vs. Robot!');
end;
end;