procedure TControlCardControlThread.Execute;
var c, iIndex: integer;
begin
for iIndex := 1
to 5
do (Form3.findcomponent('
CheckBox' + inttostr(iIndex+8))
as TCheckBox).Checked:= fabDigChannelSignals[iIndex];
repeat
c := GetTickCount;
Synchronize(UpdateForm3);
c :=
{interval}50 - (GetTickCount - c);
if c > 0
then Sleep(c);
until Terminated;
if assigned(FsLComport)
then FsLComport.Free;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Interaktion mit Oberfläche /}
{////////////////////////////////////////////////////////////////////////////////////}
// bei dieser Form sollte festgestellt werden, ob sich irgendwas verändert hat und
// nur bei vorhandenen Änderungen sollte auch Refreshed werden. Ständiges neuzeichnen
// führt zum ausbremsen des TThreads!
procedure TControlCardControlThread.UpdateForm3;
var i: integer;
bGeneralDigChannelInput, bCriticalDigChannelInput, bUpdateDataForm1, bUpdateDataForm3: boolean;
begin
bUpdateDataForm1 := ComportSearch(FsLComport);
bUpdateDataForm3 := false;
bgeneralDigChannelInput := false;
bcriticalDigChannelInput := false;
for i := 1
to 5
do
begin
case not(FabDigChannelSignals[i]
xor Board.digEingang[i])
of
false:
begin
bUpdateDataForm3 := true;
DoSingleDigChannelInput(i);
bGeneralDigChannelInput := true;
if i
in [2..4]
then bcriticalDigChannelInput := true;
FabDigChannelSignals[i] := Board.digEingang[i];
(Form3.findcomponent('
CheckBox' + inttostr(i+8))
as TCheckBox).Checked:= fabDigChannelSignals[i];
end;
end;
if (i
in [1..2])
and ((Form3.findcomponent('
ProgressBar' + inttostr(i))
as TProgressBar).Position <> Board.anaEingang[i])
then
begin
(Form3.findcomponent('
ProgressBar' + inttostr(i))
as TProgressBar).Position := Board.anaEingang[i];
bUpdateDataForm3 := true;
end;
end;
if bUpdateDataForm3
then Form3.Refresh;
// <-- Änderung nur refresh, wenn Änderung vorhanden sind
if FbBlinkRedLight
then Board.RedLight :=
not Board.RedLight;
if bGeneralDigChannelInput
then doGeneralDigChannelInput;
if bCriticalDigChannelInput
then doCriticalDigChannelInput;
// Hier ebenso Änderungen überprüfen und nur bei vorhandenen Änderungen das neuzeichnen
// auslösen!
if bUpdateDataForm1
then
begin
Form1.Memo1.Clear;
Form1.Memo1.Lines := FsLComport;
Form1.Refresh;
end;
case Counter
of
0: Form3.StatusBar1.Panels[0].Text := '
/';
1: Form3.StatusBar1.Panels[0].Text := '
|';
2: Form3.StatusBar1.Panels[0].Text := '
\';
3: Form3.StatusBar1.Panels[0].Text := '
-';
end;
Counter := Counter + 1;
if Counter > 3
then Counter := 0;
end;
{////////////////////////////////////////////////////////////////////////////////////}
{/ Überwachungsfunktion /}
{////////////////////////////////////////////////////////////////////////////////////}
// In eine Funktion umarbeiten, die true zurückgibt, wenn keine Änderungen vorhanden sind
// oder false wenn Änderungen vorhanden sind.
function TControlCardControlThread.ComportSearch(
var List: TStringList):boolean;
var ComBuffer: TComport;
TempLineArray:
array of Integer;
bLine: boolean;
i, j: integer;
begin
ComBuffer := TComport.Create;
result := false;
try
SetLength(TempLineArray,0);
for i := 0
to ComBuffer.Anzahl - 1
do
begin
j := List.IndexOf(inttostr(ComBuffer.Comportnummer[i]));
case j
of
-1:
begin
result := true;
List.Add(inttostr(ComBuffer.Comportnummer[i]));
// Eintrag ist noch nicht vorhanden -> Eintrag wird hinzugefügt
SetLength(TempLineArray,Length(TempLineArray)+1);
TempLineArray[Length(TempLineArray)-1] := List.IndexOf(inttostr(ComBuffer.Comportnummer[i]));
end;
else
begin
SetLength(TempLineArray,Length(TempLineArray)+1);
TempLineArray[Length(TempLineArray)-1] := j;
end;
end;
end;
//in Temp Linearray sind jetzt alle Zeilen Nummern der StringList enthalten, die
//auch in der Comport-Liste vorhanden sind. Nun müssen die überflüsigen Zeilen nur gelöscht werden
for i := 0
to List.Count -1
do
begin
bLine := false;
for j := 0
to Length(TempLineArray)
do if i= TempLineArray[j]
then bLine := true;
// Zeile ist in TempLineArray vorhanden und soll somit NICHT gelöscht werden!
if not bLine
then
begin
List.Delete(i);
//Wenn die Zeile nich in TEmpLineArray vorhanden ist, muss der Comport geschlossen worden sein und kann somit aus der Liste gelöscht werden.
result := true;
end;
end;
finally
SetLength(TempLineArray,0);
ComBuffer.Free;
end;
end;
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Hier noch die Comport-Klasse:
Type TComport =
class
private
bPorts: boolean;
FsLComports: TStringList;
function ComPort(ComPortNummer: byte): longbool;
function ComportScan: boolean;
function GetComport(
index: integer): integer;
function GetAnzahl: integer;
public
constructor Create;
reintroduce;
destructor destroy;
override;
property verfuegbarePorts: boolean
read bPorts;
property Comportnummer[
Index: integer]: integer
read GetComport;
property Anzahl: integer
read GetAnzahl;
end;
Constructor TComport.Create;
begin
inherited create;
FsLComports := TStringlist.Create;
bPorts := ComportScan;
end;
destructor TComport.Destroy;
begin
FsLComports.Free;
inherited destroy;
end;
function TComport.GetComport(
index: Integer): integer;
begin
result := strtoint(FsLComports[
Index]);
end;
function TComport.GetAnzahl;
begin
result := FsLComports.Count;
end;
// Funktion, die überprüfft, ob an der Comschnittstelle mit der Nummer "ComPortNummer"
// ein Gerät angeschlossen ist (ob eine Kommunikation geöffnet ist) oder nicht.
function TComport.ComPort(ComPortNummer: byte): longbool;
var TestHandle : integer;
begin TestHandle :=CreateFile(PChar('
\\.\COM'+IntToStr(ComPortNummer)),GENERIC_READ
or GENERIC_WRITE,0,
nil,OPEN_EXISTING,FILE_FLAG_OVERLAPPED,LongInt(0));
if (TestHandle <= 0)
then Result := false
else begin Result := true; CloseHandle(TestHandle);
end;
end;
// Funktion, die alle ComPorts bis zu einer vom Programmierer festgelegten maximal
// ComPortnummer anspricht.
function TComport.ComportScan: boolean;
var i: integer;
aBuffer:
array of Integer;
begin
for i := 0
to 20
do if ComPort(i)
then FsLComports.Add(inttostr(i));
if FsLComports.Count = 0
then result := false
else result := true;
end;