Browse Source

+ skeleton for TInterfaceList added

florian 23 years ago
parent
commit
95e8b8db2e
3 changed files with 171 additions and 8 deletions
  1. 9 2
      fcl/inc/classes.inc
  2. 42 6
      fcl/inc/classesh.inc
  3. 120 0
      fcl/inc/intf.inc

+ 9 - 2
fcl/inc/classes.inc

@@ -75,6 +75,10 @@ var
 { Class and component registration routines }
 { Class and component registration routines }
 {$I cregist.inc}
 {$I cregist.inc}
 
 
+{ Interface related stuff }
+{$ifdef HASINTF}
+{$I intf.inc}
+{$endif HASINTF}
 
 
 {**********************************************************************
 {**********************************************************************
  *       Miscellaneous procedures and functions                       *
  *       Miscellaneous procedures and functions                       *
@@ -1185,7 +1189,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2002-01-06 21:54:49  peter
+  Revision 1.9  2002-07-16 13:32:51  florian
+    + skeleton for TInterfaceList added
+
+  Revision 1.8  2002/01/06 21:54:49  peter
     * action classes added
     * action classes added
 
 
   Revision 1.7  2001/04/10 23:24:51  peter
   Revision 1.7  2001/04/10 23:24:51  peter
@@ -1213,4 +1220,4 @@ end;
 
 
   Revision 1.2  2000/07/13 11:32:59  michael
   Revision 1.2  2000/07/13 11:32:59  michael
   + removed logs
   + removed logs
-}
+}

+ 42 - 6
fcl/inc/classesh.inc

@@ -12,7 +12,6 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
-{ We NEED ansistrings !!}
 {$H+}
 {$H+}
 
 
 { The 1.0 compiler cannot compile the Seek(int64) overloading correct }
 { The 1.0 compiler cannot compile the Seek(int64) overloading correct }
@@ -375,15 +374,16 @@ type
   TStrings = class;
   TStrings = class;
 
 
 { IStringsAdapter interface }
 { IStringsAdapter interface }
-{ Maintains link between TStrings and IStrings implementations }
 
 
-  { !!!! Interfaces aren't supported by FPC
-  IStringsAdapter = interface
+{$ifdef HASINTF}
+  { Maintains link between TStrings and IStrings implementations }
+  IStringsAdapter = interface ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
     procedure ReferenceStrings(S: TStrings);
     procedure ReferenceStrings(S: TStrings);
     procedure ReleaseStrings;
     procedure ReleaseStrings;
   end;
   end;
-  }
+{$else HASINTF}
   IStringsAdapter = class(TObject);
   IStringsAdapter = class(TObject);
+{$endif HASINTF}
 
 
 { TStrings class }
 { TStrings class }
 
 
@@ -1316,6 +1316,39 @@ type
     property Count : Integer read GetCount write SetCount;
     property Count : Integer read GetCount write SetCount;
     property Items[index : Integer] : IUnknown read Get write Put;default;
     property Items[index : Integer] : IUnknown read Get write Put;default;
   end;
   end;
+
+  TInterfaceList = class(TInterfacedObject,IInterfaceList)
+  private
+    FList : TThreadList;
+  protected
+    function Get(i : Integer) : IUnknown;
+    function GetCapacity : Integer;
+    function GetCount : Integer;
+    procedure Put(i : Integer;item : IUnknown);
+    procedure SetCapacity(NewCapacity : Integer);
+    procedure SetCount(NewCount : Integer);
+  public
+    constructor Create;
+    destructor Destroy;
+
+    procedure Clear;
+    procedure Delete(index : Integer);
+    procedure Exchange(index1,index2 : Integer);
+    function First : IUnknown;
+    function IndexOf(item : IUnknown) : Integer;
+    function Add(item : IUnknown) : Integer;
+    procedure Insert(i : Integer;item : IUnknown);
+    function Last : IUnknown;
+    function Remove(item : IUnknown): Integer;
+    procedure Lock;
+    procedure Unlock;
+
+    function Expand : TInterfaceList;
+
+    property Capacity : Integer read GetCapacity write SetCapacity;
+    property Count : Integer read GetCount write SetCount;
+    property Items[Index : Integer] : IUnknown read Get write Put;default;
+  end;
 {$endif HASINTF}
 {$endif HASINTF}
 
 
 var
 var
@@ -1415,7 +1448,10 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.20  2002-07-15 18:35:04  florian
+  Revision 1.21  2002-07-16 13:32:51  florian
+    + skeleton for TInterfaceList added
+
+  Revision 1.20  2002/07/15 18:35:04  florian
     + IInterfaceList added
     + IInterfaceList added
 
 
   Revision 1.19  2002/03/28 12:08:47  michael
   Revision 1.19  2002/03/28 12:08:47  michael

+ 120 - 0
fcl/inc/intf.inc

@@ -0,0 +1,120 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2002 by the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+    constructor TInterfaceList.Create;
+      begin
+      end;
+
+
+    destructor TInterfaceList.Destroy;
+      begin
+      end;
+
+
+    function TInterfaceList.Get(i : Integer) : IUnknown;
+      begin
+      end;
+
+
+    function TInterfaceList.GetCapacity : Integer;
+      begin
+      end;
+
+
+    function TInterfaceList.GetCount : Integer;
+      begin
+      end;
+
+
+    procedure TInterfaceList.Put(i : Integer;item : IUnknown);
+      begin
+      end;
+
+
+    procedure TInterfaceList.SetCapacity(NewCapacity : Integer);
+      begin
+      end;
+
+
+    procedure TInterfaceList.SetCount(NewCount : Integer);
+      begin
+      end;
+
+
+    procedure TInterfaceList.Clear;
+      begin
+      end;
+
+
+    procedure TInterfaceList.Delete(index : Integer);
+      begin
+      end;
+
+
+    procedure TInterfaceList.Exchange(index1,index2 : Integer);
+      begin
+      end;
+
+
+    function TInterfaceList.First : IUnknown;
+      begin
+      end;
+
+
+    function TInterfaceList.IndexOf(item : IUnknown) : Integer;
+      begin
+      end;
+
+
+    function TInterfaceList.Add(item : IUnknown) : Integer;
+      begin
+      end;
+
+
+    procedure TInterfaceList.Insert(i : Integer;item : IUnknown);
+      begin
+      end;
+
+
+    function TInterfaceList.Last : IUnknown;
+      begin
+      end;
+
+
+    function TInterfaceList.Remove(item : IUnknown): Integer;
+      begin
+      end;
+
+
+    procedure TInterfaceList.Lock;
+      begin
+      end;
+
+
+    procedure TInterfaceList.Unlock;
+      begin
+      end;
+
+
+    function TInterfaceList.Expand : TInterfaceList;
+      begin
+      end;
+
+
+{
+  $Log$
+  Revision 1.1  2002-07-16 13:32:51  florian
+    + skeleton for TInterfaceList added
+
+}