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

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;

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;

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;