unit MessThread;
interface
uses Windows, SysUtils, Classes, SyncObjs;
Type TOnMessWertListcompleted =
procedure(Sender: TObject; List: TstringList)
of Object;
Type TMessThread =
class(TThread)
private
FsLMesswertreihe: TStringList;
FiMessAnzahl, FiMessreihe: integer;
FCriticalSection: TCriticalSection;
FOnMessWertListcompleted: TOnMessWertListcompleted;
protected
// Ausführung
procedure Execute;
override;
// Setter und Getter
function GetMessreihe: integer;
procedure SetMessreihe(iWert: integer);
function GetMessanzahl: integer;
procedure SetMessanzahl(iWert: integer);
// Eventhandling
procedure DoSendDatapacket;
public
// Initialisierung und Terminierung
constructor create;
reintroduce;
destructor destroy;
override;
property MesswertList: TStringList
read FsLMesswertreihe;
property OnMessWertListcompleted: TOnMessWertListcompleted
read FOnMessWertListcompleted
write FOnMessWertListcompleted;
property Messreihe: integer
read GetMessreihe
write SetMessreihe;
property Messanzahl: integer
read GetMessanzahl
write SetMessanzahl;
// Events
end;
implementation
uses ControlerBoardForm;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Funktionen für Komunikationsaufbau bzw. -terminierung und /}
{/ und Statusüberprüfung /}
{////////////////////////////////////////////////////////////////////////////////////}
constructor TMessThread.create;
begin
inherited create(false);
FsLMesswertreihe := TStringList.create;
FOnMessWertListcompleted :=
nil;
FiMessAnzahl := 7;
FiMessreihe := 5;
end;
destructor TMessThread.Destroy;
begin
FsLMesswertreihe.Free;
inherited destroy;
end;
procedure TMessThread.Execute;
var c, i: integer;
begin
repeat
c := GetTickcount;
FsLMesswertreihe.Add(floattostr(Board.anaEingang[1]));
if FsLMesswertreihe.Count >= (FiMessAnzahl * FiMessreihe)
then DoSendDataPacket;
c :=
{interval}30 - (GetTickCount - c);
if c > 0
then Sleep(c);
until Terminated;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Eventhandling /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TMessthread.DoSendDatapacket;
begin
if assigned(FOnMessWertListcompleted)
then FOnMessWertListcompleted(Self, FsLMesswertreihe);
FsLMesswertreihe.Clear;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Setter und Getter /}
{////////////////////////////////////////////////////////////////////////////////////}
procedure TMessthread.SetMessreihe(iWert: Integer);
begin
FiMessreihe := iWert;
end;
procedure TMessthread.SetMessanzahl(iWert: Integer);
begin
FiMessanzahl := iWert;
end;
function TMessthread.GetMessreihe;
begin
result := FiMessreihe;
end;
function TMessthread.GetMessanzahl;
begin
result := FiMessanzahl;
end;
end.
// Hier noch der Aufruf des Threads im Programm:
procedure TForm4.Button1Click(Sender: TObject);
begin
if assigned(FMessThread)
then
begin
FMessthread.Free;
if assigned(SendList.FsLMesswertListe)
then SendList.FsLMesswertListe.Free;
end
else
begin
FMessThread := TMessThread.create;
try
FMessThread.OnMessWertListcompleted := GetMessWertList;
SendList.FsLMesswertListe := TStringList.Create;
try
SendList.Messwertreihen := FMessThread.Messreihe;
SendList.Messwertanzahl := FMessThread.Messanzahl;
except
SendList.FsLMesswertListe.Free;
end;
except
FMessThread.Free;
end;
end;
end;