这段代码是否安全？

Question

// experimental code
procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width,
 Height: Integer; out Bitmap: TBitmap );
var
   AExtension: string;
   ARect: TRect;
begin
  AExtension := LowerCase( ExtractFileExt( Path ) );
  if AExtension = '.wmf' then
  begin
    ARect.Left := 0;
    ARect.Top := 0;
    ARect.Right := Width;
    ARect.Bottom := Height;
    Image1.Picture.LoadFromFile( Path ); // added at design time to form
    Bitmap := TBitmap.Create;
    Bitmap.Width := Width;
    Bitmap.Height := Height;
    Bitmap.Canvas.StretchDraw( ARect, Image1.Picture.Graphic );
  end;
end;

编辑

procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width, Height: Integer; out Bitmap: TBitmap );
var
  ARect: TRect;
  APicture: TPicture;
  AExtension: string;
begin
  // experimental code
  if FileExists( Path ) then
  begin
    AExtension := LowerCase( ExtractFileExt( Path ) );
    if AExtension = '.wmf' then
    begin
      ARect.Left := 0;
      ARect.Top := 0;
      ARect.Right := Width;
      ARect.Bottom := Height;
      APicture := TPicture.Create;
      try
        APicture.LoadFromFile( Path );
        Bitmap := TBitmap.Create;
        Bitmap.SetSize( Width, Height );
        Bitmap.IgnorePalette := True;
        Bitmap.PixelFormat := pf24bit;
        Bitmap.Transparent := False;
        Bitmap.Canvas.Lock; **// New**
        try
          Bitmap.Canvas.StretchDraw( ARect, APicture.Graphic );
        finally
          Bitmap.Canvas.Unlock;  **// New!**
        end;
      finally
        APicture.Free;
      end;
    end;
  end;
end;

这似乎完全解决了绘图问题！ 显然你在使用Draw或StretchDraw时必须锁定和解锁画布，因为在一个线程中，由于graphics.pas中的GDI对象缓存机制，它的Bitmap.canvas的DC有时会被清除。

请参阅http://qc.embarcadero.com/wc/qcmain.aspx?d=55871

Answer 1

不，因为这个：

Image1.Picture.LoadFromFile( Path );
/// [...]
Bitmap.Canvas.StretchDraw( ARect, Image1.Picture.Graphic );

您只能使用主VCL线程中的VCL控件。

Answer 2

通常，VCL代码不是线程安全的，这适用于大多数可用的VCL对象。

你说：

这似乎是线程安全的，因为线程中没有产生异常，但图像似乎是部分空白或未正确绘制？

“没有例外”并不表示“线程安全”。 这就像说“我开车上班，并没有撞车，所以我的车是防撞车。”

线程问题高度依赖于时序，并以各种方式表现出来 - 而不仅仅是异常。 需要记住的重要一点是，在发生任何不幸事件之前，线程问题可能会作为潜在缺陷存在数月。 即便如此，它们通常很难以任何一致性度量再现。

• 如果您遇到线程问题的异常，其他问题可能更难以跟踪，甚至意识到它们正在发生，那么您真的很幸运。
• 您可以获得死锁，但如果它在后台线程中，您可能甚至都没有意识到它。
• 行为不正确（正如您所报告的那样），通常是由于竞争条件导致：
  • 某些代码在处于不一致状态时会与对象进行交互 - 通常会导致高度不可预测的行为。
  • 数据被错误地“丢弃”，因为一个例程的更改会立即覆盖另一个例程。
• 表现不佳; 是的，实施不当的多线程解决方案会严重降低性能。

当你说“图像似乎是部分空白或没有正确绘制”时，一个重要的问题是：它是否总是以相同的方式行为不正常的图像？ 如果是这样，那么问题可能只是您用于加载图像的控件存在这些特定文件的问题。

你真的在运行多个线程吗？ 我没有在你的代码中看到任何表明这样的东西。
您是否尝试过运行单线程来确认它是否真的是一个线程问题？

---

编辑
那么最简单的解决方案可能是：

• 定义一个自定义消息const，您可以在其上实现消息处理程序。
• 为消息实现消息处理程序
• 修改现有procedure TFormMain.MyThumbnailProvider以便它可以与VCL主线程同步，并将工作传递给同步处理程序。

以下将在VCL主线程中调用您的自定义处理程序，并等待返回。

procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; 
  Width, Height: Integer; out Bitmap: TBitmap );
var
  LThumnailData: TThumbnailData; //Assuming an appropriately defined record
begin
  LThumbnailData.FPath := Path;
  LThumbnailData.FWidth := Width;
  LThumbnailData.FHeight := Height;
  LThumbnailData.FBitmap := nil;
  SendMessage(Self.Handle, <Your Message Const>, 0, Longint(@LThumbnailData));
  Bitmap := LThumbnailData.FBitmap;
end;

---

EDIT2
更多示例代码请求：
声明消息const。

const
  //Each distinct message must have its own unique ref number.
  //It's recommended to start at WM_APP for custom numbers.
  MSG_THUMBNAILINFO = WM_APP + 0;

声明记录类型。 真的很简单，但你也需要指针。

type
  PThumbnailData = ^TThumbnailData;
  TThumbnailData = record
    FPath: Unicodestring;
    FWidth, FHeight: Integer;
    FBitmap: TBitmap;
  end;

声明消息处理程序。

procedure MSGThumbnailInfo(var Message: TMessage); message MSG_THUMBNAILINFO;

实现消息处理程序。

procedure TForm3.MSGThumbnailInfo(var Message: TMessage);
var
  LThumbnailData: PThumbnailData;
begin
  LThumbnailData := Pointer(Message.LParam);

  //The rest of your code goes here.
  //Don't forget to set LThumbnailData^.FBitmap before done.

  Message.Result := 0;
  inherited;
end;