delphi透明panel组件或者制作方法
//透明Panel控件 unit TranPanel; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls; type TGlassStyle = (
gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,
gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,
gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness); TGlass = class(TCustomControl) private FColor: TColor;
FStyle: TGlassStyle;
FOnPaint: TNotifyEvent;
procedure SetColor(Value: TColor);
procedure SetStyle(Value: TGlassStyle);
procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING; protected Buffer: TBitmap;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Resize; override; public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas; published property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderWidth;
property Color: TColor read FColor write SetColor;
property Ctl3D;
property Enabled;
property Style: TGlassStyle read FStyle write SetStyle default gsSrcAnd;
property Visible;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end; procedure Register; implementation procedure Register;
begin
RegisterComponents('Croco', [TGlass]);
end; function GlassStyleToInt(gs: TGlassStyle): LongInt;
begin
case gs of
gsBlackness : Result := cmBlackness;
gsDstInvert : Result := cmDstInvert;
gsMergeCopy : Result := cmMergeCopy;
gsMergePaint : Result := cmMergePaint;
gsNotSrcCopy : Result := cmNotSrcCopy;
gsNotSrcErase: Result := cmNotSrcErase;
gsPatCopy : Result := cmPatCopy;
gsPatInvert : Result := cmPatInvert;
gsPatPaint : Result := cmPatPaint;
gsSrcAnd : Result := cmSrcAnd;
gsSrcCopy : Result := cmSrcCopy;
gsSrcErase : Result := cmSrcErase;
gsSrcInvert : Result := cmSrcInvert;
gsSrcPaint : Result := cmSrcPaint;
gsWhiteness : Result := cmWhiteness;
else Assert(True, 'Error parameter in function GlassStyleToInt');
end;
end; constructor TGlass.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Buffer := TBitmap.Create;
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csDoubleClicks, csReplicatable];
Width := ;
Height := ;
FStyle := gsSrcAnd;
ParentCtl3d := False;
Ctl3D := False;
ParentColor := False;
FColor := clWhite;
end; destructor TGlass.Destroy;
begin
Buffer.Free;
inherited Destroy;
end; procedure TGlass.Paint;
var
R: TRect;
rop: LongInt;
begin
R := Rect(, , Width, Height);
Buffer.Width := Width;
Buffer.Height := Height;
Buffer.Canvas.Brush.Style := bsSolid;
Buffer.Canvas.Brush.Color := FColor;
Buffer.Canvas.FillRect(Rect(, , Width, Height));
rop := GlassStyleToInt(FStyle);
StretchBlt(Buffer.Canvas.Handle, , , Width, Height,
Canvas.Handle, , , Width, Height, rop);
if Ctl3D then DrawEdge(Buffer.Canvas.Handle, R, BDR_RAISEDINNER, BF_RECT);
Buffer.Canvas.Pen.Mode := pmCopy;
Buffer.Canvas.Pen.Style := psSolid;
Canvas.Draw(, , Buffer);
if Assigned(FOnPaint) then FOnPaint(Self);
end; procedure TGlass.SetColor(Value: TColor);
begin
if Value <> FColor then
begin
FColor := Value;
RecreateWnd;
end;
end; procedure TGlass.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end; procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
Invalidate;
inherited;
end; procedure TGlass.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := ;
end; procedure TGlass.Resize;
begin
Invalidate;
inherited;
end; procedure TGlass.CMCtl3DChanged(var Message: TMessage);
begin
inherited;
RecreateWnd;
end; procedure TGlass.SetStyle(Value: TGlassStyle);
begin
if Value <> FStyle then
begin
FStyle := Value;
RecreateWnd;
end;
end; end.
我也遇到同样的问题,能解决的话,另外我也开贴给分.
目前网上有不少代码.目前我使用的方法是
.重写TPanel的Create方法,增加
ControlStyle := ControlStyle - [csOpaque];
Brush.Style := bsClear;
.CreateParams方法,增加
with Params do
begin
ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;
.重写Paint方法,直接将置空(我现在用的Panel只是做为一个容器用)
.获取WM_ERASEBKGND消息,Result为1 但是现在出现两个问题
.放置Panel的窗口发生变化时,Panel不显示
.Panel刷新后,背景没有刷新.(我在Panel上放了两个控件:控件1,控件2,这两个控件是交替显示的,发生交替的时候发现前面一个隐藏掉的控件还是画在了Panel上面,导致背景看起来很乱). 由于这个Panel是放在Form上使用的,我在Form上又放置了TImage控件,我希望Panel透明以后不要影响其他控件的显示效果,而现在网上的基本是靠获取Panel的父控件的背景来重画Panel背景实现,这种方式会影响其他控件的使用.
我结合网上搜到的资料,做了一个,基本能够达到我的应用了,但是还存在一个问题"放置Panel的窗口发生变化时,Panel不显示",
先把代码贴出来,大家帮忙看看哪边有问题.
//透明Panel
TTransparentPanel=class(TPanel)
protected
procedure Paint; override;
procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
procedure WMMove(var Message: TWMMove); Message WM_Move;
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure Invalidate;override;
end; { TTransparentPanel } procedure TTransparentPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
inherited;
Invalidate;
end; constructor TTransparentPanel.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := ControlStyle - [csSetCaption];
ControlStyle := ControlStyle - [csOpaque];
end; procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params do
begin
ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;
end; destructor TTransparentPanel.Destroy;
begin inherited Destroy;
end; procedure TTransparentPanel.Invalidate;
var
Rect: TRect;
iLoop: Integer;
begin
if (Parent<>nil) and(Parent.HandleAllocated) then
begin
Rect := BoundsRect;
InvalidateRect(Parent.Handle,@Rect,False);
for iLoop := to ControlCount- do
Controls[iLoop].Invalidate;
end;
end; procedure TTransparentPanel.Paint;
var
ARect: TRect;
TopColor, BottomColor: TColor; procedure AdjustColors(Bevel: TPanelBevel);
begin
TopColor := clBtnHighlight;
if Bevel = bvLowered then TopColor := clBtnShadow;
BottomColor := clBtnShadow;
if Bevel = bvLowered then BottomColor := clBtnHighlight;
end;
begin
ARect := GetClientRect;
if BevelOuter <> bvNone then
begin
AdjustColors(BevelOuter);
Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
end;
Frame3D(Canvas, ARect, Color, Color, BorderWidth);
if BevelInner <> bvNone then
begin
AdjustColors(BevelInner);
Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
end;
Update;
end; procedure TTransparentPanel.WMEraseBkgnd(var Message: TMessage);
begin
Message.Result := ;
end; procedure TTransparentPanel.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;
delphi透明panel组件或者制作方法的更多相关文章
- delphi列表视图组件(TListView)使用方法|实例
TListView 组件以多种形式显示列表的项目,如详细资料.小图标.大图标等形式表示列表中的项目. 列表视图与用TListBox 组件实现的列表框非常相似.不同的是,列表视图可以让用户选择不同 ...
- delphi中panel控件应用
delphi中的panel控件是怎么使用的?研究了很久了,还是搞不懂,只知道把它放到form上面,其他操作一律不懂了,有谁可以请教一下,如何把其他控件放到里面去呢?谢谢 提问者采纳 直接把控件放到 ...
- 浅谈控件(组件)制作方法一(附带一delphi导出数据到Excel的组件实例)(原创)
来自:http://blog.csdn.net/zhdwjie/article/details/1490741 -------------------------------------------- ...
- (转载)c++builder/delphi中透明panel及透明窗口的实现方法_delphi教程
c++builder/delphi中透明panel及透明窗口的实现方法_delphi教程 可能大多数程序员会问:透明窗口,特别是透明Panel有什么应用价值呢?可别小看它们哦,下面我就来讲讲他们的巨大 ...
- 2016.5.30实现透明Panel及控件置顶的方法
想放置一个透明Panel在某控件上端,实现效果是可透过此Panel看见下面控件,但鼠标点击却无任何反应. 1.新建置自定义Panel类 using System; using System.Colle ...
- delphi TAdoQuery组件的close方法可能导致”列名无效“错误
1,故障现象 一次程序运行,出现如下错误: 对应代码如下: 2,故障分析 Query_alert_2的语句在查询分析器中单独执行是正常的.排除语句出错. 如果注解掉Query_alert_1,则错误变 ...
- 基于Delphi的三层数据库系统的实现方法
基于Delphi的三层数据库系统的实现方法 1 引言 当前的数据库应用系统中,按其结构划分为两类,一类是两层结构的数据库应系统,另一类是多层结构的数据库应用系统. 两层结构的数据库应用系统包括客 ...
- Delphi 利用TComm组件 Spcomm 实现串行通信
Delphi 利用TComm组件 Spcomm 实现串行通信 摘要:利用Delphi开发工业控制系统软件成为越来越多的开发人员的选择,而串口通信是这个过程中必须解决的问题之一.本文在对几种常用串口通信 ...
- Delphi 动态创建组件,单个创建、单个销毁
效果图如下: 实现部分代码如下: var rec: Integer = 0; //记录增行按钮点击次数 implementation {$R *.dfm} //动态释放单个组件内存,即销毁组件 pro ...
随机推荐
- Dubbo---zookeeper 注册中心---xml配置
1.项目结构(maven项目) 2.pom <?xml version="1.0" encoding="UTF-8"?> <project x ...
- SQL 按关键字排序
SQL ORDER BY Keyword(按关键字排序) ORDER BY 关键字用于对结果集进行排序. SQL ORDER BY 关键字 ORDER BY 关键字用于按升序或降序对结果集进行排序. ...
- jsp网站访问次数统计的几种方法
我采用的是jsp网页,但是不管采用什么语言,原理是一样的. 第一种,单页面统计.就是说,只要点击这个页面就会统计一次. <body> <%!//在这种标记中定义的变量为全局变量 in ...
- DOS和DDOS攻击
1.什么是DOS攻击 首先注意这里是DOS(Denial Of Service)攻击,并非DoS.DoS是微软早期的系统版本. DoS即Denial Of Service,拒绝服务的缩写.DoS是指故 ...
- 树莓派安装raspbian
需要准备 Win32DiskImager-v0.6 2016-09-23-raspbian-jessie.img 右键管理员打开Win32DiskImager 选择上面的img文件,选择存储卡盘符,点 ...
- CentOS 安装MySQL(rpm)提示错误Header V3 DSA/SHA1 Signature
提示错误:Header V3 DSA/SHA1 Signature, key ID 5072e1f5: NOKEY error: Failed dependencies 错误原因:这是由于yum安装了 ...
- MDK中问题:warning : type qualifier is meaningless on cast type return 的解决
在MDK编译代码时,有时会出现这样的警告, warning : type qualifier is meaningless on cast type return 在MDK中,作如下设置: 即添加 : ...
- leetcode 596 BUG笔记
There is a table courses with columns: student and class Please list out all classes which have more ...
- 详解Telecom
学习目标: 掌握Telecom入口和分析方法 总结和演进Telecom交互模型 掌握Listener消息回调机制 学习CallsManager 为什么选择Telecom分析? 这是由于在Android ...
- 为什么Netty这么火?与Mina相比有什么优势?
Netty是什么?为什么这么火? Netty是目前最流行的由JBOSS提供的一个Java开源框架NIO框架,Netty提供异步的.事件驱动的网络应用程序框架和工具,用以快速开发高性能.高可靠性的网络服 ...