在Delphi中创建透明的TListBox

时间:2011-12-31 06:28:38

标签: delphi transparency ownerdrawn tlistbox

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;

我有我的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;

问题是ListBox无法正常工作,项目消失,闪烁......

我无法合并2个程序的代码,只留下一个(被覆盖的一个或我的):

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

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

如何使一切正常,列表框是透明的,项目是否正确绘制?

1 个答案:

答案 0 :(得分:0)

我不相信你可以创建一个透明的列表框,除非Windows Common Controls明确支持该样式。拥有一个所有者绘制项目可能允许你“不重绘项目”,但这不会,因为你说它“工作正常”。这些物品消失并闪烁,因为你并没有真正完全涂抹它们。

简短回答:不,你不能。原始链接声称工作。您能否详细说明使用原始代码找到的问题,也许有人可以建议解决方法?