1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

program Test

  TAThread = class(TThread)
  protected
    procedure Execute; override;
  public
    Status : String;
  end;

  procedure TAThread.Exceute;
  var Q : Integer;
  Begin
    Q := 0;
    while Q < 4096 do
    begin
      Status := 'Wird ausgeführt';
      inc(Q); Slepp(100);
    end;
    Status := 'Beendet';
  end;

var Q : TAThread;
    tmpMsg : TMsg;
begin
  Q := TThread.Create(FALSE)
  try
    while Q.Status <> 'Beendet' do
    Begin
      writeln(Q.Status); // bleibt immer leer
      PeekMessage(tmpMSg,0,0,0,PM_REMOVE);
    end;
  finally
    Q.Free;
  end;
  Readln;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:

program Test;

{$APPTYPE CONSOLE}

uses Windows,Classes,SysUtils;

type TAThread = class(TThread)
  protected  
    procedure Execute; override;  
  public  
    Status : String;  
  end;

  procedure TAThread.Execute;
  var Q : Integer;
  Begin
    Q := 0;
    while Q < 10 do
    begin
      Status := 'Wird ausgeführt';
      inc(Q);
      Sleep(1000);
    end;
    Status := 'Hey, der Thread ist beendet!';
  end;


var Q : TAThread;
var WaitResult:Integer;
begin
  Q := TAThread.Create(FALSE);
  try
    Repeat
      WaitResult:=WaitForSingleObject(Q.Handle,1000);
      if WaitResult<>0 then
        writeln('Thread ist noch nicht beendet.');
    until WaitResult=0;

    WriteLn(Q.Status);
  finally
    Q.Free;
  end;
  Readln;
end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:

unit TestThread;

interface

uses Classes, Windows, Messages, SysUtils;

  TSTestObject= class
    constructor Create;
    destructor Destroy; override;
  private
    FReadThread  : TThread;
    FThreadID : Cardinal;
  published
    property ThreadID : Cardinal read FThreadID;
  end;

implementation

type
  TSTestThread= class(TThread)
    destructor Destroy; override;
  protected
    procedure Execute; override;
  end;

  destructor TSTestThread.Destroy;
  Begin
    PostThreadMessage(ThreadID,WM_DESTROY,0,0);
    inherited;
  end;

  // ========== Protected Methods ==========

  procedure TSTestThread.Execute;
  var vMsg : TMsg;
  Begin
    while not Terminated do
    Begin
      IF GetMessage(vMsg,0,0,0) THEN
        case vMsg.message of
          WM_DESTROY : Terminate;
        ELSE
          {...}
          // z.B: MessageBox(0,PChar(IntToStr(vMsg.message)),nil,0);
        end;
    end;
  end;

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

  constructor TSTestObject.Create;
  Begin
    inherited;
    FReadThread := TSTestThread.Create(FALSE);
    FThreadID := FReadThread.ThreadID;
    {...}
  end;

  destructor TSTestObject.Destroy;
  Begin
    FReadThread.Free;
    inherited;
  end;

// *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

end.					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

  procedure Test;
  var Q : TSTestObject;
  Begin
    Q := TSTestObject.Create;
    try
      IF not PostThreadMessage(Q.ThreadID,WM_USER,0,0) THEN
        MessageBox(0,'Error sending',nil,0);
    finally
      Q.Free;
    end;
  end;