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:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    Thread : tTestThread;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Thread := tTestThread.create(FALSE);
end;

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

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:

unit Unit2;

interface

uses
  Classes;

type
  tTestThread = class(TThread)
  private
    i : Integer;
  protected
    Procedure ShowValue;
    procedure Execute; override;
  public
    procedure Inc;
    constructor create(CreateSuspended: Boolean);
  end;

implementation

  USES Unit1, Windows, SysUtils;

{ tTestThread }

constructor tTestThread.create(CreateSuspended: Boolean);
begin
  inherited;
  i := 0;
end;

procedure tTestThread.Execute; // Läuft in einer endlosschleife
  VAR
    MSG : TMsg;
begin
  WHILE (NOT Terminated) DO BEGIN
    IF (PeekMessage(Msg, 0, 0, 0, PM_Remove)) THEN BEGIN
      TranslateMessage(Msg);
      DispatchMessage(Msg)
    END // Message Verarbeitung
    ELSE
      Sleep(0); // CPU Zeit Freigeben, wenn keine Message vorliegt
  END; // Solande der Thread nicht Terminiert wurde
end;

procedure tTestThread.Inc;
begin
  i := i + 1;
  Synchronize(ShowValue);
end;

procedure tTestThread.ShowValue;
begin
  Form1.Label1.Caption := IntToStr(i);
end;

end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

procedure tTestThread.Execute; // Läuft in einer endlosschleife 
  VAR
    MSG : TMsg;
begin
  WHILE (NOT Terminated) DO BEGIN
    IF (PeekMessage(Msg, 0, 0, 0, PM_Remove)) THEN BEGIN
      TranslateMessage(Msg);

      case Msg.message of
        MyMsg_AbortThread:
          Terminated := True;
        end;

    END // Message Verarbeitung
    ELSE
      Sleep(0); // CPU Zeit Freigeben, wenn keine Message vorliegt
  END; // Solande der Thread nicht Terminiert wurde
end;                    

1:
2:
3:
4:

const
  MyMsg_AbortThread = WM_USER + 1;
  AnotherMessage = WM_USER + 2;
  // usw...                    

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:

unit Unit2; // Die Thread Unit
[...]
const
  MyMsg_AbortThread = WM_USER + 1;
  MyMsg_Inc = WM_USER + 2;
[...]
procedure tTestThread.Execute;
  VAR
    MSG : TMsg;
begin
  WHILE (NOT Terminated) DO BEGIN
    IF (PeekMessage(Msg, 0, 0, 0, PM_Remove)) THEN BEGIN
      TranslateMessage(Msg);
      case Msg.message of
        MyMsg_AbortThread:
          Self.Terminate;
        MyMsg_Inc:
          Self.Inc;
        ELSE
          DispatchMessage(Msg);
      end;
    END // Message Verarbeitung
    ELSE
      Sleep(0); // CPU Zeit Freigeben, wenn keine Message vorliegt
  END; // Solande der Thread nicht Terminiert wurde
end;                    

1:
2:
3:
4:
5:
6:

unit Unit1; // Das Form
[...]
procedure TForm1.Button1Click(Sender: TObject);
begin
   PostThreadMessage(Thread.ThreadID, MyMsg_Inc, 0, 0);
end;