TBitmap looses Clipping region after non-related graphics code

Question

Please consider the following code:

type
  TBaseControl = class(TWinControl)
  private
    FBitmap : TBitmap;
  public
    constructor Create(AOwner : TComponent); override;
    procedure DrawBorder;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;
  NewC : TBaseControl;

implementation

{$R *.dfm}

constructor TBaseControl.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  FBitmap := TBitmap.Create;
  FBitmap.PixelFormat := pf24bit;
  FBitmap.SetSize(100,100);
end;

procedure TBaseControl.DrawBorder;
var
  Region : HRGN;
  ContentRect : TRect;
begin
  // Almost like a Client Area of a control
  ContentRect := Rect(10,10,FBitmap.Width - 10,FBitmap.Height - 10);

  // Create clipping region on FBitmap with ContentRect being excluded
  Region := CreateRectRgnIndirect(Rect(0,0,Width,Height));
  SelectClipRgn(FBitmap.Canvas.Handle,Region);
  ExcludeClipRect(FBitmap.Canvas.Handle,ContentRect.Left,ContentRect.Top,
                  ContentRect.Right,ContentRect.Bottom);
  DeleteObject(Region);

  // Do Pre-drawing
  FBitmap.Canvas.Brush.Style := bsSolid;
  FBitmap.Canvas.Brush.Color := clRed;
  FBitmap.Canvas.FillRect(Rect(0,0,FBitmap.Width,FBitmap.Height));


  // Will comment out one of these statements
  // The graphics one (.Caption) will cause the clipping to be lost. Any
  // graphics code will do it as long as it is not related to FBitmap
  // ========================================================================
  Form1.Caption := 'You have just lost your Bitmap''s clipping';
  // -----
  Form1.Tag := Random(1000);
  // ========================================================================


  // Do some drawing afterwards
  FBitmap.Canvas.Brush.Color := clGreen;
  FBitmap.Canvas.FillRect(Rect(5,5,FBitmap.Width - 5,FBitmap.Height - 5));

  // Want to see what it looks like
  FBitmap.SaveToFile('d:\test.bmp');
  // Test the tag setting
  ShowMessage(InttoStr(Form1.Tag));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Create an instance of TBaseControl
  NewC := TBaseControl.Create(Self);
  NewC.SetBounds(0,0,200,200);
  NewC.Parent := Self;
  // Tell it to draw
  NewC.DrawBorder;
end;

In DrawBorder, if I only set Form1's Tag without the Caption being set then FBitmap's clipping region is kept and respected throughout the drawing code. FBitmap will look like this:

But if Form1's caption is set then FBitmap will loose its clipping region and look like this:

So it seems that after Form1's Caption was set FBitmap lost its clipping region. WindowOrigins (set via SetWindowOrgEx) also are lost when this happens.

That bitmap lost its canvas (its handle goes to 0 after that form caption change, in D2009). The control was not re-created. Have you tried to sacrifice a small brown squirrel or a similar tree animal? It really makes no sense. — Victoria, Aug 11 '17 at 06:01
@Victoria it makes sense, when you take into account that the VCL caches GDI resources and frequently (during message handling) releases canvas HDCs that are not actively locked. Don't expect GDI settings to be preserved over time. Reset them whenever you need to draw something. The region set by `DrawBorder` may not be valid after execution returns to the main message loop (such as due to a Repaint triggered by the `Caption` change) — Remy Lebeau, Aug 11 '17 at 07:09

score 2 · Accepted Answer · answered Aug 11 '17 at 19:57

After reading the comments by Victoria and Remy above I realized that locking the canvas might help so I tried wrapping the drawing code in FBitmap.Canvas.Lock and FBitmap.Canvas.UnLock and that seems to have fixed the issue.

procedure TBaseControl.DrawBorder;
var
  Region : HRGN;
  ContentRect : TRect;
begin
  FBitmap.Canvas.Lock;

  // ....All the drawing code-------------------
  // ....All the drawing code-------------------

  FBitmap.Canvas.UnLock;

  // Want to see what it looks like
  FBitmap.SaveToFile('d:\test.bmp');
  // Test the tag setting
  ShowMessage(InttoStr(Form1.Tag));
end;

I would just enclose it in a `try..finally` block (it's a bit paranoid here, but still). — Victoria, Aug 12 '17 at 06:36

TBitmap looses Clipping region after non-related graphics code

1 Answers1