这段代码线程安全吗

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

你说：

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

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

线程问题与时间高度相关，并且以多种方式表现出来——而不仅仅是异常。需要记住的重要一点是，线程问题可能会作为潜在缺陷存在数月，然后才会发生任何意外。即便如此，它们通常也很难以任何一致性措施来重现。

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

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

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

---

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

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

---

编辑2
请求更多示例代码：
声明消息常量。

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;