Delphi TCanvas 对象从 dll 使用后损坏，如何恢复？ [关闭]

Question

有一些问题。我有一个带有画布的表单，我需要通过它的句柄从 dll 访问这个画布。我是这样做的：

来自 dll

canvas := TCanvas.Create;
  try
    canvas.Handle := handle;
    // do some painting on this canvas
  finally
    canvas.free;
  end;

效果很好，我从 dll 中绘制了我需要的东西。但是这个技巧有副作用。从 dll 绘制后，表单会丢失字体设置（顺便说一句，从 dll 绘制时我没有使用字体，只有几个矩形），当我从主表单在同一画布上绘制时，即使我直接使用 canvas.font.size := .. .; canvas.font.name := ...;在 canvas.TextOut 之前，字体不会改变。线条，填充和其他绘画都可以。但是字体会损坏（有时不会，但大多数情况下）。

有没有办法重置/重新初始化表单的 TCanvas 对象？

Answer 1

Canvas 没有任何重置功能，但您可以要求 api 保存画布的设备上下文状态，并在绘制后恢复它。

var
  SavedDC: Integer;

  ...
  SavedDC := SaveDC(handle);
  try
    canvas := TCanvas.Create;
    try
      canvas.Handle := handle;
      // do some painting on this canvas
    finally
      canvas.free;
    end;
  finally
    RestoreDC(handle, SavedDC);
  end;

Remy's answer 解释了您如何丢失设备上下文的状态。为什么它并不总是发生应该取决于我相信的时机。如果表单在其画布使用其字体时进入了新的绘制周期，那么一切都应该很好，因为它是在新获取和设置的设备上下文上运行的。

Answer 2

Form 的Canvas 被“损坏”的原因是DLL 的TCanvas 对象正在替换已经分配给HDC 的原始HFONT、HBRUSH 和/或HPEN 对象，但随后在其销毁期间分配 stock GDI 对象（来自GetStockObject()），而不是重新分配先前分配的 original GDI 对象。当TCanvas.Handle 属性更改值（包括销毁期间）时，TCanvas.DeselectHandles() 方法中会发生这种情况：

var
  ...
  StockPen: HPEN;
  StockBrush: HBRUSH;
  StockFont: HFONT;
  ...

procedure TCanvas.DeselectHandles;
begin
  if (FHandle <> 0) and (State - [csPenValid, csBrushValid, csFontValid] <> State) then
  begin
    SelectObject(FHandle, StockPen);   // <-- STOCK PEN!
    SelectObject(FHandle, StockBrush); // <-- STOCK BRUSH!
    SelectObject(FHandle, StockFont);  // <-- STOCK FONT!
    State := State - [csPenValid, csBrushValid, csFontValid];
  end;
end;

...
initialization
  ...
  StockPen := GetStockObject(BLACK_PEN);
  StockBrush := GetStockObject(HOLLOW_BRUSH);
  StockFont := GetStockObject(SYSTEM_FONT);
  ...

要在 DLL 函数退出后使表单“重置”其Canvas，您必须欺骗Canvas 知道其 GDI 对象不再分配给 HDC因此它可以从其内部State 成员中清除相关标志，并根据需要重新分配其 GDI 对象。您可以：

1. 手动触发Canvas.Font、Canvas.Brush和Canvas.Pen属性的OnChange事件处理程序：

   procedure TMyForm.FormPaint(Sender: TObject);
   begin
     try
       CallDllFunc(Canvas.Handle);
     finally
       Canvas.Font.OnChange(nil);
       Canvas.Brush.OnChange(nil);
       Canvas.Pen.OnChange(nil);
     end;
   end;
   

   或者：

   type
     TGraphicObjectAccess = class(TGraphicObject)
     end;
   
   procedure TMyForm.FormPaint(Sender: TObject);
   begin
     try
       CallDllFunc(Canvas.Handle);
     finally
       TGraphicObjectAccess(Canvas.Font).Changed;
       TGraphicObjectAccess(Canvas.Brush).Changed;
       TGraphicObjectAccess(Canvas.Pen).Changed;
     end;
   end;
   

2. 您可以暂时删除然后重新分配原来的HDC，这对State 标志有类似的效果：

   procedure TMyForm.FormPaint(Sender: TObject);
   var
     DC: HDC;
   begin
     try
       CallDllFunc(Canvas.Handle);
     finally
       DC := Canvas.Handle;
       Canvas.Handle := 0;
       Canvas.Handle := DC;
     end;
   end;
   

3. 使用SaveDC()和RestoreDC()，如Sertac's answer所示。

Answer 3

标准的 TCanvas 类并不适合在“借来的”画布上绘画。也就是说，由于它管理 GDI 对象的方式（依赖于“拥有”HDC 和正在使用的 DC 中的 GDI 对象）。

在简单的情况下它可以工作，但您遇到的问题并不少见。特别是对于 DLL，可能会出现问题，因为 TCanvas 中的机制依赖于需要的“全局”画布列表 (CanvasList)进行管理并保持同步以响应系统变化。

即在 DLL 中会有一个 CanvasList，它是 DLL 中的画布列表，与宿主应用程序进程中的 CanvasList 分开。应用程序 CanvasList 不会在 DLL 中包含任何 TCanvas 实例，反之亦然。如果一个 DLL 有一个 TCanvas，它实际上是应用程序中一个 TCanvas 的“副本”（使用相同的 HDC），那么问题是如何出现的应该是显而易见的。

我看到您的情况有两种前进方式，可以单独使用或一起使用。

1. 您没有提供所有绘画代码的详细信息，因此很难说哪一个可能是您的问题的根源。但是，您可以通过注释掉所有您的绘画代码（在您的绘画例程中的 try 和 finally 之间）很容易地识别这一点。这应该可以解决您的字体问题。如果您随后以增量方式（逐行或逐段）重新启用绘制代码，您可以准确识别导致问题的绘制操作，并从那里（可能）确定解决方案。

2. 如果您的绘画操作非常简单（如您所说，只需绘制几个矩形），那么您可以使用简单的 GDI 调用在有问题的情况（或所有问题）中进行绘画，而不是使用画布.在这种情况下，我建议您将 窗口句柄 传递给您的 DLL，而不是设备上下文。然后，您的 DLL 应通过 GetDC() 获取它自己的设备上下文，并在完成后通过 ReleaseDC() 释放它。您需要自己在设备上下文上绘制时管理 GDI 对象，但可以确保无论您做什么都不会干扰由同一窗口上的 TCanvas 绘图管理的 GDI 对象。

另一种可能是使用SaveDC()和RestoreDC()，如Sertac's answer所示。