首页  编辑  

给没有Canvas的控件添加Canvas

Tags: /超级猛料/VCL/Control.控件使用开发和第三方控件/控件开发和设计/   Date Created:

回复人: torble(阿裕) (  ) 信誉:131  2002-7-13 19:59:25  得分:0  

 那么如何在 TButton 类中引入 Canvas 呢,看看 TCustomControl :

TCustomControl = class(TWinControl)

 private

   FCanvas: TCanvas;

   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

 protected

   procedure Paint; virtual;

   procedure PaintWindow(DC: HDC); override;

   property Canvas: TCanvas read FCanvas;

 public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

 end;

{ TCustomControl }

constructor TCustomControl.Create(AOwner: TComponent);

begin

 inherited Create(AOwner);

 FCanvas := TControlCanvas.Create;

 TControlCanvas(FCanvas).Control := Self;

end;

destructor TCustomControl.Destroy;

begin

 FCanvas.Free;

 inherited Destroy;

end;

procedure TCustomControl.WMPaint(var Message: TWMPaint);

begin

 Include(FControlState, csCustomPaint);

 inherited;

 Exclude(FControlState, csCustomPaint);

end;

procedure TCustomControl.PaintWindow(DC: HDC);

begin

 FCanvas.Lock;

 try

   FCanvas.Handle := DC;

   try

     TControlCanvas(FCanvas).UpdateTextFlags;

     Paint;

   finally

     FCanvas.Handle := 0;

   end;

 finally

   FCanvas.Unlock;

 end;

end;

procedure TCustomControl.Paint;

begin

end;

 

回复人: johnsonrao(johnson) (  ) 信誉:100  2002-7-13 20:54:22  得分:44  

 unit Button1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 StdCtrls;

type

 TButton1 = class(TButton)

 private

   FCanvas: TCanvas;

//加一句

   FControlState: TControlState;

   procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

 protected

   procedure Paint; virtual;

   procedure PaintWindow(DC: HDC); override;

//    property Canvas: TCanvas read FCanvas;

 public

   constructor Create(AOwner: TComponent); override;

   destructor Destroy; override;

   property Canvas: TCanvas read FCanvas;

 end;

procedure Register;

implementation

constructor TButton1.Create(AOwner: TComponent);

begin

 inherited Create(AOwner);

 FCanvas := TControlCanvas.Create;

 TControlCanvas(FCanvas).Control := Self;

end;

destructor TButton1.Destroy;

begin

 FCanvas.Free;

 inherited Destroy;

end;

procedure TButton1.WMPaint(var Message: TWMPaint);

begin

 Include(FControlState, csCustomPaint);

 inherited;

 Exclude(FControlState, csCustomPaint);

end;

procedure TButton1.PaintWindow(DC: HDC);

begin

 FCanvas.Lock;

 try

   FCanvas.Handle := DC;

   try

     TControlCanvas(FCanvas).UpdateTextFlags;

     Paint;

   finally

     FCanvas.Handle := 0;

   end;

 finally

   FCanvas.Unlock;

 end;

end;

procedure TButton1.Paint;

begin

end;

procedure Register;

begin

 RegisterComponents('Samples', [TButton1]);

end;

end.