delphi - TBitmap 在非相关图形代码后丢失剪切区域

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

阅读上面维多利亚和雷米的评论后，我意识到锁定 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;