type
  TDLLThreadSync=class
  private
    FWnd:HWND;
    procedure WndProc(var Msg:TMessage);
    procedure WakeMainThread(Sender:TObject);
  public
    constructor Create;
    destructor Destroy; override;
  end;

unit Unit1;

interface

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

const
   Wm_Finished = Wm_User;

type
  TThreadInfo = class;

  TWmFinished = packed record
    Msg: Cardinal;
    Info: TThreadInfo;
    Aborted: Boolean;
    TotalLoop: Integer;
    CurrentLoop: Integer;
    Result: LongInt;
  end;

  TThreadInfo = class
  private
    fTotalLoop:   Integer;
    fCurrentLoop: Integer;
    fAborted:     Boolean;
  Public
    constructor   Create(aTotal:	Integer);
    destructor    Destroy; override;
    procedure     Abort;

    property TotalLoop:   Integer read fTotalLoop;
    property CurrentLoop: Integer read fCurrentLoop write fCurrentLoop;
    property Aborted:     Boolean read fAborted;
  end;

const
    MaxIterations = 20000;


type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    Thread: Integer;
    Info: TThreadInfo;
    procedure WmFinished(var Msg: TWmFinished);
    procedure StartThread;
    procedure FormClosed(Sender:  TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function HandeAbortThread(Param: Pointer): Integer;
var
  InfoMail: TThreadInfo;
  I: Integer;
begin
  Result :=0;
  InfoMail := TThreadInfo(Param);
  for I := 0 to InfoMail.TotalLoop do begin
    InfoMail.CurrentLoop:=I;
    if InfoMail.Aborted then begin
      PostMessage(Form1.Handle, Wm_Finished, 1, LParam(Param));
      Exit;
    end;
  end;
  PostMessage(Form1.Handle, Wm_Finished, 0, LParam(Param));
end;

constructor TThreadInfo.Create(aTotal:	Integer);
begin
  fTotalLoop:=aTotal;
end;

destructor TThreadInfo.Destroy;
begin
  Free;
end;

procedure TThreadInfo.Abort;
begin
  fAborted:=True;
end;

procedure TForm1.WmFinished(var Msg: TWmFinished);
begin
  Label1.Caption:='Thread Finished';
  if not Msg.Info.Aborted then Label1.Caption:=Label1.Caption+' '+IntToStr(Msg.Info.CurrentLoop);
  FreeAndNil(Msg.Info);
  CloseHandle(Thread);
  Thread  := 0;
end;

procedure TForm1.StartThread;
var
  Id:  Cardinal;
begin
  Info  := TThreadInfo.Create(10000);
  Thread:= BeginThread(nil,0,@HandeAbortThread,Info,0,Id);
end;

procedure TForm1.FormClosed(Sender:  TObject);
begin
  if Info <> nil then Info.Abort;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  StartThread;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FormClosed(Sender);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Info.Abort;
end;

end.

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Application.OnMessage := nil;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  Info: TThreadInfo;
begin
  if Msg.Message = Wm_Finished then begin
    Info:= TThreadInfo(Msg.lParam);
    ShowMessage('Thread Finished '+IntToStr(Info.CurrentLoop));
    Handled:= True;
  end;
end;