Einzelnen Beitrag anzeigen

Ykcim

Registriert seit: 29. Dez 2006
Ort: NRW
804 Beiträge
 
Delphi 10.4 Sydney
 
#18

AW: Erste Schritte Multi-Threading

  Alt 28. Nov 2023, 14:38
Hallo Zusammen,

das ganze Thema ist für mich dünnes Eis, daher habe ich mich seit Wochen schwergetan, es umzusetzen. Diese Lösung scheint zu arbeiten, aber möglicherweise sagt Ihr mir gleich, wo ich "einbrechen" werde...
Ich habe es jetzt ohne Events und Callbacks realisiert und der Sync-Procedure eine Procedure aus dem MainForm gegeben...

In der Thread-Unit habe ich einen Typen definiert und der Threadklasse TMyThread_Uhr eine Variable und eine Property:
Delphi-Quellcode:
type

   TWriteClockValue = procedure (TimeValue: TTime) of Object;

   TMyThread_Uhr = class(TThread)
      private
         fWriteClockValue: TWriteClockValue;
      public
         procedure Execute; override;
         property WriteClockValue: TWriteClockValue read fWriteClockValue write fWriteClockValue;
   end;
Die Synchronisierung habe ich dann so vorgenommen:
Delphi-Quellcode:
procedure TMyThread_Uhr.Execute;
var I: integer;
      sUhr: integer;
      O: TObject;
      T: TTime;
begin
   sUhr := 1000;
   while not Terminated do begin
      sleep(sUhr);
      Synchronize(procedure
                  begin
                     if Assigned(fWriteClockValue) then
                        fWriteClockValue(Now());
                  end);
   end;
end;
In der aufrufenden Form sieht das dann so aus:
Delphi-Quellcode:
procedure TfrmMain.FormShow(Sender: TObject);
begin
   MyThread.TH_Uhr_Start(True);
   MyThread.TH_Uhr.WriteClockValue := Write_Uhr;
   MyThread.TH_Uhr.Resume;
end;
Die Procedure Write_Uhr ist ein dem Formular so definiert:
Delphi-Quellcode:
procedure TfrmMain.Write_Uhr(Zeit: TTime);
begin
   lbl_Zeit.Caption := TimeToStr(Zeit);
   lbl_Zeit.Refresh;
end;

Ich erstelle den Thread, pausiere ihn, weise die Procedure Write_Uhr aus der Form der Variablen in dem Thread zu und lasse den Thread dann laufen.

Das scheint so zu funktionieren. Ist das eine anständige Lösung?

Hier der gesamte Code der kleinen Test-App

Meine Thread-Unit
Delphi-Quellcode:
unit TMyThreadUnit;

interface

uses Windows, Messages, SysUtils, Classes;

type

   TWriteClockValue = procedure (TimeValue: TTime) of Object;
   TWriteTHEinsValue = procedure (THValue: integer) of Object;
   TWriteTHZweiValue = procedure (THValue: integer) of Object;

   TMyThread_Eins = class(TThread)
      private
         fWriteTHEinsValue: TWriteTHEinsValue;
      public
         procedure Execute; override;
         property WriteTHEinsValue: TWriteTHEinsValue read fWriteTHEinsValue write fWriteTHEinsValue;
   end;

   TMyThread_Zwei = class(TThread)
      private
         fWriteTHZweiValue: TWriteTHZweiValue;
      public
         procedure Execute; override;
         property WriteTHZweiValue: TWriteTHZweiValue read fWriteTHZweiValue write fWriteTHZweiValue;
   end;

   TMyThread_Uhr = class(TThread)
      private
         fWriteClockValue: TWriteClockValue;
      public
         procedure Execute; override;
         property WriteClockValue: TWriteClockValue read fWriteClockValue write fWriteClockValue;
   end;

   TMyThreads = class
      strict protected

      private
         fTH_Eins: TMyThread_Eins;
         fTH_Zwei: TMyThread_Zwei;
         fTH_Uhr : TMyThread_Uhr;

      public
         constructor Create;
         property TH_Eins: TMyThread_Eins read fTH_Eins write fTH_Eins;
         property TH_Zwei: TMyThread_Zwei read fTH_Zwei write fTH_Zwei;
         property TH_Uhr : TMyThread_Uhr read fTH_Uhr write fTH_Uhr;
         procedure TH_Eins_Start(breaked: boolean);
         procedure TH_Eins_Break;
         procedure TH_Eins_Resume;
         procedure TH_Eins_Stop;
         procedure TH_Zwei_Start (breaked: boolean);
         procedure TH_Zwei_Break;
         procedure TH_Zwei_Resume;
         procedure TH_Zwei_Stop;
         procedure TH_Uhr_Start (breaked: boolean);
         procedure TH_Uhr_Stop;
   end;

