Nicht gestarteter TThread wird nicht beendet - Verständnisproblem: Thread und Event

[TiGü]

Hallo Gemeinde,

ich habe gerade ein Brett vor dem Kopf und das Gefühl etwas ganz Wesentliches in Bezug auf Threads und Events nicht verstanden zu haben.

Wenn mich jemand in die richtige Richtung schubsen würde, wäre ich sehr dankbar.

Was habe ich vor?

Eine Anwendung soll aus einer DLL über ein COM-Interface-Objekt als Wrapper einen Thread starten.
Beim Instanziieren des COM-Interface-Objekts aus der DLL wird der Thread suspendiert erzeugt.

Dieser Thread soll nach dem Starten beim Ausführen ein Messgerät ständig abfragen bzw. pollen und zwar so schnell wie möglich (oder wie es die Hardware zulässt).

Die Host-Anwendung lässt sich super beenden, wenn der Thread gestartet wurde und sein Execute durchläuft.
Wenn ich aber das Programm beenden will, ohne das der Thread losläuft, dann hänge ich im System.Classes.TThread.Destroy fest.
Es wird die folgende While-Schleife nie verlassen:

Delphi-Quellcode:

destructor TThread.Destroy;
begin
  if (FThreadID <> 0) and not FFinished and not FExternalThread then
  begin
    Terminate;
    if FCreateSuspended or FSuspended then
      Resume;
...
    while not FStarted do
...
      Yield;  // Hier komme ich nicht raus!
    WaitFor;
  end;
...
end;

Mit der folgenden Testanwendung (auch als gezipptes XE7-Projekt im Anhang) wird mein Problem nachvollziehbar.
Das COM-Interface-Objekt wird im AfterConstruction des Hauptformulars erzeugt und erzeugt dann wiederrum intern den Thread.
Wenn die Anwendung beendet wird, ohne auf den Button geklickt zu haben, bleibt das Programm im Taskmanager mit Endlosschleife stehen.

Was mache ich falsch?
Muss ich das Problem ganz anderes angehen?
Ich bitte um Rat!

Delphi-Quellcode:

unit Main.View;

interface

uses
  System.SysUtils,
  System.Classes,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls;

type
  IDataManager = interface
    ['{936641B4-4868-4EFB-8513-65FE4DF51397}']
    procedure StartDataGrapping; stdcall;
  end;

  TForm2 = class(TForm)
    btnStartDataGrapping : TButton;
    procedure btnStartDataGrappingClick(Sender : TObject);
  private
    FDataManager : IDataManager;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

const
  THREAD_PROBLEM_DLL = 'ThreadProblemDLL.dll';

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall; external THREAD_PROBLEM_DLL;

var
  Form2 : TForm2;

implementation

{$R *.dfm}


procedure TForm2.AfterConstruction;
begin
  inherited;
  GetDataManager(FDataManager);
end;

procedure TForm2.BeforeDestruction;
begin
  inherited;
end;

procedure TForm2.btnStartDataGrappingClick(Sender : TObject);
begin
  if Assigned(FDataManager) then
  begin
    FDataManager.StartDataGrapping;
  end;
end;

end.

Delphi-Quellcode:

unit DLL.DataManager;

interface

uses
  System.SysUtils,
  System.Classes,
  DLL.Thread;

type
  IDataManager = interface
    ['{936641B4-4868-4EFB-8513-65FE4DF51397}']
    procedure StartDataGrapping; stdcall;
  end;

  TDataManager = class(TInterfacedObject, IDataManager)
  strict private
    FMyThread : TMyThread;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;

    procedure StartDataGrapping; stdcall;
  end;

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall;

implementation

var
  _DataManager : IDataManager;

function GetDataManager(out DataManager : IDataManager) : ByteBool; stdcall;
begin
  if not Assigned(_DataManager) then
  begin
    _DataManager := TDataManager.Create;
  end;
  DataManager := _DataManager;
  Result := Assigned(DataManager);
end;

procedure TDataManager.AfterConstruction;
begin
  inherited;
  FMyThread := TMyThread.Create(True);
end;

procedure TDataManager.BeforeDestruction;
begin
  inherited;
  FMyThread.Free;
end;

procedure TDataManager.StartDataGrapping;
begin
  if Assigned(FMyThread) then
  begin
    if not FMyThread.Started then
    begin
      FMyThread.Start;
    end;
  end;
end;

end.

Delphi-Quellcode:

unit DLL.Thread;

interface

uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  System.SyncObjs;

type
  TLock = System.SyncObjs.TCriticalSection;

  TBaseThread = class(TThread)
  private
    FThreadName : string;
  protected
    FLock : TLock;
    FWaitEvent : TEvent;

    procedure Execute; override;
    procedure ProcessInternalTask; virtual; abstract;
    procedure TerminatedSet; override;
  public
    procedure LogToOutput(const Text : string);
    constructor Create(CreateSuspended : Boolean = True); overload;
    destructor Destroy; override;
  end;

  TMyThread = class(TBaseThread)
  strict private
    FData : UInt64;
  protected
    procedure ProcessInternalTask; override;
  end;

implementation

constructor TBaseThread.Create(CreateSuspended : Boolean = True);
begin
  inherited Create(CreateSuspended);
  FLock := TLock.Create;
  FWaitEvent := TEvent.Create;
  FThreadName := Self.ClassName + '-' + Self.ThreadID.ToString;
  NameThreadForDebugging(FThreadName, ThreadID);
end;

destructor TBaseThread.Destroy;
begin
  inherited;
  FWaitEvent.Free;
  FLock.Free;
end;

procedure TBaseThread.Execute;
begin
  inherited;
  while not Terminated do
  begin
    FWaitEvent.WaitFor(1);
    if not Terminated then
    begin
      ProcessInternalTask;
    end;
  end;
end;

procedure TBaseThread.LogToOutput(const Text : string);
begin
  OutputDebugString(PWideChar(Text));
end;

procedure TBaseThread.TerminatedSet;
begin
  inherited;
  FWaitEvent.SetEvent;
end;

procedure TMyThread.ProcessInternalTask;
begin
  try
    Inc(FData);
    if (FData mod 1000) = 0 then
      LogToOutput('FData say Hello! ' + FData.ToString);
  except
    on E : Exception do
      LogToOutput(E.ClassName + ': ' + E.Message);
  end;
end;

end.