请问高手,如何使panel变成透明的?谢谢! 请问高手,如何使panel变成透明的?谢谢! 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 使panel自身变成透明: 如果自己做个控件继承自TPanel的话比较容易: 1. override createparams方法: procedure CreateParams(var Params: TCreateParams); begin inherited CreateParams(params); Params.exstyles := Params.exstyles or WS_EX_TRANSPARENT; // 设置为透明窗 end; 2. 截取WM_ERASEBKGND消息. procedure WMEraseBkgnd(var Message: TMessage); begin Message.result := 1; // 什么都不做既返回. panel默认的erasebkgnd将 // fillrect, 所以需要去掉它 end; 3. 最重要的一步: 需要通过SetWindowLong修改parent control的style: procedure SetParentStyle; begin SetWindowLong(Parent.Handle, GWL_STYLE, GetWindowLong(Parent.Handle, GWL_STYLE) and not WS_CLIPCHILDREN); // 如果没有这步, parent在repaint时不会画上被当前panel遮住的部分. 不过在 // 第一次建立时也能取到背景, 不过不是parent的图案, 而是透明到Desktop上去了, // 显示的是当前Desktop上的图案, 效果就象在你的form上挖了个洞. RecreateWnd; // 重建当前panel的handle, 系统将自动重画, 这时panel的 // 背景已经是原先被遮住的部分了 end; 以上各步是建立透明TWinControl类可视控件的必备步骤.如果想在外界实现也是可行的(不继承), 完全可以在程序运行过程中将一个标准panel变成透明.主要思路和上面一样, 只是需用SetWindowLong(Panel.handle, GWL_EXSTYLE, ....)替换上述override CreateParams步骤, 然后替换panel的windowproc(需要保存原来的windowproc地址), 用如下代码:SetWindowLong(Panel.handle, GWL_WNDPROC, integer(@NewWindowProc));在NewWindowProc过程中判断接受的消息是否是WM_ERASEBKGND, 如果是, 则直接返回, 否则用CallWindowProc调用原来panel的windowproc处理)最后RecreateWnd, 重建整个form, 你就会发觉原来不透明的panel变透明了(对其他控件没有影响) To:hongqi162(失踪的月亮) integer(@NewWindowProc)是什么意思? Panel透明unit Glass;interfaceuses 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;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. 不可以写些代码,让原生的Panel变透明吗? 求一条sql 取天数,小时,分钟的方法? 请问如何将一个string变量转成char型? 用dephi调vc的dll的问题 memo自动折行 求助!这两个sql表能合并吗? 请各位大哥大姐帮帮忙啦!这个问题比较麻烦啊 窗口焦点如何控制默认位置 关于通用人事工资管理系统的公式和个我所得税的问题(500分) 如何引用另一个UNIT中的变量或自定义函数? 线程内传递参数问题,请大家帮忙。 怎样把sql server 表中数据按查询条件复制到ACCESS数据库表中/??
如果自己做个控件继承自TPanel的话比较容易:
1. override createparams方法:
procedure CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(params);
Params.exstyles := Params.exstyles or WS_EX_TRANSPARENT; // 设置为透明窗
end; 2. 截取WM_ERASEBKGND消息.
procedure WMEraseBkgnd(var Message: TMessage);
begin
Message.result := 1; // 什么都不做既返回. panel默认的erasebkgnd将
// fillrect, 所以需要去掉它
end;
3. 最重要的一步: 需要通过SetWindowLong修改parent control的style:
procedure SetParentStyle;
begin
SetWindowLong(Parent.Handle, GWL_STYLE,
GetWindowLong(Parent.Handle, GWL_STYLE) and
not WS_CLIPCHILDREN);
// 如果没有这步, parent在repaint时不会画上被当前panel遮住的部分. 不过在
// 第一次建立时也能取到背景, 不过不是parent的图案, 而是透明到Desktop上去了,
// 显示的是当前Desktop上的图案, 效果就象在你的form上挖了个洞.
RecreateWnd; // 重建当前panel的handle, 系统将自动重画, 这时panel的
// 背景已经是原先被遮住的部分了
end;
以上各步是建立透明TWinControl类可视控件的必备步骤.如果想在外界实现也是可行的(不继承), 完全可以在程序运行过程中将一个标准panel变成透明.主要思路和上面一样, 只是需用SetWindowLong(Panel.handle, GWL_EXSTYLE, ....)
替换上述override CreateParams步骤, 然后替换panel的windowproc(需要保存原来的
windowproc地址), 用如下代码:
SetWindowLong(Panel.handle, GWL_WNDPROC, integer(@NewWindowProc));
在NewWindowProc过程中判断接受的消息是否是WM_ERASEBKGND, 如果是, 则直接返回, 否
则用CallWindowProc调用原来panel的windowproc处理)最后RecreateWnd, 重建整个form, 你就会发觉原来不透明的panel变透明了(对其他控件没有
影响)
Panel透明
unit Glass;interfaceuses
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;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.