TThread.Queue landet nicht in der Queue

[Sir Rufo]

Zitat von himitsu:

Das ist ja grade falsch, denn vom Hauptthread aus aufgerufen ist diese Funktion "blockierend", da sie dort erst zurück kehrt, wenn der enthaltene Code abgearbeitet wurde.

Und genau das sollte nicht passieren ... jedenfalls war das so nicht von mir geplant/erhofft.
Hatte halt "erwartet", daß die Funktion auch da genauso ist, wie aus anderen Threads.

Es gibt halt keinen noch mainigeren Thread über dem MainThread. Und sobald sich das im MainThread-Kontext befindet, wird es aufgerufen. Beim Aufruf ist es in dem Kontext, also wird es auch direkt ausgeführt.

Eventuell suchst du ja so was

Delphi-Quellcode:

unit uLater;

interface

uses
  System.Generics.Collections,
  System.SysUtils,
  System.SyncObjs,
  System.Classes;

type
  Later = class
  private type
    TProcItem = record
      Proc : TProc;
      constructor Create( AProc : TProc );
    end;

    TLaterThread = class( TThread )
    private
      FCS : TCriticalSection;
      FEvent : TEvent;
      FQueue : TQueue<TProcItem>;
    private
      function GetProc : TProcItem;
    protected
      procedure Execute; override;
      procedure TerminatedSet; override;
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddProc( AProc : TProc );
    end;
  private
    class var FThread : TLaterThread;
  protected
    class constructor Create;
    class destructor Destroy;
  public
    class procedure Execute( AProc : TProc );
  end;

implementation

{ Later }

class constructor Later.Create;
begin
  FThread := TLaterThread.Create;
end;

class destructor Later.Destroy;
begin
  FThread.Free;
end;

class procedure Later.Execute( AProc : TProc );
begin
  FThread.AddProc( AProc );
end;

{ Later.TLaterThread }

procedure Later.TLaterThread.AddProc( AProc : TProc );
begin
  FCS.Enter;
  try
    FQueue.Enqueue( TProcItem.Create( AProc ) );
    FEvent.SetEvent;
  finally
    FCS.Leave;
  end;
end;

constructor Later.TLaterThread.Create;
begin
  inherited Create( False );
  FCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, True, False, '' );
  FQueue := TQueue<TProcItem>.Create;
end;

destructor Later.TLaterThread.Destroy;
begin
  FCS.Enter;
  try
    FQueue.Free;

    inherited;
    FEvent.Free;
  finally
    FCS.Leave;
    FreeAndNil( FCS );
  end;
end;

procedure Later.TLaterThread.Execute;
var
  LProc : TProcItem;
begin
  inherited;
  while not Terminated do
  begin
    if ( FEvent.WaitFor( INFINITE ) = TWaitResult.wrSignaled ) and not Terminated then
    begin
      LProc := GetProc;
      Queue(
          procedure
        begin
          LProc.Proc( );
        end );
    end;
  end;
end;

function Later.TLaterThread.GetProc : TProcItem;
begin
  FCS.Enter;
  try
    Result := FQueue.Dequeue;
    if FQueue.Count = 0 then
      FEvent.ResetEvent;
  finally
    FCS.Leave;
  end;
end;

procedure Later.TLaterThread.TerminatedSet;
begin
  inherited;
  FEvent.SetEvent;
end;

{ Later.TProcItem }

constructor Later.TProcItem.Create( AProc : TProc );
begin
  Proc := AProc;
end;

end.

Dann kannst du damit

Delphi-Quellcode:

procedure TForm1.Button2Click( Sender : TObject );
begin
  ListBox1.Items.Add( 'first' );

  Later.Execute(
      procedure
    begin
      ListBox1.Items.Add( 'second' );
    end );

  ListBox1.Items.Add( 'third' );
end;

und in der ListBox kommt an

Code:

first
third
second