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;

这段代码是否安全？

2 个答案: