Создание потоков для обработки файлов

unit Unit1;
 
interface
 
uses
  classes, types, forms, ExtCtrls, Controls, StdCtrls, SysUtils, Dialogs,
  System.Generics.Collections, vcl.imaging.jpeg;
 
type
  TMyThread=class(TThread)
    fname:string;
    jpg:TJPegImage;
    constructor Create(AFname:String; TermProc:TNotifyEvent);
    procedure Execute; override;
    destructor Destroy; override;
  end;
 
 
  TForm1 = class(TForm)
    bStart: TButton;
    m1: TMemo;
    procedure bStartClick(Sender: TObject);
  private
    ready:integer;
    procedure ThreadTerminated(Sender: TObject);
    procedure RunThread;
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  vcl.graphics ;
const
  max_th=100;
 
 
{$R *.dfm}
 
 
{ TForm1 }
 
 
procedure TForm1.RunThread;
var
  th:TMyThread;
  path,fn:string;
begin
  path:=extractFilePath(ParamStr(0));
  fn:=format('%.02d.jpg',[ready]);
  th:=TMyThread.Create(path+fn,ThreadTerminated);
  m1.lines.add('begin -- '+fn);
  th.Start;
  Inc(ready);
end;
 
procedure TForm1.bStartClick(Sender: TObject);
begin
  ready := 0;
  while ready<5 do
    runThread;
end;
 
 
procedure TForm1.ThreadTerminated(Sender:TObject);
var
  th:TMyThread absolute Sender;
begin
  th.jpg.SaveToFile(th.fname);
  m1.lines.add('end -- '+extractfilename(th.fname));
  if ready<max_th then
    RunThread;
end;
 
 
{ TMyThread }
constructor TMyThread.Create(AFname: String; TermProc: TNotifyEvent);
begin
  inherited Create(true);
  FreeOnTerminate := true;
  fname := AFname;
  OnTerminate := TermProc;
  jpg:=TJPEGImage.Create;
end;
 
destructor TMyThread.Destroy;
begin
  jpg.free;
  inherited;
end;
 
procedure TMyThread.Execute;
var b:TBitmap;
  i: Integer;
const
  SZ:TSize=(cx:300;cy:150);
begin
  b:=Tbitmap.Create;
  b.SetSize(sz.cx,sz.cy);
  for i := 0 to 9 do
    b.Canvas.Rectangle(random(sz.cx),random(sz.cy),random(sz.cx),random(sz.cy));
  jpg.CompressionQuality := 70;
  jpg.Assign(b);
  if FileExists(fname) then
    deletefile(fname);
  // jpg.SaveToFile(th.fname);
  b.Free;
end;
 
end.

unit Unit1;
 
interface
 
uses
  classes, types, forms, ExtCtrls, Controls, StdCtrls, SysUtils, Dialogs,
  System.Generics.Collections, vcl.imaging.jpeg;
 
type
  TMyThread=class(TThread)
    FName:String;
    Result:integer;
    jpeg:TJPEGImage;
    constructor Create(AFname:string; TermProc:TNotifyEvent);
    procedure Execute; override;
    destructor Destroy; override;
  end;
 
 
  TForm1 = class(TForm)
    bStart: TButton;
    m1: TMemo;
    procedure bStartClick(Sender: TObject);
  private
    T1:int64;
    Started:integer;
    Finished:integer;
    Sum:integer;
    procedure ThreadTerminated(Sender: TObject);
    procedure RunThread;
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses
  graphics;
 
const
  max_th=100;
  max_same_time=10;
 
 
{$R *.dfm}
 
 
{ TForm1 }
 
 
procedure TForm1.RunThread;
var
  th:TMyThread;
begin
  th:=TMyThread.Create(ExtractFilePath(ParamStr(0))+Format('%.03d.jpg',[started]),ThreadTerminated);
//  m1.lines.add('begin -- '+inttostr(Started));
  th.Start;
  Inc(Started);
end;
 
procedure TForm1.bStartClick(Sender: TObject);
begin
  bStart.Enabled := false;
  m1.lines.clear;
  t1:=TThread.GetTickCount;
  Started := 0;
  Finished := 0;
  Sum := 0;
  while Started < max_same_time do
    runThread;
end;
 
 
procedure TForm1.ThreadTerminated(Sender:TObject);
var
  th:TMyThread absolute Sender;
begin
  Inc(Finished);
//  m1.lines.add('end -- '+inttostr(th.Result));
  Sum:=Sum+th.Result;
 
  if Started<max_th then
    RunThread;
 
  if Finished=max_th then
  begin
    m1.lines.add('========================');
    m1.lines.add('Итог: '+inttostr(sum));
    m1.Lines.Add(IntToStr(max_th)+' threads');
    m1.Lines.Add(IntToStr(TThread.GetTickCount-t1)+' msec');
    bStart.Enabled:=true;
  end;
end;
 
 
{ TMyThread }
constructor TMyThread.Create(AFname:string; TermProc: TNotifyEvent);
begin
  inherited Create(true);
  FreeOnTerminate := true;
  FName := AFname;
  OnTerminate := TermProc;
  jpeg:=TJPEGImage.Create;
end;
 
 
destructor TMyThread.Destroy;
begin
  jpeg.Free;
  inherited;
end;
 
procedure TMyThread.Execute;
var
  i: Integer;
  b:TBitmap;
begin
  b:=TBitmap.Create;
  b.SetSize(300,150);
  b.Canvas.Lock;
  try
    for i := 0 to 5 do
      b.Canvas.Rectangle(Random(300),Random(150),Random(300),Random(150));
    jpeg.Assign(b);
    jpeg.Canvas.Lock;
    try
      if FileExists(FName) then
        DeleteFile(fname);
      jpeg.SaveToFile(fname);
    finally
      jpeg.canvas.Unlock;
    end;
  finally
    b.Canvas.Unlock;
    b.Free;
  end;
end;
 
end.

TTThread = class(TThread)
    FileName: string;
    Success: boolean;
  protected
    procedure Execute; override;
  end;

procedure TTThread.Execute;
var
  bmp: TBitmap;
  jpg: TJPEGImage;
  fJpegName: string;
begin
  // конвертирование BMP в JPG
  fJpegName:= DirOut + ChangeFileExt(ExtractFileName(FileName),'.jpg');
  bmp:= TBitmap.Create;
  jpg:= TJPEGImage.Create;
  bmp.LoadFromFile(FileName);
  bmp.Canvas.Lock;
  try
    jpg.Assign(bmp);
    jpg.CompressionQuality:= 100;
    jpg.Compress;
    if FileExists(fJpegName) then DeleteFile(fJpegName);
    jpg.SaveToFile(fJpegName);
  finally
    jpg.Free;
    bmp.Canvas.Unlock;
    bmp.Free;
  end;
  Success:= FileExists(fJpegName);
end;