Einzelnen Beitrag anzeigen

Benutzerbild von haentschman
haentschman

Registriert seit: 24. Okt 2006
Ort: Seifhennersdorf / Sachsen
5.297 Beiträge
 
Delphi 12 Athens
 
#9

AW: Mutithreading: Konsolenausgabe hakt

  Alt 5. Apr 2017, 11:28
Moin...
Warum verpaßt du dem Thread nicht ein Event mit den "Arbeitsdaten".

...ungetestet:
Delphi-Quellcode:
unit Unit1;

interface

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

type
  TWorkEvent = procedure(Sender: TObject; WorkStep: Integer);

  TPoll = class(TThread)
  private
    FStep: Integer;
    FOnWork: TWorkEvent;
    procedure SyncWork;
  protected
    constructor Create;
    property OnWork: TOnWorkEvent read FOnWork write FOnWork;
    procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FPoll: TPoll;
    procedure DoOnWork(Sender: TObject; WorkStep: Integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TPoll.Create;
begin
  inherited Create(True);
  Suspended := False;
  FreeOnTerminate := True;
  FStep := 0;
end;

procedure TPoll.Execute;
begin
  repeat
    sleep(500);
    Synchronize(SyncWork);
    // weitere Steps
  until terminated;
end;

procedure TPoll.SyncWork;
begin
  if Assigned(FOnWork) then
  begin
    FOnWork(Self, FStep);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FPoll := TPoll.Create;
  FPoll.OnWork := DoOnWork;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FPoll.Free;
end;

procedure TForm1.DoOnWork(Sender: TObject; WorkStep: Integer);
begin
  writeln('data packet ', WorkStep);
end;

end.
  Mit Zitat antworten Zitat