您现在的位置:首页 >> VCL >> VCL >> 内容

如何编写背景透明的ListBox组件

时间:2011/9/3 16:25:42 点击:

  核心提示:unit TransparentListBox;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms...

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.

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2020 版权所有 All Rights Reserved.
  • 沪ICP备05001939号