ich empfehle mal folgendes:
http://www.eonclash.com/Tutorials/Mu...ey1.1/ToC.html
http://www.delphipraxis.net/114195-t...huetzen-2.html
http://docwiki.embarcadero.com/CodeE...t_%28Delphi%29

Hatt ja eigentlich nichts mehr mit dem Thema zu tun, aber ich habe jetzt auf Queue umgestellt:

http://www.delphi3000.com/articles/article_3869.asp

Jeder Thread hat nun seine eigene MessageQueue.
Nix mehr mit PostThreadMessage! Läuft schneller und besser!

zusammenfalten · markieren

Delphi-Quellcode:

unit ThreadUtilities;

interface

uses
  Windows, SysUtils, Classes;

type
  TQueueTypes = (
    _TIMER_FINISHED,
    _STOP,
    _START,
    _RESTART
    );

type
  TQueueMessage = record
    Msg : TQueueTypes;
    Value : Integer;
    Data : Pointer;
  end;
  PQueueMessage = ^TQueueMessage;

type
  EThreadStackFinalized = class(Exception);

  // Thread Safe Pointer Queue
  TThreadQueue = class
  private
      FFinalized: Boolean;
      FIOQueue: THandle;
  public
      constructor Create();
      destructor Destroy; override;
      procedure Finalize;
      procedure Put(Data: PQueueMessage);
      procedure CreateMsg(QueueType : TQueueTypes; Data : Pointer = nil; Value : Integer = 0); Overload;
      procedure CreateMsg(QueueType : TQueueTypes; Data : Pointer = nil); Overload;
      procedure CreateMsg(QueueType : TQueueTypes; Value : Integer = 0); Overload;
      function Get(var Data: PQueueMessage): Boolean;
      property Finalized: Boolean read FFinalized;
  end;

implementation

Uses
  uGlobal;

{ TThreadQueue }

constructor TThreadQueue.Create();
begin
  //-- Create IO Completion Queue
  FIOQueue := CreateIOCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
  FFinalized := False;
end;

destructor TThreadQueue.Destroy;
begin
  //-- Destroy Completion Queue
  Finalize;

  if (FIOQueue <> 0) then
      CloseHandle(FIOQueue);
  inherited;
end;

procedure TThreadQueue.Finalize;
begin
  //-- Post a finialize pointer on to the queue
  PostQueuedCompletionStatus(FIOQueue, 0, 0, Pointer($FFFFFFFF));
  FFinalized := True;
end;

(* Pop will return false if the queue is completed *)
function TThreadQueue.Get(var Data: PQueueMessage): Boolean;
var
    A: Cardinal;
    OL: POverLapped;
begin
  Result := True;
  Data := nil;
  if (not FFinalized) then
  //-- Remove/Pop the first pointer from the queue or wait
    //GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, INFINITE);
    GetQueuedCompletionStatus(FIOQueue, A, Cardinal(Data), OL, 0);

  //-- Check if we have finalized the queue for completion
  if FFinalized or (Data = nil) then begin
      Result := False;
      //Finalize;
  end;
end;

procedure TThreadQueue.CreateMsg(QueueType : TQueueTypes; Data : Pointer = nil; Value : Integer = 0);
var
  QueueMessage : PQueueMessage;
begin
  New(QueueMessage);
  QueueMessage^.Msg := QueueType;
  QueueMessage^.Value := Value;
  QueueMessage^.Data := Data;
  Put(QueueMessage);
end;

procedure TThreadQueue.CreateMsg(QueueType : TQueueTypes; Data : Pointer = nil);
var
  QueueMessage : PQueueMessage;
begin
  New(QueueMessage);
  QueueMessage^.Msg := QueueType;
  QueueMessage^.Value := 0;
  QueueMessage^.Data := Data;
  Put(QueueMessage);
end;

procedure TThreadQueue.CreateMsg(QueueType : TQueueTypes; Value : Integer = 0);
var
  QueueMessage : PQueueMessage;
begin
  New(QueueMessage);
  QueueMessage^.Msg := QueueType;
  QueueMessage^.Value := Value;
  QueueMessage^.Data := nil;
  Put(QueueMessage);
end;

procedure TThreadQueue.Put(Data: PQueueMessage);
begin
  if FFinalized then
    Raise EThreadStackFinalized.Create('Stack is finalized');
  //-- Add/Push a pointer on to the end of the queue
  PostQueuedCompletionStatus(FIOQueue, 0, Cardinal(Data), nil);
end;

end.