{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit TMultiThreadObjectMethodsList;

interface
  USES Classes, MultiThreadList;

type
{  TMultiThreadMethodsList=class(tMultiTreadList)
    protected
     function GetCount:integer;
     function Get(Index:integer):TNotifyEvent;
     procedure Put(Index:integer; AItem:TNotifyEvent);
    public
      function    Add(Item: TNotifyEvent): Integer;
      function    Remove(Item: TNotifyEvent): Integer;
      procedure   Delete(Index: Integer);
      property    Items[Index: Integer]: TNotifyEvent read Get write Put; default;
      function    Extract(Item: TNotifyEvent): TNotifyEvent;
      procedure   Move(CurIndex, NewIndex: Integer);
      procedure   Exchange(Index1, Index2: Integer);
      procedure   Insert(Index: Integer; Item: TNotifyEvent);
      property    Count:integer read GetCount;
      procedure   Lock;
      procedure   UnLock;
  end;
}
  TMultiThreadMethodsList=class(TObject)
    private
      prMethodsList:tMultiThreadList;
      prObjectsList:TList;
    protected
      function GetCount:integer;
      procedure SetCount(ACount:integer);
      function Get(Index:integer):TNotifyEvent;
      procedure Put(Index:integer; AItem:TNotifyEvent);
      property    Methods:tMultiThreadList read prMethodsList;
      property    Objects:TList read prObjectsList;
    public
      constructor Create;
      destructor  Destroy; override;
      procedure   BeginRead;
      procedure   EndRead;
      procedure   BeginWrite;
      procedure   EndWrite;
      function    Add(Item: TNotifyEvent): Integer;
      function    Remove(Item: TNotifyEvent): Integer;
      procedure   Delete(Index: Integer);
      property    Items[Index: Integer]: TNotifyEvent read Get write Put; default;
      function    Extract(Item: TNotifyEvent): TNotifyEvent;
      procedure   Move(CurIndex, NewIndex: Integer);
      procedure   Exchange(Index1, Index2: Integer);
      procedure   Insert(Index: Integer; Item: TNotifyEvent);
      property    Count:integer read GetCount write SetCount;
      procedure   Assign(ASource:TMultiThreadMethodsList);
  end;

implementation

 type
   tMethodOfObject=record
     case byte of
      0:(Method:TNotifyEvent);
      1:(Ptr:array[0..1] of pointer);
      2:(MethodPtr:pointer; ObjectPtr:TObject);
   end;

constructor TMultiThreadMethodsList.Create;
begin
  Inherited;
  prMethodsList:=tMultiThreadList.Create;
  prMethodsList.BeginWrite;
  try
    prObjectsList:=TList.Create;
  finally
    prMethodsList.EndWrite;
  end;
end;

destructor TMultiThreadMethodsList.Destroy;
begin
  prMethodsList.BeginWrite;
  try
    prObjectsList.Free;
    Inherited;
  finally
    prMethodsList.Free;
  end;
end;

procedure TMultiThreadMethodsList.BeginRead;
begin
  prMethodsList.BeginRead;
end;

procedure TMultiThreadMethodsList.EndRead;
begin
  prMethodsList.EndRead;
end;

procedure TMultiThreadMethodsList.BeginWrite;
begin
  prMethodsList.BeginWrite;
end;

procedure TMultiThreadMethodsList.EndWrite;
begin
  prMethodsList.EndWrite;
end;

procedure TMultiThreadMethodsList.Assign(ASource:TMultiThreadMethodsList);
  var sz:cardinal;
begin
  ASource.BeginRead;
  try
    prMethodsList.BeginWrite;
    try
      Count:=ASource.Count;
      sz:=SizeOf(prObjectsList.List^[0])*Count;
      System.Move(ASource.Objects.List^,Objects.List^,sz);
      System.Move(ASource.Methods.List^,Methods.List^,sz);
    finally
      prMethodsList.EndWrite;
    end;
  finally
    ASource.EndRead;
  end;
end;

procedure TMultiThreadMethodsList.SetCount(ACount:integer);
begin
  if ACount=Count then Exit;
  prMethodsList.BeginWrite;
  try
     prMethodsList.Count:=ACount;
     prObjectsList.Count:=ACount;
  finally
    prMethodsList.EndWrite;
  end;
end;

function TMultiThreadMethodsList.GetCount:integer;
begin
  prMethodsList.BeginRead;
  try
    Result:=prMethodsList.Count;
  finally
    prMethodsList.EndRead;
  end;
end;

function TMultiThreadMethodsList.Get(Index:integer):TNotifyEvent;
begin
  prMethodsList.BeginRead;
  try
    with tMethodOfObject(Result) do begin
     MethodPtr:=prMethodsList[Index];
     ObjectPtr:=prObjectsList[Index];
    end;
  finally
    prMethodsList.EndRead;
  end;
end;

procedure TMultiThreadMethodsList.Put(Index:integer; AItem:TNotifyEvent);
begin
  prMethodsList.BeginWrite;
  try
     prMethodsList[Index]:=tMethodOfObject(AItem).MethodPtr;
     prObjectsList[Index]:=tMethodOfObject(AItem).ObjectPtr;
  finally
    prMethodsList.EndWrite;
  end;
end;

function TMultiThreadMethodsList.Add(Item: TNotifyEvent): Integer;
begin
  prMethodsList.BeginWrite;
  try
    Result:=prMethodsList.Add(tMethodOfObject(Item).MethodPtr);
    if Result>=0 then begin
      Result:=prObjectsList.Add(tMethodOfObject(Item).ObjectPtr);
    end;
  finally
    prMethodsList.EndWrite;
  end;
end;

function TMultiThreadMethodsList.Remove(Item: TNotifyEvent): Integer;
  var i:integer;
begin
  Result:=-1;
  prMethodsList.BeginRead;
  try
    for i:=0 to Pred(Count) do begin
      if @Items[i]=@Item then begin
        Delete(i);
        Result:=i;
      end;
    end;
  finally
    prMethodsList.EndRead;
  end;
end;

function  TMultiThreadMethodsList.Extract(Item: TNotifyEvent): TNotifyEvent;
  var i:integer;
begin
  Result:=NIL;
  prMethodsList.BeginRead;
  try
    for i:=0 to Pred(Count) do begin
      if @Items[i]=@Item then begin
        Result:=Item;
        Delete(i);
      end;
    end;
  finally
    prMethodsList.EndRead;
  end;
end;

procedure TMultiThreadMethodsList.Move(CurIndex, NewIndex: Integer);
begin
  if CurIndex=NewIndex then Exit;
  prMethodsList.BeginWrite;
  try
    prMethodsList.Move(CurIndex, NewIndex);
    prObjectsList.Move(CurIndex, NewIndex);
  finally
    prMethodsList.EndWrite;
  end;
end;

procedure TMultiThreadMethodsList.Exchange(Index1, Index2: Integer);
begin
  prMethodsList.BeginWrite;
  try
    prMethodsList.Exchange(Index1, Index2);
    prObjectsList.Exchange(Index1, Index2);
  finally
    prMethodsList.EndWrite;
  end;
end;

procedure  TMultiThreadMethodsList.Delete(Index: Integer);
begin
  prMethodsList.BeginWrite;
  try
    prMethodsList.Delete(Index);
    prObjectsList.Delete(Index);
  finally
    prMethodsList.EndWrite;
  end;
end;

procedure   TMultiThreadMethodsList.Insert(Index: Integer; Item: TNotifyEvent);
begin
  prMethodsList.BeginWrite;
  try
    prMethodsList.Insert(Index, tMethodOfObject(Item).MethodPtr);
    prObjectsList.Insert(Index, tMethodOfObject(Item).ObjectPtr);
  finally
    prMethodsList.EndWrite;
  end;
end;

//----------------------------------------------------------
(*function TMultiThreadMethodsList.GetCount:integer;
begin
  BeginRead;
  try
    Result:=Inherited Count shr 1;
  finally
    EndRead;
  end;
end;

function TMultiThreadMethodsList.Get(Index:integer):TNotifyEvent;
begin
  BeginRead;
  try
    tMethodOfObject(Result).Ptr[0]:=Inherited Get(Index shl 1);
    tMethodOfObject(Result).Ptr[1]:=Inherited Get(Succ(Index shl 1));
  finally
    EndRead;
  end;
end;

procedure TMultiThreadMethodsList.Put(Index:integer; AItem:TNotifyEvent);
begin
  BeginWrite;
  try
    Inherited Put(Index shl 1,tMethodOfObject(AItem).Ptr[0]);
    Inherited Put(Succ(Index shl 1),tMethodOfObject(AItem).Ptr[1]);
  finally
    EndWrite;
  end;
end;

function TMultiThreadMethodsList.Add(Item: TNotifyEvent): Integer;
begin
  BeginWrite;
  try
    Inherited Add(tMethodOfObject(Item).Ptr[0]);
    Inherited Add(tMethodOfObject(Item).Ptr[1]);
  finally
    EndWrite;
  end;
end;

function TMultiThreadMethodsList.Remove(Item: TNotifyEvent): Integer;
begin
  Result:=-1;
end;

function  TMultiThreadMethodsList.Extract(Item: TNotifyEvent): TNotifyEvent;
begin
  Result:=NIL;
end;

procedure TMultiThreadMethodsList.Move(CurIndex, NewIndex: Integer);
  var tmp:TNotifyEvent;
begin
  if CurIndex=NewIndex then Exit;
  BeginWrite;
  try
    tmp:=Items[CurIndex];
    Delete(CurIndex);
    if CurIndex<NewIndex then begin
      Insert(Pred(NewIndex),tmp);
    end else begin
      Insert(NewIndex,tmp);
    end;
  finally
    EndWrite;
  end;
end;

procedure TMultiThreadMethodsList.Exchange(Index1, Index2: Integer);
begin
  BeginWrite;
  try
    Inherited Exchange(Succ(Index1 shl 1),Succ(Index2 shl 1));
    Inherited Exchange((Index1 shl 1),(Index2 shl 1));
  finally
    EndWrite;
  end;
end;

procedure  TMultiThreadMethodsList.Delete(Index: Integer);
begin
  BeginWrite;
  try
    Inherited Delete(Succ(Index shl 1));
    Inherited Delete(Index shl 1);
  finally
    EndWrite;
  end;
end;

procedure   TMultiThreadMethodsList.Insert(Index: Integer; Item: TNotifyEvent);
begin
  BeginWrite;
  try
    Inherited Insert(Succ(Index shl 1),tMethodOfObject(Item).Ptr[1]);
    Inherited Insert((Index shl 1),tMethodOfObject(Item).Ptr[0]);
  finally
    EndWrite;
  end;
end;

procedure TMultiThreadMethodsList.Lock;
begin
  BeginWrite;
end;

procedure TMultiThreadMethodsList.UnLock;
begin
  EndWrite;
end;
*)
end.