您的位置:首页 > 运维架构 > 网站架构

娃娃鸭深入核心VCL架构剖析(李维)笔记

2009-03-10 15:34 344 查看
26、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;
27、TCanvas类

TCanvas = class(TPersistent)

private
FHandle: HDC;
State: TCanvasState;
FFont: TFont;
FPen: TPen;
FBrush: TBrush;
FPenPos: TPoint;
FCopyMode: TCopyMode;
FOnChange: TNotifyEvent;
FOnChanging: TNotifyEvent;
FLock: TRTLCriticalSection;
FLockCount: Integer;
FTextFlags: Longint;
procedure CreateBrush;
procedure CreateFont;
procedure CreatePen;
procedure BrushChanged(ABrush: TObject);
procedure DeselectHandles;
function GetCanvasOrientation: TCanvasOrientation;
function GetClipRect: TRect;
function GetHandle: HDC;
function GetPenPos: TPoint;
function GetPixel(X, Y: Integer): TColor;
procedure FontChanged(AFont: TObject);
procedure PenChanged(APen: TObject);
procedure SetBrush(Value: TBrush);
procedure SetFont(Value: TFont);
procedure SetHandle(Value: HDC);
procedure SetPen(Value: TPen);
procedure SetPenPos(Value: TPoint);
procedure SetPixel(X, Y: Integer; Value: TColor);
protected
procedure Changed; virtual;
procedure Changing; virtual;
procedure CreateHandle; virtual;
procedure RequiredState(ReqState: TCanvasState);
public
constructor Create;
destructor Destroy; override;
procedure Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure BrushCopy(const Dest: TRect; Bitmap: TBitmap;
const Source: TRect; Color: TColor);
procedure Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure CopyRect(const Dest: TRect; Canvas: TCanvas;
const Source: TRect);
procedure Draw(X, Y: Integer; Graphic: TGraphic);
procedure DrawFocusRect(const Rect: TRect);
procedure Ellipse(X1, Y1, X2, Y2: Integer); overload;
procedure Ellipse(const Rect: TRect); overload;
procedure FillRect(const Rect: TRect);
procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);
procedure FrameRect(const Rect: TRect);
function HandleAllocated: Boolean;
procedure LineTo(X, Y: Integer);
procedure Lock;
procedure MoveTo(X, Y: Integer);
procedure Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer);
procedure Polygon(const Points: array of TPoint);
procedure Polyline(const Points: array of TPoint);
procedure PolyBezier(const Points: array of TPoint);
procedure PolyBezierTo(const Points: array of TPoint);
procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
procedure Rectangle(const Rect: TRect); overload;
procedure Refresh;
procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer);
procedure StretchDraw(const Rect: TRect; Graphic: TGraphic);
function TextExtent(const Text: string): TSize;
function TextHeight(const Text: string): Integer;
procedure TextOut(X, Y: Integer; const Text: string);
procedure TextRect(Rect: TRect; X, Y: Integer; const Text: string);
function TextWidth(const Text: string): Integer;
function TryLock: Boolean;
procedure Unlock;
property ClipRect: TRect read GetClipRect;
property Handle: HDC read GetHandle write SetHandle;
property LockCount: Integer read FLockCount;
property CanvasOrientation: TCanvasOrientation read GetCanvasOrientation;
property PenPos: TPoint read GetPenPos write SetPenPos;
property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
property TextFlags: Longint read FTextFlags write FTextFlags;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
published
property Brush: TBrush read FBrush write SetBrush;
property CopyMode: TCopyMode read FCopyMode write FCopyMode default cmSrcCopy;
property Font: TFont read FFont write SetFont;
property Pen: TPen read FPen write SetPen;
end;

procedure TCanvas.SetPixel(X, Y: Integer; Value: TColor);
begin
Changing;
RequiredState([csHandleValid, csPenValid]);
Windows.SetPixel(FHandle, X, Y, ColorToRGB(Value));
Changed;
end;

procedure TCanvas.Changing;
begin
if Assigned(FOnChanging) then FOnChanging(Self);
end;

procedure TCanvas.Changed;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
28、TControlCanvas类

TControlCanvas = class(TCanvas)

private
FControl: TControl;
FDeviceContext: HDC;
FWindowHandle: HWnd;
procedure SetControl(AControl: TControl);
protected
procedure CreateHandle; override;
public
destructor Destroy; override;
procedure FreeHandle;
procedure UpdateTextFlags;
property Control: TControl read FControl write SetControl;
end;
procedure TControlCanvas.CreateHandle;
begin
if FControl = nil then inherited CreateHandle else
begin
if FDeviceContext = 0 then
begin
with CanvasList.LockList do
try
if Count >= CanvasListCacheSize then FreeDeviceContext;
FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
Add(Self);
finally
CanvasList.UnlockList;
end;
end;
Handle := FDeviceContext;
UpdateTextFlags;
end;
end;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: