Thema: TTask Frage

Einzelnen Beitrag anzeigen

DaCoda

Registriert seit: 21. Jul 2006
Ort: Hamburg
75 Beiträge
 
Delphi 12 Athens
 
#8

AW: TTask Frage

  Alt 26. Mai 2021, 12:04
Hallo,
ich komme irgendwie nicht so klar mit TTask/TThread.
Meine Probleme sind:
1. ReadOpcData soll in einen Thread, damit mein Mainprogramm weiter läuft.
2. Wenn ich dann die Maschinen freigebe (Mainprogramm wird beendet) müssen die Tasks/bzw. Threads dann sauber beendet werden.

Ich lande aber irgendwie immer wieder im Chaos (Exceptions, MemoryLeaks etc.) Vielleicht hat ja jemand einen guten Tip, wie ich das am besten Lösen kann...

Die TMaschine ist so definiert:

Code:
unit Kommunikation;

interface
uses
  Globals,
  DataModul,
  tbUtils,
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  System.Threading,
  Vcl.Controls,
  Vcl.ExtCtrls,
  Vcl.Forms;

type
  TMaschinenDaten = record
    MaschineOnline: Boolean;

  end;

  TOnDataEvent = procedure(Sender: TObject; Value: TMaschinendaten) of object;

  TMaschine = class(TObject)
  private
    FOwner: TComponent;
    FHostIP: WideString;
    FActive: Boolean;
    PollTimer: TTimer;
    FOpcTask: ITask;
    FOnData: TOnDataEvent;
    FOnTaskStart: TNotifyEvent;
    FOnTaskReady: TNotifyEvent;
    FInterval: Cardinal;
    FMaschinenID: Integer;
    FMaschinenName: WideString;
    FMaschinendaten: TMaschinendaten;

    procedure SetHostIp(Value: WideString);
    procedure SetActive(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure ReadOpcData;
    procedure OnPollTimer(Sender: TObject);
    procedure OnOpcData(Sender: TObject; Value: TMaschinendaten);
    procedure OnOpcTaskStart(Sender: TObject);
    procedure OnOpcTaskReady(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); virtual;
    destructor Destroy; override;

    property HostIP: WideString read FHostIp write SetHostIp;
    property Active: Boolean read FActive write SetActive;
    property OnData: TOnDataEvent read FOnData write FOnData;
    property OnTaskStart: TNotifyEvent read FOnTaskStart write FOnTaskStart;
    property OnTaskReady: TNotifyEvent read FOnTaskReady write FOnTaskReady;
    property PollInterval: Cardinal read FInterval write SetInterval;
    property MaschinenID: Integer read FMaschinenID write FMaschinenID;
    property MaschinenName: WideString read FMaschinenName write FMaschinenName;
  end;

implementation


(*** TMaschine *********************************************************************************************************************************************************************)

constructor TMaschine.Create(AOwner: TComponent);
begin
  FOwner := AOwner;
  PollTimer := TTimer.Create(FOwner);
  PollTimer.Interval := FInterval;
  PollTimer.OnTimer := OnPollTimer;
  PollTimer.Enabled := False;
end;

destructor TMaschine.Destroy;
begin
  PollTimer.Enabled := False;
  Active := False;
  inherited;
end;

procedure TMaschine.SetInterval(Value: Cardinal);
begin
  FInterval := Value;
  PollTimer.Interval := Value;
end;

procedure TMaschine.OnPollTimer(Sender: TObject);
begin
  ReadOpcData;
end;

procedure TMaschine.SetHostIp(Value: WideString);
begin
  FHostIp := Value;

end;

procedure TMaschine.SetActive(Value: Boolean);
begin
  FActive := Value;
  PollTimer.Enabled := Value;
end;

procedure TMaschine.ReadOpcData;
var
  FirstTickCount: DWord;
begin
  if FActive then begin
    PollTimer.Enabled := False;
    OnOpcTaskStart(Self);
    FOpcTask := TTask.Create(procedure begin

    {*** HIER WERDEN DIE OPC-DATEN DANN GELESEN DIES IST NUR EINE DUMMYROUTINE UM ZEIT ZU VERBRAUCHEN ***}

      FirstTickCount := GetTickCount;
      while ((GetTickCount - FirstTickCount) < 1000) do begin
        Application.ProcessMessages;
        if Application.Terminated then
          Exit;
      end;

    {****************************************************************************************************}

     end);
     FOpcTask.Start;

    OnOpcTaskReady(Self);
    OnOpcData(Self, FMaschinendaten);
    PollTimer.Enabled := True;
  end;
end;

procedure TMaschine.OnOpcTaskStart(Sender: TObject);
begin
  if Assigned(FOnTaskStart) then
    FOnTaskStart(Self);
end;

procedure TMaschine.OnOpcTaskReady(Sender: TObject);
begin
  if Assigned(FOnTaskReady) then
    FOnTaskReady(Self);
end;

procedure TMaschine.OnOpcData(Sender: TObject; Value: TMaschinendaten);
begin
  if Assigned(FOndata) then
    FOnData(Self, FMaschinendaten);
end;

(**********************************************************************************************************************************************************************************)

end.
Mein Hauptprogramm ist in etwa das:

Code:
procedure TfrmMain.FormShow(Sender: TObject);
var
  Loop: Integer;
begin
  SetLength(Maschinen, 10);     //   <- z.B. 10 Maschinen...
  SetLength(Maschinendaten, 10);

  for Loop := Low(Maschinen) to High(Maschinen) do begin
    Maschinen[Loop] := TMaschine.Create(Self);
    try
      Maschinen[Loop].MaschinenID := Loop + 1;
      Maschinen[Loop].OnData := OnOpcData;
      Maschinen[Loop].OnTaskStart := OnTaskStart;
      Maschinen[Loop].OnTaskReady := OnTaskReady;
      Maschinen[Loop].PollInterval := 1000;
      Maschinen[Loop].HostIP := slMaschinenIp.Strings[Loop];
      Maschinen[Loop].MaschinenName := slMaschinenName.Strings[Loop];
      Maschinen[Loop].Active := True;
    except
      // TODO
    end;
  end;

end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
var
  Loop: Integer;
begin
  if High(Maschinen) > -1 then begin
    for Loop := Low(Maschinen) to High(Maschinen) do begin
      if Assigned(Maschinen[Loop]) then begin
        Maschinen[Loop].Active := False;
        FreeAndNil(Maschinen[Loop]);
      end;
    end;
  end;

  CanClose := True;
end;

procedure TfrmMain.OnOpcData(Sender: TObject; Value: TMaschinendaten);
begin
  MaschinenDaten[(Sender as TMaschine).MaschinenID] := Value;
end;

procedure TfrmMAin.OnTaskStart(Sender: TObject);
begin
  // TODO
end;

procedure TfrmMain.OnTaskReady(Sender: TObject);
begin
  //  TODO
end;
Debuggers don’t remove bugs, they only show them in slow-motion.

Geändert von DaCoda (26. Mai 2021 um 14:40 Uhr)
  Mit Zitat antworten Zitat