Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Adding Canvas to TScrollBox

Tags:

delphi

I am trying to do simple thing: Add a Canvas property on the TScrollBox descendant. I have read this article

but my ScrollBox descendant simply does not draw on the canvas. May anybody tell me, what is wrong?

  TfrmScrollContainer = class (TScrollBox)
  private
    FCanvas: TCanvas; 
    FControlState:TControlState;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Paint;
    procedure PaintWindow(DC: HDC); override;
    property Canvas: TCanvas read FCanvas;
  public
    constructor Create(AOwner: TComponent);  override;
    destructor Destroy; override;
  end;

... this is exact copy, how TWincontrol turns to TCustomControl (but it fails somewhere)

constructor TfrmScrollContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;

destructor TfrmScrollContainer.Destroy;
begin
  FCanvas.Free;
  inherited Destroy;
end;

procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
  Include(FControlState, csCustomPaint);
  inherited;
  Exclude(FControlState, csCustomPaint);
end;

procedure TfrmScrollContainer.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 TfrmScrollContainer.Paint;    // this is not executed (I do not see any ellipse)
begin
  Canvas.Brush.Color:=clRed;
  Canvas.Ellipse(ClientRect);
end;

Thanx

like image 770
lyborko Avatar asked Aug 15 '13 00:08

lyborko


1 Answers

You are not including csCustomPaint to ControlState, you're including it to the similarly named field you declared. Your field is not checked, the ascendant control does not know anything about it. To solve, replace

procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
  Include(FControlState, csCustomPaint);
  inherited;
  Exclude(FControlState, csCustomPaint);
end;

with

procedure TfrmScrollContainer.WMPaint(var Message: TWMPaint);
begin
  ControlState := ControlState + [csCustomPaint];
  inherited;
  ControlState := ControlState - [csCustomPaint];
end;


Alternatively your scroll box may parent any control for your custom painting to work. The inherited WM_PAINT handler checks to see the control count and if it's not 0 it calls the paint handler instead of delivering the message to the default handler.

like image 189
Sertac Akyuz Avatar answered Nov 14 '22 17:11

Sertac Akyuz