给没有Canvas的控件添加Canvas

回复人： 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.