//透明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组件或者制作方法的更多相关文章

  1. delphi列表视图组件(TListView)使用方法|实例

    TListView 组件以多种形式显示列表的项目,如详细资料.小图标.大图标等形式表示列表中的项目.    列表视图与用TListBox 组件实现的列表框非常相似.不同的是,列表视图可以让用户选择不同 ...

  2. delphi中panel控件应用

    delphi中的panel控件是怎么使用的?研究了很久了,还是搞不懂,只知道把它放到form上面,其他操作一律不懂了,有谁可以请教一下,如何把其他控件放到里面去呢?谢谢 提问者采纳   直接把控件放到 ...

  3. 浅谈控件(组件)制作方法一(附带一delphi导出数据到Excel的组件实例)(原创)

    来自:http://blog.csdn.net/zhdwjie/article/details/1490741 -------------------------------------------- ...

  4. (转载)c++builder/delphi中透明panel及透明窗口的实现方法_delphi教程

    c++builder/delphi中透明panel及透明窗口的实现方法_delphi教程 可能大多数程序员会问:透明窗口,特别是透明Panel有什么应用价值呢?可别小看它们哦,下面我就来讲讲他们的巨大 ...

  5. 2016.5.30实现透明Panel及控件置顶的方法

    想放置一个透明Panel在某控件上端,实现效果是可透过此Panel看见下面控件,但鼠标点击却无任何反应. 1.新建置自定义Panel类 using System; using System.Colle ...

  6. delphi TAdoQuery组件的close方法可能导致”列名无效“错误

    1,故障现象 一次程序运行,出现如下错误: 对应代码如下: 2,故障分析 Query_alert_2的语句在查询分析器中单独执行是正常的.排除语句出错. 如果注解掉Query_alert_1,则错误变 ...

  7. 基于Delphi的三层数据库系统的实现方法

    基于Delphi的三层数据库系统的实现方法   1  引言 当前的数据库应用系统中,按其结构划分为两类,一类是两层结构的数据库应系统,另一类是多层结构的数据库应用系统. 两层结构的数据库应用系统包括客 ...

  8. Delphi 利用TComm组件 Spcomm 实现串行通信

    Delphi 利用TComm组件 Spcomm 实现串行通信 摘要:利用Delphi开发工业控制系统软件成为越来越多的开发人员的选择,而串口通信是这个过程中必须解决的问题之一.本文在对几种常用串口通信 ...

  9. Delphi 动态创建组件,单个创建、单个销毁

    效果图如下: 实现部分代码如下: var rec: Integer = 0; //记录增行按钮点击次数 implementation {$R *.dfm} //动态释放单个组件内存,即销毁组件 pro ...

随机推荐

  1. Spring boot ----RestTemplate学习笔记

    ****spring boot-----restTemplate 封装了HttpURLConnection,HttpClient,Netty等接口访问实现库 restTemplet包含以下部分 Htt ...

  2. vue子组件获取父组件方法

    注:以下代码未使用esLint语法检查 父组件: <template> <div class="wrapper"> <cp_action @paren ...

  3. jsp service bean

    //在jsp中使用后台service中方法需要在jsp页面引入service bean 1 <%@page import="com..entity.Users"%> & ...

  4. go声明和初始化

    go声明和初始化 当我们第一次看见变量和声明时,我们仅仅看见一些内置的类型,比如整型和字符串.现在我们将学习结构体,并且我们会深入学习包括指针的内容. 通过一种最简单的方式去创建一个结构体值类型: g ...

  5. YUM仓库的搭建方式

    搭建YUM仓库 通俗的讲,实际上就是创建一个链接,将一堆可用于Linux系统安装的数据包用一种链接的方式给Linux系统读取,方法步骤如下: 一.找到可用的yum软件包的位置 二.创建挂载点提供访问y ...

  6. kubernetes Pod的升级与回滚

    一:Deployment的升级 1.通过kubectl set image命令为Deployment设置新的镜像名称kubectl set image deployment/nginx-deploym ...

  7. iptables对请求的URL作IP访问控制

    服务器运行环境是Tomcat,现在要实现的目的是,只允许特定的IP访问某个目录,一种方法是在tomcat配置文件server.conf中,使用RemoteAddrValve对虚拟主机做访问控制.另外一 ...

  8. 详解Windows注册表分析取证

    大多数都知道windows系统中有个叫注册表的东西,但却很少有人会去深入的了解它的作用以及如何对它进行操作.然而对于计算机取证人员来说注册表无疑是块巨大的宝藏.通过注册表取证人员能分析出系统发生了什么 ...

  9. [NOIP模拟13]题解

    A.矩阵游戏 其实挺水的? 考场上根本没有管出题人的疯狂暗示(诶这出题人有毛病吧这么简单的东西写一大堆柿子),而且推公式能力近乎没有,所以死掉了. 很显然乘法有交换率结合率所以操作顺序对最终结果没什么 ...

  10. java_monitor

    转载自http://blog.sina.com.cn/s/blog_9385f6d90101dbqy.html java会为每个object对象分配一个monitor,当某个对象的同步方法(synch ...