Search code examples
multithreadingdelphidelphi-7

Threads are freezing main form


I want to run multiple thread. Each thread should convert JPEG to Bitmap. Conversion works but my whole application is always using 12%-13% of CPU. I have an 8 core CPU so it seems the whole application uses just a single core. Also while the threads are working the main form is frozen and doesn't respond.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Jpeg, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Str: TMemoryStream;
    procedure OnTerminate(Sender: TObject);
  end;

  TMakeThumbThread= class(TThread)
  private
    FStream: TStream;
  public
    FBmp: TBitmap;    
    constructor Create(Str: TStream);
    procedure Execute; override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TMakeThumbThread.Create(Str: TStream);
begin
  inherited Create(True);
  FStream := Str;
  FreeOnTerminate := True;
end;

procedure TMakeThumbThread.Execute;
var Jpg: TJpegImage;
begin
  FBmp := TBitmap.Create;
  FBmp.PixelFormat := pf32bit;
  FBmp.Width := 300;
  FBmp.Height := 200;

  Jpg := TJpegImage.Create;
  FStream.Position := 0;
  Jpg.LoadFromStream(FStream);
  FBmp.Canvas.Draw(0,0, Jpg);
  Jpg.Free;

  DoTerminate;
  FBmp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var F: TFileStream;
    i: Integer;
    MT: TMakeThumbThread;
begin
  Str := TMemoryStream.Create;
  F := TFileStream.Create('test.jpg', fmOpenRead or fmShareDenyWrite);
  Str.CopyFrom(F, F.Size);
  F.Free;

  for i:=0 to 500 do begin
    MT := TMakeThumbThread.Create(Str);
    MT.OnTerminate := OnTerminate;
    MT.Execute;
  end;
end;

procedure TForm1.OnTerminate(Sender: TObject);
var Bmp: TBitmap;
begin
  Bmp := TMakeThumbThread(Sender).FBmp;
  Form1.Canvas.Draw(1,1, Bmp );
end;

end.

Solution

  • You are manually calling the thread's Execute() method in the context of the main thread. DON'T DO THAT! That is why your UI is freezing. You are creating your threads in a suspended state and never resuming them.

    You need to change this line:

    MT.Execute;
    

    To either this:

    MT.Resume;
    

    Or this:

    MT.Start;
    

    Depending on which version of Delphi you are using.

    There are several other problems with your code, too.

    • The VCL's TBitmap class is not entirely thread-safe. You MUST Lock() the TBitmap.Canvas when working with a TBitmap in a worker thread, to prevent the main thread from ripping GDI resources away from the TBitmap unexpectedly.

    • You are sharing a single TMemoryStream with multiple threads to have them all load the same JPG image simultaneously. That will not work unless you wrap access to the TMemoryStream with a synchronization object, like a TCriticalSection or TMutex. Or, another option would be to use TCustomMemoryStream to create multiple streams that share a single memory block. Otherwise, you would be better off simply passing the JPG filename to each thread and let Execute() call TJpegImage.LoadFromFile() instead of TJpegImage.LoadFromStream().

    • You are calling FBmp.Free() at the end of Execute(), but then you are accessing FBmp afterwards in the OnTerminate event handler. You need to delay the call to FBmp.Free() until after the OnTerminate event handler exits, such as in the thread's destructor.

    • You are drawing the bitmaps directly on the TForm.Canvas from outside of the Form's OnPaint event. As such, as soon as your Form need to redraw itself for any reason, your drawn images will be lost. If you want the images to be persistent for the Form's lifetime, you need to save them and draw them whenever the OnPaint event fires. Or, you can simply assign them to TImage components and let them handle the drawing for you.