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 ...
随机推荐
- python_django_类视图的第一次忐忑碰触!!!
我们Django学到这里,基础知识阶段是已经完成了!! 在我们前面接触到的视图都是基于函数的视图函数我们可以称它为FBV,而今天我们新接触的就是视图函数的另一类CBV:基于类的视图函数,我们这里拓展这 ...
- C++子类的构造函数后面加:冒号的作用(转)
在C++类的构造函数中经常会看到如下格式的写法: MyWindow::MyWindow(QWidget* parent , Qt::WindowFlags flag) : QMainWindow(pa ...
- HIVE基本原理和基础
读时模式:HIVE加载数据时不校验,查询数据时才校验,与数据库相反
- Windows version PE System Key
{ }
- 在SpringCloud中MAVEN配置文件中的更改
<mirrors> <mirror> <id>alimaven</id> <mirrorOf>central</mirrorOf> ...
- 【原理】RabbitMQ概要图
使用流程 发布者(推送消息的一端): 创建一个tcp长连接connection,连接rabbitmq的监听端口5672: 在TCP长连接下创建一个信道channel,信道可以理解为connection ...
- NOIP2019模拟2019.9.20】膜拜大会(外向树容斥,分类讨论)
传送门. 题解: 我果然是不擅长分类讨论,心态被搞崩了. 注意到\(m<=n-2\),意味着除了1以外的位置不可能被加到a[1]两遍. 先考虑个大概: 考虑若存在\(x,x-1,-,2\)(有序 ...
- Android中的ListView的绘制过程中执行的方法
首先,系统在绘制ListView之前, 将会先调用getCount方法来获取Item的个数.(如果getCount方法返回0的话,列表时不显示任何内容的) 之后每绘制一个 Item就会调用一次getV ...
- python 模块-json
1.JSON(Javascript Object Notation) 是一种轻量级的数据交换格式.易于人阅读和编写.同时也易于机器解析和生成.它基于JavaScript Programming Lan ...
- Sqli labs系列-less-1 详细篇
要说 SQL 注入学习,网上众多的靶场,就属 Sqli labs 这个系列挺不错的,关卡达到60多关了,我自己也就打了不几关,一个挺不错的练习SQL注入的源码. 我一开始就准备等我一些原理篇总结完了, ...