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.
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.