背景透明的 ListBox 控件

Code
  1unit TransparentListBox;
  2
  3(* 
  4* 
  5*  Written by Walter Irion (CIS 114254, 2455) after the THotSpot 
  6*  sample component that Arne Sch?pers presented in the German 
  7*  c't magazine (issue 6/1996, pp. 286 ff.). 
  8*
  9*  TTransparentListBox is far from being a universal solution: 
 10*  it does not prevent Windows' scrolling mechanism from 
 11*  shifting the background along with scrolled listbox lines. 
 12*  Moreover, the scroll bar remains hidden until the keyboard 
 13*  is used to change the selection, and the scroll buttons 
 14*  become visible only when clicked. 
 15* 
 16*  To break it short: TTransparentListBox is only suitable 
 17*  for non-scrolling lists. 
 18* 
 19*  In fact it must be possible to write a listbox component 
 20*  that handles scrolling correctly. But my essays to intercept 
 21*  EM_LINESCROLL messages were fruitles, even though I tried 
 22*  subclassing via WndProc. 
 23* 
 24*  A solution for transparent TEdit and TMemo controls is 
 25*  introduced in issue 9/1996 of the c't magazine, again 
 26*  by Arne Sch?pers. But these are outright monsters with 
 27*  wrapper windows to receive notification messages as well 
 28*  as so-called pane windows that cover the actual control's 
 29*  client area and display its content. 
 30* 
 31*  Previous issues of the c't magazine can be ordered from: 
 32* 
 33*    c't-Kopierservice 
 34*    Helstorfer Str. 7 
 35*    30625 Hannover, Germany 
 36* 
 37*  They expect a crossed cheque amounting to DM 14,00 
 38*  to be included with your order, but I don't know about 
 39*  international orders. 
 40* 
 41*) 
 42
 43interface 
 44
 45uses 
 46  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
 47  StdCtrls; 
 48
 49type 
 50  TTransparentListBox = class(TListBox) 
 51  private 
 52    { Private declarations } 
 53  protected 
 54    { Protected declarations } 
 55    procedure CreateParams(var Params: TCreateParams); override; 
 56    procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; 
 57    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); 
 58      override; 
 59  public 
 60    { Public declarations } 
 61    constructor Create(AOwner: TComponent); override; 
 62    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; 
 63  published 
 64    { Published declarations } 
 65    property Style default lbOwnerDrawFixed; 
 66    property Ctl3D default False; 
 67    property BorderStyle default bsNone; 
 68  end; 
 69
 70procedure Register; 
 71
 72implementation 
 73
 74constructor TTransparentListBox.Create(AOwner: TComponent); 
 75begin 
 76  inherited Create(AOwner); 
 77  Ctl3D       := False; 
 78  BorderStyle := bsNone; 
 79  Style       := lbOwnerDrawFixed;  // changing it to lbStandard results 
 80  // in loss of transparency 
 81end; 
 82
 83procedure TTransparentListBox.CreateParams(var Params: TCreateParams); 
 84begin 
 85  inherited CreateParams(Params); 
 86  Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT; 
 87end; 
 88
 89procedure TTransparentListBox.WMEraseBkgnd(var Msg: TWMEraseBkgnd); 
 90begin 
 91  Msg.Result := 1;           // Prevent background from getting erased 
 92end; 
 93
 94procedure TTransparentListBox.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); 
 95var 
 96  tlbVisible: Boolean; 
 97begin 
 98  tlbVisible := (Parent <> nil) and IsWindowVisible(Handle);  // Check for   visibility 
 99  if tlbVisible then ShowWindow(Handle, SW_HIDE);             // Hide-Move-Show    strategy
100  inherited SetBounds(ALeft, ATop, AWidth, AHeight);          //  to prevent   background
101  if tlbVisible then ShowWindow(Handle, SW_SHOW);             //  from   getting copied
102end; 
103
104procedure TTransparentListBox.DrawItem(Index: Integer; Rect: TRect; 
105  State: TOwnerDrawState); 
106var 
107  FoundStyle: TBrushStyle; 
108  R: TRect; 
109begin 
110  FoundStyle := Canvas.Brush.Style;       // Remember the brush style 
111
112  R := Rect;                                     // Adapt coordinates of drawing   rect
113  MapWindowPoints(Handle, Parent.Handle, R, 2);  //  to parent's coordinate   system
114  InvalidateRect(Parent.Handle, @R, True);   // Tell parent to redraw the    item Position
115  Parent.Update;                             // Trigger instant redraw   (required)
116
117  if not (odSelected in State) then 
118  begin  // If an unselected line is being      handled
119    Canvas.Brush.Style := bsClear;  //   use a transparent background 
120  end 
121  else 
122  begin                          // otherwise, if the line needs to be     highlighted,
123    Canvas.Brush.Style := bsSolid;  //   some colour to the brush is       essential
124  end; 
125
126  inherited DrawItem(Index, Rect, State); // Do the regular drawing and give   component users 
127  //  a chance to provide an    OnDrawItem handler
128
129  Canvas.Brush.Style := FoundStyle;  // Boy-scout rule No. 1: leave site as   you found it 
130end; 
131
132procedure Register; 
133begin 
134  RegisterComponents('Samples', [TTransparentListBox]); 
135end; 
136
137end. 
138
139
140

摘自 http://www.delphi3000.com/articles/article_4667.asp?SK=

转载于:https://www.cnblogs.com/netclass/archive/2009/09/09/1563668.html