interfaceuses
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; 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 for visibility
if tlbVisible then ShowWindow(Handle, SW_HIDE); // Hide-Move-Show strategy
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;
end.
参照网上的一段ListBox透明的代码,发现一个问题,在ListBox有数据时,的确可以整个ListBox透明,但是如果没数据不执行DrawItem则不会透明,有没有什么办法让ListBox在没数据的时候也可以透明
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; 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 for visibility
if tlbVisible then ShowWindow(Handle, SW_HIDE); // Hide-Move-Show strategy
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;
end.
参照网上的一段ListBox透明的代码,发现一个问题,在ListBox有数据时,的确可以整个ListBox透明,但是如果没数据不执行DrawItem则不会透明,有没有什么办法让ListBox在没数据的时候也可以透明
解决方案 »
- for循环语句奇怪的自己倒序了是什么原因
- 下面是一个加密函数,里面包含有四层加密,能帮我写一个相应的解密函数?
- 这日子没法过了~~~~~~~放分ing ~~~~~~~~
- SQL高手请进(12月8日结贴)
- 有一很常的文件名如:c:\windows\a\b\c\d\f\s\c.exe怎么使它显示为c:\...\f\s\c.exe?
- RAVE的简单问题
- 讨教,请问delphi中如何检测电脑端口是否开放!如21端口...
- 紧急求助啊?高分香送,高手帮忙啊~~~十万火急啊
- 怎么做个程序,把txt文件里的内容导入SQL数据库中????
- faint,单步运行没有问题,执行时却报异常
- 如何把C++的 WCHAR bString[1];转换成delphi的?定义是什么
- 判断网络连接状态的问题(掉线、已连接)
var
DrawItemMsg: TWMDrawItem;
MeasureItemMsg: TWMMeasureItem;
DrawItemStruct: TDrawItemStruct;
MeasureItemStruct: TMeasureItemStruct;
R: TRect;
Y, I, H, W: Integer;
{$IF DEFINED(CLR)}
LMessage: TMessage;
LMeasureItemBuf: IntPtr;
LDrawItemBuf: IntPtr;
{$IFEND}
begin
if Items.Count = 0 then
begin
{ Just fill it in with the color }
with TBrush.Create do
try
Color := Self.Color;
FillRect(Message.DC, ClientRect, Handle); //当没有数据时,这段代码往界面上填了东西
finally
Free;
end;
Exit;
end;
//...........................所以,解决办法是重写消息事件procedure WMPaint(var Message: TWMPaint); message WM_PAINT;在里面判断如果Items.Count=0,则触发父窗体的重绘,否则,调用继承的方法。
在Items.Count=0时直接贴图到整个区域不同样也是透明效果么,以前一直都没转过弯来