unit uDemoThread;
interface
uses
Classes,
SyncObjs;
type
TNotifyInfoEvent =
procedure(
const Info :
string; Ticks : Cardinal )
of object;
TThreadExecType = ( tetSlowSync, tetFastSync, tetQueue );
TDemoThread =
class( TThread )
private
{ Private-Deklarationen }
FEventCS : TCriticalSection;
FOnInfoEvent : TNotifyInfoEvent;
FExecType : TThreadExecType;
procedure CallSlowSyncEvent(
const Info :
string; Ticks : Cardinal = 0 );
procedure CallFastSyncEvent(
const Info :
string; Ticks : Cardinal = 0 );
procedure CallQueueEvent(
const Info :
string; Ticks : Cardinal = 0 );
function GetOnInfoEvent : TNotifyInfoEvent;
procedure SetOnInfoEvent(
const Value : TNotifyInfoEvent );
protected
procedure Execute;
override;
public
constructor Create( CreateSuspended : Boolean; ExecType : TThreadExecType = tetSlowSync );
destructor Destroy;
override;
published
property OnInfoEvent : TNotifyInfoEvent
read GetOnInfoEvent
write SetOnInfoEvent;
end;
implementation
uses
SysUtils, Windows;
{ TDemoThread }
procedure TDemoThread.CallSlowSyncEvent(
const Info :
string; Ticks : Cardinal );
var
IntTicks : Cardinal;
begin
// Der SlowSync synchronisiert IMMER mit dem Hauptthread
// egal, ob ein Event verknüpft ist oder nicht
// Wenn kein Event verknüpft ist, bräuchte ja eigentlich kein Sync erfolgen
if MainThreadID = GetCurrentThreadId
then
begin
if Assigned( FOnInfoEvent )
then
FOnInfoEvent( Info, Ticks );
end
else
begin
IntTicks := GetTickCount;
Synchronize(
procedure begin CallSlowSyncEvent( '
via SlowSync: ' + Info, IntTicks )
end );
end;
end;
procedure TDemoThread.CallFastSyncEvent(
const Info :
string; Ticks : Cardinal );
var
IntTicks : Cardinal;
begin
// Der Fast-Sync synchronisiert nur, wenn auch ein Event zugewiesen wurde
// Da diese Abfrage aber noch im Thread-Kontext erfolgt, muss die
// Eigenschaft OnInfoEvent über eine CS abgesichert werden
if Assigned( OnInfoEvent )
then
if MainThreadID = GetCurrentThreadId
then
FOnInfoEvent( Info, Ticks )
else
begin
IntTicks := GetTickCount;
Synchronize(
procedure begin CallFastSyncEvent( '
via FastSync: ' + Info, IntTicks )
end );
end;
end;
procedure TDemoThread.CallQueueEvent(
const Info :
string; Ticks : Cardinal );
var
IntTicks : Cardinal;
begin
// Beim Queue ist es völlig wurscht, ob da nun eine Sync erfolgt oder nicht,
// denn dieser Aufruf erfolgt eh asynchron und beschäftigt den Thread nicht weiter
if MainThreadID = GetCurrentThreadId
then
begin
if Assigned( OnInfoEvent )
then
FOnInfoEvent( Info, Ticks );
end
else
begin
IntTicks := GetTickCount;
Queue(
procedure begin CallQueueEvent( '
via Queue: ' + Info, IntTicks )
end );
end;
end;
constructor TDemoThread.Create( CreateSuspended : Boolean; ExecType : TThreadExecType );
begin
FEventCS := TCriticalSection.Create;
FEventCS.Enter;
try
inherited Create( CreateSuspended );
FExecType := ExecType;
FreeOnTerminate := True;
finally
FEventCS.Leave;
end;
end;
destructor TDemoThread.Destroy;
begin
FEventCS.Enter;
try
inherited;
finally
FEventCS.Leave;
FreeAndNil( FEventCS );
end;
end;
procedure TDemoThread.Execute;
var
idx : Integer;
Info :
string;
begin
Sleep( 25 );
{ Thread-Code hier einfügen }
for idx := 0
to 10
do
begin
Info := '
Ich bin bei ' + IntToStr( idx );
case FExecType
of
tetSlowSync :
CallSlowSyncEvent( Info );
tetFastSync :
CallFastSyncEvent( Info );
tetQueue :
CallQueueEvent( Info );
end;
end;
// Wenn dieser "Slow"-Sync nicht gemacht wird, kann es sein,
// dass einige Nachrichten über die Queue verloren gehen!!!!
case FExecType
of
tetSlowSync: CallSlowSyncEvent( '
Fettich!' );
tetFastSync: CallFastSyncEvent( '
Fettich!' );
tetQueue: CallSlowSyncEvent( '
Fettich! (Queue)' );
end;
end;
function TDemoThread.GetOnInfoEvent : TNotifyInfoEvent;
begin
FEventCS.Enter;
try
Result := FOnInfoEvent;
finally
FEventCS.Leave;
end;
end;
procedure TDemoThread.SetOnInfoEvent(
const Value : TNotifyInfoEvent );
begin
FEventCS.Enter;
try
FOnInfoEvent := Value;
finally
FEventCS.Leave;
end;
end;
end.