我需要一个可以透明,并且可以拖动的panel组件。当然也可以不是panel,其他的容器组件也可以的。注意:透明指的是panel下面的变化也能看见(如下面是一个edit,可以看见里面文字的变化),就像网页上的效果一样。
在网上漂了三天,我涝呀,找呀,找了三天,没有找到合适的方案。 首先找了一些第三方组件,有可以支持透明的,比如TIAsemiPanel和eztexturepanel。
TIAsemiPanel在给上面拖上去一个按钮时,delphi就会死掉。eztexturepanel在拖动panel时背景不跟着变,即还是用的原来的背景,当然更不能看见下面东西的变化了。 找了一些制作透明组件的方法,有说使用SetLayeredWindowAttributes API的,可是要用它,组件要有WS_EX_LAYERED样式,而有了这个样式就必须不能有WS_CHILD,但是panel肯定是有WS_CHILD的,这种办法不能用了。
我就试着用另一种方法,首先取得panel父组件的背景,将其放到一个bitmap中去,然后取得panel的图像将其也存到一bitmap中,然后将这两个 bitmap通过一定方法叠加后,画到panel上去。可是因为我在取背景的图像时,需要先把panel设为不可见再取背景图像,取到后再把panel设为可见,这样一执行到paint方法里时panel开始不停闪烁,不知如何解决,有人知道如何解决不? 我原来是做b/s的,这些透明之类的效果,在网页里就是一个滤镜效果,轻轻指定几个值就可以了,可没想到在delphi里竟如此难做。我在想网页里的滤镜效果是如何实现的。同样是在windows系统下显示,为什么浏览器能实现,而应用程序就实现不了了,当然肯定是我不会。我在想为什么delphi就不把这些大家都会共用到的东西做出来。我们做开发的主要目的就是实现业务,这些什么乱七八糟的基本东西应该是开发工具就提供好了的,据说borland的架构师跑到微软去了,剩下的人怎么就不知道赶赶潮流,把delphi给正儿八经升升级。那些自带的组件是可以完成功能,但做一个真正的好东西,用户都不愿意看着一个丑不垃圾的界面。说是可以自定义组件,给开发者留了很大的扩展余地,可是问题是开发者要做的东西太多,太多!
说多了,哪位高手知道如何实现我要的效果。谢谢!!!!!!!!
在网上漂了三天,我涝呀,找呀,找了三天,没有找到合适的方案。 首先找了一些第三方组件,有可以支持透明的,比如TIAsemiPanel和eztexturepanel。
TIAsemiPanel在给上面拖上去一个按钮时,delphi就会死掉。eztexturepanel在拖动panel时背景不跟着变,即还是用的原来的背景,当然更不能看见下面东西的变化了。 找了一些制作透明组件的方法,有说使用SetLayeredWindowAttributes API的,可是要用它,组件要有WS_EX_LAYERED样式,而有了这个样式就必须不能有WS_CHILD,但是panel肯定是有WS_CHILD的,这种办法不能用了。
我就试着用另一种方法,首先取得panel父组件的背景,将其放到一个bitmap中去,然后取得panel的图像将其也存到一bitmap中,然后将这两个 bitmap通过一定方法叠加后,画到panel上去。可是因为我在取背景的图像时,需要先把panel设为不可见再取背景图像,取到后再把panel设为可见,这样一执行到paint方法里时panel开始不停闪烁,不知如何解决,有人知道如何解决不? 我原来是做b/s的,这些透明之类的效果,在网页里就是一个滤镜效果,轻轻指定几个值就可以了,可没想到在delphi里竟如此难做。我在想网页里的滤镜效果是如何实现的。同样是在windows系统下显示,为什么浏览器能实现,而应用程序就实现不了了,当然肯定是我不会。我在想为什么delphi就不把这些大家都会共用到的东西做出来。我们做开发的主要目的就是实现业务,这些什么乱七八糟的基本东西应该是开发工具就提供好了的,据说borland的架构师跑到微软去了,剩下的人怎么就不知道赶赶潮流,把delphi给正儿八经升升级。那些自带的组件是可以完成功能,但做一个真正的好东西,用户都不愿意看着一个丑不垃圾的界面。说是可以自定义组件,给开发者留了很大的扩展余地,可是问题是开发者要做的东西太多,太多!
说多了,哪位高手知道如何实现我要的效果。谢谢!!!!!!!!
解决方案 »
- wndproc接受不到wm_keydown
- 请教高人,我将dbgrid1的数据复制到了dbgrid2,怎么将dbgrid2的内容保存到mssql数据库中?dbgrid1和dbgrid2分别是oracle和mssql
- Delphi中使用的关键字你知道几个?
- 据说Delphi7以后的版本都要基于.NET,那么如果我已经装了.NET Framework,Delphi2005或Delphi2006是用的哪个版本的Framework?
- VARPROPSETTER是什么来的?
- 模拟设计时组件托动、改变大小的问题?<等>
- 奇怪的问题
- 求助如何制作撤销功能(实现对动态生成的组件的撤销)
- 有没有用DSPack开发的录制屏幕的例子 ???
- 这是什么意思啊?一句话的问题!
- 如何清空打印机缓存
- 如何让TreeNode保持高亮,或者设置TreeNode背景色
ExtCtrls;typeTGlassStyle = (
gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,
gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,
gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);TGlass = class(TCustomControl)privateFColor: 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;protectedBuffer: TBitmap;
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Resize; override;public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;publishedproperty 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;implementationprocedure 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 := 100;
Height := 100;
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(0, 0, Width, Height);
Buffer.Width := Width;
Buffer.Height := Height;
Buffer.Canvas.Brush.Style := bsSolid;
Buffer.Canvas.Brush.Color := FColor;
Buffer.Canvas.FillRect(Rect(0, 0, Width, Height));
rop := GlassStyleToInt(FStyle);
StretchBlt(Buffer.Canvas.Handle, 0, 0, Width, Height,
Canvas.Handle, 0, 0, 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(0, 0, 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 := 0;
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.
假定透明度:0-255
新颜色=Round((背景色*透明度+原panel颜色*(255-透明度))/255)
目前网上有不少代码.目前我使用的方法是
1.重写TPanel的Create方法,增加
ControlStyle := ControlStyle - [csOpaque];
Brush.Style := bsClear;
2.CreateParams方法,增加
with Params do
begin
ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;
3.重写Paint方法,直接将置空(我现在用的Panel只是做为一个容器用)
4.获取WM_ERASEBKGND消息,Result为1但是现在出现两个问题
1.放置Panel的窗口发生变化时,Panel不显示
2.Panel刷新后,背景没有刷新.(我在Panel上放了两个控件:控件1,控件2,这两个控件是交替显示的,发生交替的时候发现前面一个隐藏掉的控件还是画在了Panel上面,导致背景看起来很乱).由于这个Panel是放在Form上使用的,我在Form上又放置了TImage控件,我希望Panel透明以后不要影响其他控件的显示效果,而现在网上的基本是靠获取Panel的父控件的背景来重画Panel背景实现,这种方式会影响其他控件的使用.
如果你仅仅是为了得到这种效果的话,可以用TBevel来实现.
我现在主要的是这个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 := 0 to ControlCount- 1 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 := 1;
end;
procedure TTransparentPanel.WMMove(var Message: TWMMove);
begin
inherited;
Invalidate;
end;