|
![]() |
|
Registriert seit: 29. Dez 2006 Ort: NRW 856 Beiträge Delphi 12 Athens |
#1
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:
Die Synchronisierung habe ich dann so vorgenommen:
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;
Delphi-Quellcode:
In der aufrufenden Form sieht das dann so aus:
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;
Delphi-Quellcode:
Die Procedure Write_Uhr ist ein dem Formular so definiert:
procedure TfrmMain.FormShow(Sender: TObject);
begin MyThread.TH_Uhr_Start(True); MyThread.TH_Uhr.WriteClockValue := Write_Uhr; MyThread.TH_Uhr.Resume; end;
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:
Meine aufrufendes Formular
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.
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
|
![]() |
Registriert seit: 8. Mär 2006 Ort: Jüterbog 498 Beiträge Delphi 12 Athens |
#2
Ohne mir das alles genauer angeschaut zu haben, würde ich im
Delphi-Quellcode:
das Self.Free entfernen.
for I := 0 to 19 do begin
if Terminated then begin Self.Free; Break; end; Wenn du erreichen willst, das sich der Thread selbst frei gibt, dann verwende FreeOnTerminate := True; |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |