TransparentListBox

unit TransparentListBox;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TTransparentListBox = class(TListBox)
private
{ Private declarations }
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
{ Published declarations }
property Style default lbOwnerDrawFixed;
property Ctl3D default False;
property BorderStyle default bsNone;
end;
procedure Register;
implementation

constructor TTransparentListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Ctl3D := False;
BorderStyle := bsNone;
Style := lbOwnerDrawFixed; // changing it to lbStandard results
// in loss of transparency
end;
procedure TTransparentListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;
procedure TTransparentListBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
Msg.Result := 1; // Prevent background from getting erased
end;
procedure TTransparentListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
tlbVisible: Boolean;
begin
tlbVisible := (Parent <> nil) and IsWindowVisible(Handle); // Check forvisibility
if tlbVisible then ShowWindow(Handle, SW_HIDE); // Hide-Move-Shows trategy...
inherited SetBounds(ALeft, ATop, AWidth, AHeight); // ... to prevent background...
if tlbVisible then ShowWindow(Handle, SW_SHOW); // ... from getting copied
end;
procedure TTransparentListBox.DrawItem(Index: Integer; Rect: TRect;
State: TOwnerDrawState);
var
FoundStyle: TBrushStyle;
R: TRect;
begin
FoundStyle := Canvas.Brush.Style; // Remember the brush style
R := Rect; // Adapt coordinates of drawing rect...
MapWindowPoints(Handle, Parent.Handle, R, 2); // ... to parent's coordinate system
InvalidateRect(Parent.Handle, @R, True); // Tell parent to redraw the item Position
Parent.Update; // Trigger instant redraw(required)
if not (odSelected in State) then
begin // If an unselected line is being
//handled
Canvas.Brush.Style := bsClear; // use a transparent background
end
else
begin // otherwise, if the line needs to be
//highlighted,
Canvas.Brush.Style := bsSolid; // some colour to the brush is essential
end;
inherited DrawItem(Index, Rect, State); // Do the regular drawing and give component users...
// ... a chance to provide an OnDrawItem handler
Canvas.Brush.Style := FoundStyle; // Boy-scout rule No. 1: leave site as you found it
end;
procedure Register;
begin
RegisterComponents('Samples', [TTransparentListBox]);
end;
end.