Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Is this code thread safe

// 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;

Edited

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;

This seems to fix the drawing problem completely! Apparently you have to lock and unlock the canvas when using Draw or StretchDraw because in a thread, the DC of its Bitmap.canvas is sometimes cleared due to the GDI Object Caching mechanism in graphics.pas.

See http://qc.embarcadero.com/wc/qcmain.aspx?d=55871

like image 213
Bill Avatar asked Dec 12 '22 13:12

Bill


2 Answers

No, because of this:

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

You can only work with the VCL controls from the main VCL thread.

like image 193
Cosmin Prund Avatar answered Dec 31 '22 03:12

Cosmin Prund


In general VCL code is not thread safe, and this applies to the majority of VCL objects available for use.

You said:

This seems to be threadsafe because no exceptions are produced in the thread, but the images seem to be partially blank or not drawing correctly?

"No exceptions" are not an indication of 'thread safety'. That's the same as saying "I drove to work, and didn't crash, so my car is crash proof."

Threading issues are highly timing dependent, and manifest themselves in a variety of ways - not just exceptions. The important thing to remember is that threading issues can exist as latent defects for months before anything untoward happens. And even so, they are typically very difficult to reproduce with any measure of consistency.

  • You're actually lucky if you get exceptions with threading issues, the other problems can be more difficult to track, or even realise they're occuring.
  • You can get deadlocks, but if it's in a background thread, you might not even realise it.
  • Incorrect behaviour (as you're reporting), typically due to race conditions in which:
    • Some code will interact with an object while it's in an inconsistent state - typically resulting in highly unpredictable behaviour.
    • Data being incorrectly 'discarded' because one routines changes immediately overwrite another's.
  • Poor performance; yes, poorly implemented muti-threaded solutions can severely reduce performance.

When you say "images seem to be partially blank or not drawing correctly", an important question is: Is it always the same images misbehaving, in the same way? If so, then the issue might simply be that the control you're using to load the images is having a problem with those specific files.

Are you actually running multiple threads? I did't see anything in your code to indicate as such.
Have you tried running single-threaded to confirm whether it really is a threading issue?


EDIT
Then the simplest solution will probably be:

  • Define a custom message const on which you can implement a message handler.
  • Implement a message handler for the message
  • Modify your existing procedure TFormMain.MyThumbnailProvider so that it can synchronise with the VCL Main Thread, and pass the work on to the synchronised handler.

The following will call your custom handler in the VCL main thread, and wait for a return.

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
More sample code requested:
Declaring the message 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;

Declaring the record type. Really easy, but you need the pointer too.

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

Declaring the message handler.

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

Implementing the message handler.

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;
like image 37
Disillusioned Avatar answered Dec 31 '22 02:12

Disillusioned