Chip 2001 December/Chip_2001-12_cd1.bin/zkuste/delphi/kompon/d23456/CAJSCRTP.ZIP/libraries/call/ifpsdclass.pas

Pascal/Delphi Source File | 2001-09-03 | 3KB | 162 lines

unit ifpsdclass;

interface
uses
  ifs_utl, ifs_var, ifspas, ifs_obj, ifpscall;


type
  TIFPSClass = class
  private
    FClassType: TClass;
    FDecls: TIFStringList;
  public
    constructor Create(Cl: TClass);
    destructor Destroy; override;

    function AddDecl(const s: string): boolean;
  end;

  TIFPSClassManager = class
  private
    Items: TIFList;
  public
    constructor Create;
    destructor Destroy; override;

    function Add(Cl: TClass): TIFPSClass;
    procedure Delete(I: Cardinal);
    procedure Clear;
    function Count: Cardinal;
    function GetItem(I: Cardinal): TIFPSClass;
  end;

implementation

{ TIFPSClassManager }

function TIFPSClassManager.Add(Cl: TClass): TIFPSClass;
begin
  Result := TIFPSClass.Create(cl);
  Items.Add(Result);
end;

procedure TIFPSClassManager.Clear;
var
  i: Longint;
begin
  for i := 0 to Items.Count - 1 do
    TIFPSClass(Items.GetItem(I)).Free;
  Items.Clear;
end;

function TIFPSClassManager.Count: Cardinal;
begin
  Result := Items.Count;
end;

constructor TIFPSClassManager.Create;
begin
  inherited Create;
  Items := TIFList.Create;
end;

procedure TIFPSClassManager.Delete(I: Cardinal);
begin
  TIFPSClass(Items.GetItem(I)).Free;
  Items.Delete(I);
end;

destructor TIFPSClassManager.Destroy;
begin
  Clear;
  inherited Destroy;
end;

function TIFPSClassManager.GetItem(I: Cardinal): TIFPSClass;
begin
  Result := Items.GetItem(I);

end;

{ TIFPSClass }
{
  NAME TYPE RESULTTYPE PARM1NAME [PARAM1MOD]PARAM1TYPE
  TYPE:
    PROC = Procedure/Function (RESULTTYPE = '' means procedure)
    PROP = Property (*)
  PARAMMOD:
    ! = Var parameter (*)


* = Not supported.

}

function TIFPSClass.AddDecl(const s: string): boolean;
var
  FF, FFBegin: string;
  FType: Byte;
  FParser: TIfPascalParser;
  FParserError: TIFParserError;
begin
  FParser := TIfPascalParser.Create;
  if not FParser.SetText(s, FParserError) then
  begin
    Result := False;
    exit;
  end;
  if FParser.CurrTokenID = CSTII_Procedure then
  begin
    FFBegin := ' PROC ';
    FType := 0;
  end else if FParser.CurrTokenId = CSTII_Function then
  begin
    FFBegin := ' PROC ';
    FType := 1;
  end else begin
    Result := False;
    exit;
  end;
  FParser.Next;
  if FParser.CurrTokenID <> CSTI_Identifier then
  begin
    Result := False;
    exit;
  end;
  FFBegin := FParser.GetToken + FFBegin;
  FParser.Next;
  if FType = 1 then begin
    if FParser.CurrTokenId <> CSTI_Colon then begin
      Result := False;
      exit;
    end;
    if ValidType(FParser.GetToken) then
    begin
      FFBegin := FFBegin + FParser.GetToken + ' ';
    end else begin
    end;
  end else
    FFBegin := FFbegin + ' ';



  FDecls.Add(FFBegin + FF);
  Result := True;
end;

constructor TIFPSClass.Create(Cl: TClass);
begin
  inherited Create;
  FClassType := Cl;
  FDecls := TIFStringList.Create;
end;

destructor TIFPSClass.Destroy;
begin
  FDecls.Free;
  inherited;
end;

end.