Einzelnen Beitrag anzeigen

Fritzew

Registriert seit: 18. Nov 2015
Ort: Kehl
678 Beiträge
 
Delphi 11 Alexandria
 
#15

AW: Result als mehrdimensoiertes array im Thread

  Alt 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
  Mit Zitat antworten Zitat