-2

A transparent TListBox:

type
   TListBox = class(StdCtrls.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;



 constructor TListBox.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Ctl3D       := False;
   BorderStyle := bsNone;
   Style       := lbOwnerDrawFixed;
end;

procedure TListBox.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TListBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
   Msg.Result := 1;    
end;

procedure TListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
   tlbVisible: Boolean;
begin
   tlbVisible := (Parent <> nil) and IsWindowVisible(Handle);  
   if tlbVisible then ShowWindow(Handle, SW_HIDE);             
   inherited SetBounds(ALeft, ATop, AWidth, AHeight);        
   if tlbVisible then ShowWindow(Handle, SW_SHOW);           

end;

procedure TListBox.DrawItem(Index: Integer; Rect: TRect;
   State: TOwnerDrawState);
var
   FoundStyle: TBrushStyle;
   R: TRect;
begin
   FoundStyle := Canvas.Brush.Style;   
   R := Rect;     
   MapWindowPoints(Handle, Parent.Handle, R, 2);  
   InvalidateRect(Parent.Handle, @R, True);  
   item Position
   Parent.Update;    
   if not (odSelected in State) then
   begin  
     Canvas.Brush.Style := bsClear;  
   end
   else
   begin
     Canvas.Brush.Style := bsSolid;
   end;
   inherited DrawItem(Index, Rect, State);
   Canvas.Brush.Style := FoundStyle;
end;

And I have my DrawItem:

procedure TMainForm.MenuDrawItem(Control: TWinControl; Index: integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Sender: TListBox;
  R: TRect;
begin
  Sender := (Control as TListBox);
  if (odSelected in State) then
  begin
    Sender.Canvas.Font.Color := clWhite;
    Sender.Canvas.Font.Style := [fsBold];
    GradientFillCanvas(Sender.Canvas, $00C08000, $00FF8000, Rect, gdVertical);
  end
  else
  begin
    Sender.Canvas.Brush.Style := bsClear;
    Sender.Canvas.Font.Color := clblack;
  end;
  R := Rect;
  Sender.Canvas.Brush.Style := bsClear;

  MainMenuImageList.Draw(Sender.Canvas, 3, R.top + (R.Bottom - R.top - 48)
    div 2, Index, True);
  R.left := MainMenuImageList.width + 10;

  DrawText(Sender.Canvas.Handle, Sender.Items[Index],
    Length(Sender.Items[Index]), R, DT_SINGLELINE or DT_LEFT or DT_VCENTER or
    DT_END_ELLIPSIS);

  if odFocused in State then
    DrawFocusRect((Control as TListBox).Canvas.Handle, Rect);
end;

A problem is the ListBox doesn't work properly, items disappear, blink...

I cannot merge a code of 2 procedures and leave only one (overridden one or mine):

procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;

OR

TMainForm.MenuDrawItem(Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDrawState);

How can I make everything works fine, the list box is transparent, items are drawn properly?

Deduplicator
  • 44,692
  • 7
  • 66
  • 118
maxfax
  • 4,281
  • 12
  • 74
  • 120

1 Answers1

0

I do not believe that you can make a transparent listbox, unless the style is supported explicitly by the Windows Common Controls. Having an owner-draw item may allow you to "not redraw the items", but that will not as you put it "work fine". The items disappear and blink because you are not truly painting them fully.

Short answer: No you can't. The original link claims to work. Can you detail the problem you found with the original code, and perhaps someone can suggest a workaround?

Andreas Rejbrand
  • 105,602
  • 8
  • 282
  • 384
Warren P
  • 65,725
  • 40
  • 181
  • 316