这段代码线程安全

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;