home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d23456 / CAJSCRTP.ZIP / libraries / call / ifpsdclass.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-09-03  |  3.0 KB  |  162 lines
  1. unit ifpsdclass;
  2.  
  3. interface
  4. uses
  5.   ifs_utl, ifs_var, ifspas, ifs_obj, ifpscall;
  6.  
  7.  
  8. type
  9.   TIFPSClass = class
  10.   private
  11.     FClassType: TClass;
  12.     FDecls: TIFStringList;
  13.   public
  14.     constructor Create(Cl: TClass);
  15.     destructor Destroy; override;
  16.  
  17.     function AddDecl(const s: string): boolean;
  18.   end;
  19.  
  20.   TIFPSClassManager = class
  21.   private
  22.     Items: TIFList;
  23.   public
  24.     constructor Create;
  25.     destructor Destroy; override;
  26.  
  27.     function Add(Cl: TClass): TIFPSClass;
  28.     procedure Delete(I: Cardinal);
  29.     procedure Clear;
  30.     function Count: Cardinal;
  31.     function GetItem(I: Cardinal): TIFPSClass;
  32.   end;
  33.  
  34. implementation
  35.  
  36. { TIFPSClassManager }
  37.  
  38. function TIFPSClassManager.Add(Cl: TClass): TIFPSClass;
  39. begin
  40.   Result := TIFPSClass.Create(cl);
  41.   Items.Add(Result);
  42. end;
  43.  
  44. procedure TIFPSClassManager.Clear;
  45. var
  46.   i: Longint;
  47. begin
  48.   for i := 0 to Items.Count - 1 do
  49.     TIFPSClass(Items.GetItem(I)).Free;
  50.   Items.Clear;
  51. end;
  52.  
  53. function TIFPSClassManager.Count: Cardinal;
  54. begin
  55.   Result := Items.Count;
  56. end;
  57.  
  58. constructor TIFPSClassManager.Create;
  59. begin
  60.   inherited Create;
  61.   Items := TIFList.Create;
  62. end;
  63.  
  64. procedure TIFPSClassManager.Delete(I: Cardinal);
  65. begin
  66.   TIFPSClass(Items.GetItem(I)).Free;
  67.   Items.Delete(I);
  68. end;
  69.  
  70. destructor TIFPSClassManager.Destroy;
  71. begin
  72.   Clear;
  73.   inherited Destroy;
  74. end;
  75.  
  76. function TIFPSClassManager.GetItem(I: Cardinal): TIFPSClass;
  77. begin
  78.   Result := Items.GetItem(I);
  79.  
  80. end;
  81.  
  82. { TIFPSClass }
  83. {
  84.   NAME TYPE RESULTTYPE PARM1NAME [PARAM1MOD]PARAM1TYPE
  85.   TYPE:
  86.     PROC = Procedure/Function (RESULTTYPE = '' means procedure)
  87.     PROP = Property (*)
  88.   PARAMMOD:
  89.     ! = Var parameter (*)
  90.  
  91.  
  92. * = Not supported.    
  93.  
  94. }
  95.  
  96. function TIFPSClass.AddDecl(const s: string): boolean;
  97. var
  98.   FF, FFBegin: string;
  99.   FType: Byte;
  100.   FParser: TIfPascalParser;
  101.   FParserError: TIFParserError;
  102. begin
  103.   FParser := TIfPascalParser.Create;
  104.   if not FParser.SetText(s, FParserError) then
  105.   begin
  106.     Result := False;
  107.     exit;
  108.   end;
  109.   if FParser.CurrTokenID = CSTII_Procedure then
  110.   begin
  111.     FFBegin := ' PROC ';
  112.     FType := 0;
  113.   end else if FParser.CurrTokenId = CSTII_Function then
  114.   begin
  115.     FFBegin := ' PROC ';
  116.     FType := 1;
  117.   end else begin
  118.     Result := False;
  119.     exit;
  120.   end;
  121.   FParser.Next;
  122.   if FParser.CurrTokenID <> CSTI_Identifier then
  123.   begin
  124.     Result := False;
  125.     exit;
  126.   end;
  127.   FFBegin := FParser.GetToken + FFBegin;
  128.   FParser.Next;
  129.   if FType = 1 then begin
  130.     if FParser.CurrTokenId <> CSTI_Colon then begin
  131.       Result := False;
  132.       exit;
  133.     end;
  134.     if ValidType(FParser.GetToken) then
  135.     begin
  136.       FFBegin := FFBegin + FParser.GetToken + ' ';
  137.     end else begin
  138.     end;
  139.   end else
  140.     FFBegin := FFbegin + ' ';
  141.  
  142.  
  143.  
  144.   FDecls.Add(FFBegin + FF);
  145.   Result := True;
  146. end;
  147.  
  148. constructor TIFPSClass.Create(Cl: TClass);
  149. begin
  150.   inherited Create;
  151.   FClassType := Cl;
  152.   FDecls := TIFStringList.Create;
  153. end;
  154.  
  155. destructor TIFPSClass.Destroy;
  156. begin
  157.   FDecls.Free;
  158.   inherited;
  159. end;
  160.  
  161. end.
  162.