var MyThreads: TMyThreads;

implementation

{ TMyThreads }

constructor TMyThreads.Create;
begin

end;

//TH_Eins
procedure TMyThreads.TH_Eins_Start(breaked: boolean);
begin
   fTH_Eins := TMyThread_Eins.Create(breaked);
end;

procedure TMyThreads.TH_Eins_Break;
begin
   if not fTH_Eins.Terminated then begin
      fTH_Eins.Suspend;
   end;
end;

procedure TMyThreads.TH_Eins_Resume;
begin
   if not fTH_Eins.Terminated then begin
      fTH_Eins.Resume;
   end;
end;

procedure TMyThreads.TH_Eins_Stop;
begin
   if assigned(fTH_Eins) then begin
      if not fTH_Eins.Terminated then begin
         fTH_Eins.Terminate;
      end;
   end;
end;

//TH_Zwei
procedure TMyThreads.TH_Zwei_Start(breaked: boolean);
begin
   fTH_Zwei := TMyThread_Zwei.Create(breaked);
end;

procedure TMyThreads.TH_Zwei_Break;
begin
   if not fTH_Zwei.Terminated then begin
      fTH_Zwei.Suspend;
   end;
end;

procedure TMyThreads.TH_Zwei_Resume;
begin
   if not fTH_Zwei.Terminated then begin
      fTH_Zwei.Resume;
   end;
end;

procedure TMyThreads.TH_Zwei_Stop;
begin
   if assigned(fTH_Zwei) then begin
      if not fTH_Zwei.Terminated then begin
         fTH_Zwei.Terminate;
      end;
   end;
end;

//Uhr
procedure TMyThreads.TH_Uhr_Start(breaked: boolean);
begin
   fTH_Uhr := TMyThread_Uhr.Create(breaked);
end;

procedure TMyThreads.TH_Uhr_Stop;
begin
   if assigned(fTH_Uhr) then begin
      if not fTH_Uhr.Terminated then begin
         fTH_Uhr.Terminate;
      end;
   end;
end;

{ TMyTread_Eins }

procedure TMyThread_Eins.Execute;
var I: integer;
      sEins: integer;
      c_Eins: integer;
begin
   sEins := 1000;
   c_Eins := 0;
   Synchronize(procedure
               begin
                  if Assigned(fWriteTHEinsValue) then
                     fWriteTHEinsValue(c_Eins);
               end);
   for I := 0 to 19 do begin
      if Terminated then begin
         Self.Free;
         Break;
      end;
      sleep(sEins);
      INC(c_Eins);
      if Terminated then begin
         Self.Free;
         Break;
      end;
      Synchronize(procedure
                  begin
                     if Assigned(fWriteTHEinsValue) then
                        fWriteTHEinsValue(c_Eins);
                  end);
   end;
end;

{ TMyThread_Zwei }

procedure TMyThread_Zwei.Execute;
var I: integer;
      sZwei: integer;
      c_Zwei: integer;
