unit Unit1;

interface

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

const
  WM_THREAD_UPDATE = WM_USER + 1;
  WM_THREAD_REQUEST = WM_USER + 2;
  WM_THREAD_STOP = WM_USER + 3;

type
  TTestThread = class( TThread )
  private
    FWindowHandle: HWND;
    FWaitEvent: TSimpleEvent;
    FContinueFunc: TMsgDlgBtn;
  protected
    procedure Execute; override;
  public
    constructor Create( AWindowHandle: HWND );
    destructor Destroy; override;

    procedure ContinueCommand( AContinueFlag: TMsgDlgBtn );
  end;

  TForm1 = class(TForm)
    btnRestart: TButton;
    btnContinue: TButton;
    btnStop: TButton;
    Label1: TLabel;
    btnSkip: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRestartClick(Sender: TObject);
    procedure btnContinueClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure btnSkipClick(Sender: TObject);
  private
    FThread: TTestThread;

    procedure OnThreadUpdate( var Msg: TMessage ); message WM_THREAD_UPDATE;
    procedure OnThreadRequest( var Msg: TMessage ); message WM_THREAD_REQUEST;
    procedure OnThreadStop( var Msg: TMessage ); message WM_THREAD_STOP;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  btnRestart.Enabled := True;
  btnContinue.Enabled := False;
  btnSkip.Enabled := False;
  btnStop.Enabled := False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FThread.Free;
end;

procedure TForm1.OnThreadUpdate( var Msg: TMessage );
begin
  Label1.Caption := IntToStr( Msg.WParam );
end;

procedure TForm1.OnThreadRequest( var Msg: TMessage );
begin
  btnContinue.Enabled := True;
  btnSkip.Enabled := True;
  btnStop.Enabled := True;
end;

procedure TForm1.OnThreadStop( var Msg: TMessage );
begin
  FreeAndNil( FThread );
  btnRestart.Enabled := True;
end;

procedure TForm1.btnRestartClick(Sender: TObject);
begin
  btnRestart.Enabled := False;
  FThread.Free;
  FThread := TTestThread.Create( Handle );
end;

procedure TForm1.btnContinueClick(Sender: TObject);
begin
  btnContinue.Enabled := False;
  btnSkip.Enabled := False;
  btnStop.Enabled := False;
  FThread.ContinueCommand( mbYes );
end;

procedure TForm1.btnSkipClick(Sender: TObject);
begin
  btnContinue.Enabled := False;
  btnSkip.Enabled := False;
  btnStop.Enabled := False;
  FThread.ContinueCommand( mbNo );
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  btnContinue.Enabled := False;
  btnSkip.Enabled := False;
  btnStop.Enabled := False;
  FThread.ContinueCommand( mbCancel );
end;

constructor TTestThread.Create( AWindowHandle: HWND );
begin
  FWindowHandle := AWindowHandle;
  FWaitEvent := TSimpleEvent.Create;
  inherited Create( False );
end;

destructor TTestThread.Destroy;
begin
  Terminate;
  FWaitEvent.SetEvent;
  inherited;
  FWaitEvent.Free;
end;

procedure TTestThread.ContinueCommand( AContinueFlag: TMsgDlgBtn );
begin
  FContinueFunc := AContinueFlag;
  FWaitEvent.SetEvent;
end;

procedure TTestThread.Execute;
var
  i: Integer;
begin
  try
    repeat
      for i := 0 to 1000 do begin
        SendMessage( FWindowHandle, WM_THREAD_UPDATE, i, 0 );
        FWaitEvent.WaitFor( 5 );
        if Terminated then
          Exit;

        if i = 500 then begin
          SendMessage( FWindowHandle, WM_THREAD_REQUEST, 0, 0 );
          FWaitEvent.WaitFor( INFINITE );
          if Terminated then
            Exit;

          FWaitEvent.ResetEvent;
          case FContinueFunc of
            mbYes: Continue; // Продолжаем счет от 500 (на самом деле от 501) до 1000
            mbNo: Break; // Пропускаем и начинаем с начала
            else {mbCancel} // Прерываем счет
              Exit;
          end;
        end;
      end;
    until Terminated;
  finally
    PostMessage( FWindowHandle, WM_THREAD_STOP, 0, 0 );
  end;
end;

end.