这个代码线程安全吗

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 对象。

你说：

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

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

线程问题高度依赖时间，并以多种方式表现出来——不仅仅是例外。要记住的重要一点是，线程问题可能会作为潜在缺陷存在数月，然后才会发生任何不愉快的事情。即便如此，它们通常很难以任何一致性度量来重现。

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

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

您实际上是在运行多个线程吗？我在您的代码中没有看到任何可以表明的内容。
您是否尝试过运行单线程来确认它是否真的是线程问题？

---

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

• 定义一个自定义消息常量，您可以在该常量上实现消息处理程序。
• 为消息实现消息处理程序
• 修改您现有的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
  //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;