//透明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 新建mybatis ...

    一. 创建bean类 package com.feilong.blog.dao; public class Message { private int id; private String autho ...

  2. Vue学习笔记【26】——Vue路由(什么是路由)

    什么是路由 后端路由:对于普通的网站,所有的超链接都是URL地址,所有的URL地址都对应服务器上对应的资源,这个对应关系就是后端中的路由: 前端路由:对于单页面应用程序来说,主要通过URL中的hash ...

  3. luoguP1288 取数游戏II [博弈论]

    题目描述 有一个取数的游戏.初始时,给出一个环,环上的每条边上都有一个非负整数.这些整数中至少有一个0.然后,将一枚硬币放在环上的一个节点上.两个玩家就是以这个放硬币的节点为起点开始这个游戏,两人轮流 ...

  4. Linux shell脚本编程if语句的使用方法(条件判断)

    if 语句格式if  条件then Commandelse Commandfi        别忘了这个结尾If语句忘了结尾fitest.sh: line 14: syntax error: unex ...

  5. action通信机制

    当service通信不能很好的完成任务时候, actionlib则可以比较适合实现长时间的通信过程, actionlib通信过程可以随时被查看过程进度, 也可以终止请求, 这样的一个特性, 使得它在一 ...

  6. sqlserver 登录记录(登录触发器)

    本人自用 sqlserver  账号登录的记录(记录表+登录触发器) --存储账号的登录记录信息 use [YWmonitor] go create table access_log ( ,) NOT ...

  7. mongodb导入csv

    主要介绍使用自带工具mongoimport工具将 CSV 格式数据导入到 MongoDB 的详细过程. 由于官方提供了mongoimport工具,所以实际上导入 CSV 格式数据的过程非常简单,再次体 ...

  8. Java学习之集合(Collection接口)

    集合类的由来: 对象用于封装特有数据,对象多了需要存储,如果对象的个数不确定,就使用集合容器进行存储 集合特点: 1.用于存储对象的容器 2.集合长度可变 3.不可以存储基本数据类型 集合体系的顶层C ...

  9. 网络数据包最大长度 MTU 分片 转发https://blog.csdn.net/singular2611/article/details/52513406

    1.数据链路层对数据帧的长度都有一个限制,也就是链路层所能承受的最大数据长度,这个值称为最大传输单元,即MTU.以以太网为例,这个值通常是1500字节. 2.对于IP数据包来讲,也有一个长度,在IP包 ...

  10. Spring Boot主要目标

    Spring Boot主要目标 Spring Boot的主要目标是: 为所有Spring开发提供一个基本的,更快,更广泛的入门体验. 开箱即用,但随着需求开始偏离默认值,快速启动. 提供大型项目(例如 ...