TBitmap 在 non-related 图形代码后丢失裁剪区域

Question

请考虑以下代码：

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;

在DrawBorder中，如果我只设置 Form1 的标签而没有设置标题，那么在整个绘图代码中都会保留并遵守 FBitmap 的剪辑区域。 FBitmap 将如下所示：

但如果设置了 Form1 的标题，则 FBitmap 将失去其剪裁区域，看起来像这样：

所以看起来Form1的Caption设置后FBitmap失去了裁剪区域。发生这种情况时，WindowOrigins（通过 SetWindowOrgEx 设置）也会丢失。

Answer 1

阅读上面 Victoria 和 Remy 的评论后，我意识到锁定 canvas 可能会有帮助，所以我尝试将绘图代码包装在 FBitmap.Canvas.Lock 和 FBitmap.Canvas.UnLock 中，这似乎有解决了这个问题。

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;

TBitmap 在 non-related 图形代码后丢失裁剪区域

TBitmap looses Clipping region after non-related graphics code

delphi

tbitmap

tcanvas