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的Tag而没有设置标题，那么FBitmap的裁剪区域将在整个绘图代码中保持并得到尊重。 FBitmap将如下所示：

但是，如果设置Form1的标题，则FBitmap将失去其裁剪区域，并如下所示：

因此，似乎在设置Form1的标题后，FBitmap失去了其裁剪区域。当这种情况发生时，WindowOrigins（通过SetWindowOrgEx设置）也会丢失。

- Blurry Sterk

---

那个位图失去了它的画布（在D2009中，它的句柄在窗体标题更改后变为0）。控件没有被重新创建。你试过牺牲一只小棕色松鼠或类似的树上动物吗？这真的毫无意义。 - Victoria

@Victoria，如果考虑到VCL缓存GDI资源并频繁（在消息处理期间）释放未被主动锁定的画布HDC，则这是有道理的。不要期望GDI设置会随时间保持不变。每当需要绘制东西时，请重置它们。由DrawBorder设置的区域在执行返回到主消息循环后（例如由于Caption更改引起的重绘）可能无效。 - Remy Lebeau

Answer 1

在阅读了上面Victoria和Remy的评论后，我意识到锁定画布可能有所帮助，因此我尝试在绘图代码中添加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;

- Blurry Sterk

---

我会将它放在一个 try..finally 块中（这里有点多虑，但还是这样做比较好）。 - Victoria