// 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
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.
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.
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:
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;
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With