Как выполнить процедуру в отдельном потоке, не используя 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;
|