Поток+dll

unit Thread_ImageCreate;

interface

uses
  Windows, Classes, Forms, Graphics;

type
  TImageCreateThread = class(TThread) //Новый класс
  private

  protected
    procedure ShowError;
    procedure Execute; override;
  public
    constructor Create(CreateSuspennded:Boolean);
  end;

implementation

constructor TImageCreateThread.Create(CreateSuspennded:Boolean);
begin
 inherited Create(CreateSuspennded);
end;

procedure TImageCreateThread.ShowError;
begin
Application.MessageBox(PChar('11111'),'Error',MB_ICONERROR);
end;

procedure TImageCreateThread.Execute;
var ZBitmap,BM:TBitmap;
    i:Integer;
begin
try
ZBitmap:=TBitmap.Create;
ZBitmap.PixelFormat:=pf4bit;
ZBitmap.Width:=4000;
ZBitmap.Height:=4000;

for i:=1 to 1000 do
begin
BM:=TBitmap.Create;
BM.LoadFromFile('c:\1.bmp');
ZBitmap.Canvas.Draw(i*3,i*3,BM);
BM.Free;
end;

ZBitmap.SaveToFile('c:\3.bmp');
ZBitmap.Free;
except
 Synchronize(ShowError);
 end;
end;

end.

procedure TForm.FormClick(Sender: TObject);
 function GetHandle(iThread:TThread):HWND;
 begin
 if iThread<>nil then Result:=iThread.Handle
 else Result:=HWND(0);
 end;
begin
 if WaitForSingleObject(GetHandle(ImageCreateThread),0)<>WAIT_TIMEOUT then
  begin//запуск потока
  ImageCreateThread:=TImageCreateThread.Create(True);
  ImageCreateThread.FreeOnTerminate:=True;
  ImageCreateThread.Resume;
  end;
end;

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs;
type
  TForm1 = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation
uses Thread_ImageCreate;
{$R *.dfm}

procedure TForm1.FormClick(Sender: TObject);
begin
if Assigned(ImageCreateThread)=false then
 begin
 form1.Caption:='Start';
 ImageCreateThread:=TImageCreateThread.Create(true);
 ImageCreateThread.FreeOnTerminate:=true;
 ImageCreateThread.Resume;
 end;
end;

end.

unit Thread_ImageCreate;

interface
uses
  Windows, Classes, Forms, Graphics, SysUtils;
type
  TImageCreateThread = class(TThread) //Новый класс
  private
    FStep:Integer;
  protected
    procedure ShowError;
    procedure Progress;
    procedure Execute; override;
  public
    constructor Create(CreateSuspended:Boolean);
    destructor Destroy; override;
  end;

var ImageCreateThread:TImageCreateThread;
implementation
uses Unit1;

constructor TImageCreateThread.Create(CreateSuspended:Boolean);
begin
 inherited Create(CreateSuspended);
 FStep:=0;
end;

destructor TImageCreateThread.Destroy;
begin
inherited;
ImageCreateThread:=nil;
end;

procedure TImageCreateThread.Progress;
begin
form1.Caption:=IntToStr(FStep);
end;

procedure TImageCreateThread.ShowError;
begin
Application.MessageBox(PChar('11111'),'Error',MB_ICONERROR);
end;

procedure TImageCreateThread.Execute;
var ZBitmap,BM:TBitmap;
      i:Integer;
begin
try
ZBitmap:=TBitmap.Create;
ZBitmap.PixelFormat:=pf4bit;
ZBitmap.Width:=4000;
ZBitmap.Height:=4000;

ZBitmap.Canvas.Lock;{NEWNEWNEWNENWNEWNEWNEW}

for i:=1 to 1000 do
 begin
 BM:=TBitmap.Create;

 BM.Canvas.Lock;{NEWNEWNEWNENWNEWNEWNEW}

 BM.LoadFromFile('c:\1.bmp');
 ZBitmap.Canvas.Draw(i*3,i*3,BM);
 
 BM.Canvas.Unlock;{NEWNEWNEWNENWNEWNEWNEW}
 
 FreeAndNil(BM);
 FStep:=i;
 Synchronize(Progress);
 end;
ZBitmap.SaveToFile('c:\3.bmp');

ZBitmap.Canvas.Unlock;{NEWNEWNEWNENWNEWNEWNEW}

FreeAndNil(ZBitmap);
except
 Synchronize(ShowError);
 end;
end;

end.