Einzelnen Beitrag anzeigen

Tryer

Registriert seit: 16. Aug 2003
200 Beiträge
 
#14

Re: Liste (ähnlich dyn Array) mit fortlaufendem Index?

  Alt 25. Mär 2010, 11:00
Speicherst Du entweder die Zeichenkette oder die Realwerte? Die Vermischung finde ich unübersichtlich, aber diesbezügich kannst Du das ganze ja selber anpassen.
"Mal eben", also garantiert nicht fehlerfrei:
Delphi-Quellcode:
type
  POneData = ^TOneData;
  TOneData = record
      Zeichenkette: string;
      Value1: Double;
      Value2: Double;
      Value3: Double;
      Value4: Double;
      _Next: POneData;
    end;

  TDataClass = class
  private
    FEvent: THandle;
    FLock: TRTLCriticalSection;
    FFirst: POneData;
    FLast: POneData;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(Name: string; V1, V2, V3, V4 : Double);
    procedure ExtractFirst: POneData;
    procedure Lock;
    procedure Unlock;
    property NewDataEvent: TEvent read FEvent write FEvent;
  end;

  TWorker = class(TThread)
  private
    FDataClass: TDataClass;
  protected
    procedure Execute; override;
  public
    constructor Create(DataClass: TDataClass);
  end;

implementation

constructor TDataClass.Create;
begin
  inherited Create;
  FFirst := nil;
  FLast := nil;
  FEvent := CreateEvent(nil,True,False,nil);
  InitializeCriticalSection(FLock);
end;

Procedure TDataClass.Add(Name : string; V1, V2, V3, V4 : Double);
var
  NewData: POneData;
begin
  New(NewData);
  NewData^._Next := nil;
  NewData^.Zeichenkette:= Name;
  NewData^.Value1 := V1;
  NewData^.Value2 := V2;
  NewData^.Value3 := V3;
  NewData^.Value4 := V4;
  try
    Lock;
    try
      if Assigned(FLast) then
      begin
        FLast^._Next := NewData;
        FLast := NewData;
      end else
      begin
        FFirst := NewData;
        FLast := FFirst;
      end;
      SetEvent(FEvent);
    finally
      Unlock;
    end;
  except
    Dispose(NewData);
  end;
end;

procedure TDataClass.Lock;
begin
  EnterCriticalSection(FLock);
end;

procedure TDataClass.Unlock;
begin
  LeaveCriticalSection(FLock);
end;

function TDataClass.ExtractFirst: POneData;
begin
  Result := nil;
  Lock;
  try
    ResetEvent(FEvent);
    if Assigned(FFirst) then
    begin
      Result := FFirst;
      FFirst := FFirst^._Next;
    end;
  finally
    Unlock;
  end;
end;

destructor TDataClass.Destroy;
var
  tmp: POneData;
begin
  while FFirst <> nil do
  begin
    tmp := FFirst;
    FFirst := FFirst^._Next;
    Dispose(tmp);
  end;
  CloseHandle(FEvent);
  DeleteCriticalSection(FLock);
  inherited Destroy;
end;

procedure TWorker.Execute;
var
  PData: POneData;
begin
  repeat
    if WaitForSingleObject(FDataClass.NewDataEvent, 100) = WAIT_OBJECT_0 then
    begin
      PData := FDataClass.ExtractFirst;
      if Assigned(PData) then
      begin
        try
          Verarbeite(PData^);
        finally
          Dispose(PData);
        end;
      end;
    end;
  until Terminated;
end;

constructor TWorker.Create(DataClass: TDataClass);
begin
  inherited Create(True);
  FDataClass := DataClass;
  Resume;
end;
Grüsse,
Dirk

EDIT: kleine Korrektur: Das SetEvent im Add() muss in den abgesicherten Bereich.
  Mit Zitat antworten Zitat