请教透明panel的制作方法 请教透明panel的制作方法,在delphi7.0版本下.谢谢帮助 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 //透明panel控件unit TranPanel;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,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;publicconstructor 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;beginRegisterComponents('Croco', [TGlass]);end;function GlassStyleToInt(gs: TGlassStyle): LongInt;begincase gs ofgsBlackness : 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);begininherited 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;beginBuffer.Free;inherited Destroy;end;procedure TGlass.Paint;varR: TRect;rop: LongInt;beginR := 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);beginif Value <> FColor thenbeginFColor := Value;RecreateWnd;end;end;procedure TGlass.CreateParams(var Params: TCreateParams);begininherited CreateParams(Params);Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;end;procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);beginInvalidate;inherited;end;procedure TGlass.WMEraseBkgnd(var Message: TMessage);beginMessage.Result := 0;end;procedure TGlass.Resize;beginInvalidate;inherited;end;procedure TGlass.CMCtl3DChanged(var Message: TMessage);begininherited;RecreateWnd;end;procedure TGlass.SetStyle(Value: TGlassStyle);beginif Value <> FStyle thenbeginFStyle := Value;RecreateWnd;end;end;end. 建议你看一下TSpeedButton在Flat=True时的实现方式 ADOQuery1怎么编辑case when 字段呢? 请教简单操作mysql数据库问题,感觉用delphi太难操作 请问scrollbar来控制控件移动的问题! 用Desktop桌面数据库创建的表,用Ttable如何使用? indy + ADO问题 有奖竞猜-这是用什么控件做的?先猜中先得分:) 关于插入的一个问题 怎样自己定义一个消息并屏蔽系统消息 搞一份简单的餐饮业的 进销存,就报价多少合适? 怎样处理 我的IT人生(转载自天涯论坛) 一个程序中如何将另一个程序调到最前面?
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.