FAQ VCL
Потоки

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как выполнить процедуру в отдельном потоке, не используя TThread?

// Способ первый
type
  TRefProc = reference to procedure;

implementation

function Thread( const Proc: TRefProc ): THandle;
   function Run( const Proc: TRefProc ): Integer; stdcall;
   begin
      Proc;
      Result := 0;
   end;
begin
   CreateThread( nil, 0, @Run, PPointer( @Proc )^, 0, Result );
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Done: THandle;
begin
   Done := CreateEvent( nil, true, false, nil );
   try
      Thread( procedure
              begin
                 Sleep( 2000 );
                 SetEvent( Done );
              end );
      WaitForSingleObject( Done, INFINITE );
   finally
      CloseHandle( Done );
   end;
end;

// Способ второй
type
  PThreadData = ^TThreadData;
  TThreadData = record
    c: TControl;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

{...}

implementation

{$R *.dfm}

var
  DataPtr: TThreadData;

function JoltingControl(Parameter: Pointer): Integer;
var
  i, x, y, r: Integer;
  lpDataPtr: PThreadData;
begin
  lpDataPtr := Parameter;

  x := TControl(lpDataPtr^.c).Left;
  y := TControl(lpDataPtr^.c).Top;
  r := 5;

  Randomize;
  for i := 1 to 1000 do
  begin
    TControl(lpDataPtr^.c).Left := x + Random(r+1) - Random(r+1);
    TControl(lpDataPtr^.c).Top := y + Random(r+1) - Random(r+1);
  end;
  TControl(lpDataPtr^.c).Left := x;
  TControl(lpDataPtr^.c).Top := y;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  ThreadId: DWORD;
  ThreadHandle: THandle;
begin
  DataPtr.c := Edit1;
  ThreadHandle := BeginThread(nil, 0, @JoltingControl, @DataPtr, 0, ThreadId);
  CloseHandle(ThreadHandle);
end;

При использовании материала - ссылка на сайт обязательна