Registriert seit: 18. Nov 2015
Ort: Kehl
678 Beiträge
Delphi 11 Alexandria
|
AW: Result als mehrdimensoiertes array im Thread
4. Jan 2017, 13:16
Also ich würde das in etwa so umsetzen:
Delphi-Quellcode:
unit newLwThread;
interface
uses
Windows,
Classes,
SysUtils,
Syncobjs;
type
tarray = array [1 .. 4] of array of Boolean;
TnewLwThread = class(TThread)
private
FEvent: TEvent;
fFileList: array [1 .. 4] of TStringList;
fisfilea: tarray; // array[1..4] of array of Boolean;
fIsFileIndex: Integer;
fIsListIndex: Integer;
fLock: array [1 .. 4] of Tcriticalsection;
procedure setFileList( index: Integer; const Value: TStringList);
function Getfile: tarray;
protected
procedure Execute; override;
public
constructor Create;
destructor Destroy; override;
procedure ContinueWork;
procedure Terminate;
property Titel[ index: Integer]: TStringList write setFileList;
property isfile: tarray read Getfile;
end;
implementation
{ TnewLwThread }
constructor TnewLwThread.Create;
var
i: Integer;
begin
inherited Create(true);
FEvent := TEvent.Create( nil, false, false, ' ');
for i := 1 to 4 do
begin
fFileList[i] := TStringList.Create;
fLock[i] := Tcriticalsection.Create;
end;
FreeonTerminate := false;
end;
destructor TnewLwThread.Destroy;
var
i: Integer;
begin
ContinueWork;
if not Terminated then
begin
Terminate;
ContinueWork;
WaitFor;
end;
for i := 1 to 4 do
begin
fFileList[i].Free;
fLock[i].Free;
SetLength(fisfilea[i], 0);
end;
FEvent.Free;
inherited;
end;
procedure TnewLwThread.ContinueWork;
begin
(* Event auf Signaled setzen *)
FEvent.SetEvent;
end;
procedure TnewLwThread.setFileList( index: Integer; const Value: TStringList);
begin
if index in [1 .. 4] then
begin
fLock[ index].Enter;
fFileList[ index].Clear;
fFileList[ index].Assign(Value);
SetLength(fisfilea[ index], fFileList[ index].Count);
fLock[ index].Leave;
end;
end;
procedure TnewLwThread.Execute;
var
i, x: Integer;
begin
while not Terminated do
begin
if (FEvent.WaitFor(INFINITE) = wrSignaled) and not Terminated then
begin
// checkfile;
for i := 1 to 4 do
begin
fLock[i].Enter;
try
if fFileList[i].Count > 0 then
begin
for x := 0 to fFileList[i].Count - 1 do
begin
if FileExists(fFileList[i].Strings[x]) then
if not fisfilea[i][x] then
fisfilea[i][x] := true
else if fisfilea[i][x] then
fisfilea[i][x] := false;
end;
end;
// getfile;
finally
fLock[i].Leave;
end;
end;
end;
end;
end;
procedure TnewLwThread.Terminate;
begin
inherited Terminate;
FEvent.SetEvent;
end;
function TnewLwThread.Getfile: tarray;
var
i, j: Integer;
begin
for i := 1 to 4 do
begin
fLock[i].Enter;
try
SetLength(result[i], length(fisfilea[i]));
for j := 0 to length(fisfilea[i]) - 1 do
result[i, j] := fisfilea[i, j];
finally
fLock[i].Leave;
end;
end;
end;
end.
Fritz Westermann
|
|
Zitat
|