begin
   sZwei := 1000;
   c_Zwei := 0;
   Synchronize(procedure
               begin
                  if Assigned(fWriteTHZweiValue) then
                     fWriteTHZweiValue(c_Zwei);
               end);
   for I := 0 to 19 do begin
      if Terminated then begin
         Self.Free;
         Break;
      end;
      sleep(sZwei);
      INC(c_Zwei);
      if Terminated then begin
         Self.Free;
         Break;
      end;
      Synchronize(procedure
               begin
                  if Assigned(fWriteTHZweiValue) then
                     fWriteTHZweiValue(c_Zwei);
               end);
   end;
end;

{ TMyThread_Uhr }

procedure TMyThread_Uhr.Execute;
var I: integer;
      sUhr: integer;
      O: TObject;
      T: TTime;
begin
   sUhr := 1000;
   while not Terminated do begin
      sleep(sUhr);
      Synchronize(procedure
                  begin
                     if Assigned(fWriteClockValue) then
                        fWriteClockValue(Now());
                  end);
   end;
end;

end.
Meine aufrufendes Formular
Delphi-Quellcode:
unit Frm_Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, TMyThreadUnit;

type
   TfrmMain = class(TForm)
      lbl_eins: TLabel;
      lbl_zwei: TLabel;
      btn_eins: TButton;
      btn_zwei: TButton;
      lbl_Zeit: TLabel;
      Timer1: TTimer;
      Timer_Eins_Start: TButton;
      Timer_Zwei_Start: TButton;
      Timer_Eins_Pause: TButton;
      Timer_Zwei_Pause: TButton;
      Timer_Eins_Resume: TButton;
      Timer_Zwei_Resume: TButton;
      Timer_Eins_Stop: TButton;
      Timer_Zwei_Stop: TButton;
      btn_EinsZwei: TButton;
      pnl_MultiThreads: TPanel;
      pnl_MainThread: TPanel;
      pnl_Results: TPanel;
      procedure btn_einsClick(Sender: TObject);
      procedure btn_zweiClick(Sender: TObject);
      procedure Timer1Timer(Sender: TObject);
      procedure Timer_Eins_StartClick(Sender: TObject);
      procedure Timer_Eins_PauseClick(Sender: TObject);
      procedure Timer_Eins_ResumeClick(Sender: TObject);
      procedure Timer_Eins_StopClick(Sender: TObject);
      procedure Timer_Zwei_StartClick(Sender: TObject);
      procedure Timer_Zwei_PauseClick(Sender: TObject);
      procedure Timer_Zwei_ResumeClick(Sender: TObject);
      procedure Timer_Zwei_StopClick(Sender: TObject);
      procedure btn_EinsZweiClick(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure FormCreate(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
   private
      { Private-Deklarationen }
      MyThread: TMyThreads;
   public
      { Public-Deklarationen }
      //Alles im Main-Thread
      procedure Timer_Eins;
      procedure Timer_Zwei;
      //Wird vom MyThread aufgerufen
      procedure Write_Counter_Eins(Counter_Eins: integer);
      procedure Write_Counter_Zwei (Counter_Zwei: integer);
      procedure Write_Uhr (Zeit: TTime);
   end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

//Alles im MainThread
procedure TfrmMain.Timer_Eins;
var I: integer;
      sEins: integer;
      c_Eins: integer;
begin
   sEins := 1000;
   c_Eins := 0;
   lbl_eins.Caption := IntToStr(c_Eins);
   lbl_eins.Refresh;
   for I := 0 to 9 do begin
      sleep(sEins);
      INC(c_Eins);
      lbl_eins.Caption := IntToStr(c_Eins);
      lbl_eins.Refresh;
   end;
end;

procedure TfrmMain.Timer_Zwei;
var I: integer;
      sZwei: integer;
      c_Zwei: integer;
begin
   sZwei := 1000;
   c_Zwei := 0;
   lbl_zwei.Caption := IntToStr(c_Zwei);
   lbl_zwei.Refresh;
   for I := 0 to 9 do begin
      sleep(sZwei);
      INC(c_Zwei);
      lbl_zwei.Caption := IntToStr(c_Zwei);
      lbl_zwei.Refresh;
   end;
end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
   //lbl_Zeit.Caption := TimeToStr(now());
end;

//OnCreate, OnShow, OnDestroy Proceduren
procedure TfrmMain.FormCreate(Sender: TObject);
begin
   MyThread := TMyThreads.Create;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
   MyThread.TH_Uhr_Start(True);
   MyThread.TH_Uhr.WriteClockValue := Write_Uhr;
   MyThread.TH_Uhr.Resume;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
   MyThread.TH_Uhr_Stop;
   MyThread.TH_Eins_Stop;
   MyThread.TH_Zwei_Stop;
   MyThread.Free;
end;

//ClickProceduren
//Im MainThread
procedure TfrmMain.btn_einsClick(Sender: TObject);
begin
   Timer_Eins;
end;

procedure TfrmMain.btn_zweiClick(Sender: TObject);
begin
   Timer_Zwei;
end;

procedure TfrmMain.btn_EinsZweiClick(Sender: TObject);
begin
   MyThread.TH_Eins_Start(true);
   MyThread.TH_Eins.WriteTHEinsValue := Write_Counter_Eins;
   MyThread.TH_Eins.Resume;

   MyThread.TH_Zwei_Start(true);
   MyThread.TH_Zwei.WriteTHZweiValue := Write_Counter_Zwei;
   MyThread.TH_Zwei.Resume;
end;

//MultiThreads
//TH_Eins Ckick
procedure TfrmMain.Timer_Eins_StartClick(Sender: TObject);
begin
   MyThread.TH_Eins_Start(true);
   MyThread.TH_Eins.WriteTHEinsValue := Write_Counter_Eins;
   MyThread.TH_Eins.Resume;
end;

procedure TfrmMain.Timer_Eins_PauseClick(Sender: TObject);
begin
   MyThread.TH_Eins_Break;
end;

procedure TfrmMain.Timer_Eins_ResumeClick(Sender: TObject);
begin
   MyThread.TH_Eins_Resume;
end;

procedure TfrmMain.Timer_Eins_StopClick(Sender: TObject);
begin
   MyThread.TH_Eins_Stop;
end;
//TH_Zwei Click
procedure TfrmMain.Timer_Zwei_StartClick(Sender: TObject);
begin
   MyThread.TH_Zwei_Start(true);
   MyThread.TH_Zwei.WriteTHZweiValue := Write_Counter_Zwei;
   MyThread.TH_Zwei.Resume;
end;

procedure TfrmMain.Timer_Zwei_PauseClick(Sender: TObject);
begin
   MyThread.TH_Zwei_Break;
end;

procedure TfrmMain.Timer_Zwei_ResumeClick(Sender: TObject);
begin
   MyThread.TH_Zwei_Resume;
end;

procedure TfrmMain.Timer_Zwei_StopClick(Sender: TObject);
begin
   MyThread.TH_Zwei_Stop;
end;

//Schreibproceduren
procedure TfrmMain.Write_Counter_Eins(Counter_Eins: integer);
begin
   lbl_eins.Caption := IntToStr(Counter_Eins);
   lbl_eins.Refresh;
end;

procedure TfrmMain.Write_Counter_Zwei(Counter_Zwei: integer);
begin
   lbl_zwei.Caption := IntToStr(Counter_Zwei);
   lbl_zwei.Refresh;
end;

procedure TfrmMain.Write_Uhr(Zeit: TTime);
begin
   lbl_Zeit.Caption := TimeToStr(Zeit);
   lbl_Zeit.Refresh;
end;

end.
Patrick
  Mit Zitat antworten Zitat