CD Actual Thematic 25: Programming/pc_actual_25.iso/Delphi/eXpertDevelopmentKit/SOURCE/XDKSNIPS.PAS

Pascal/Delphi Source File | 1998-01-26 | 5.7 KB | 213 lines

{*******************************************************}
{                                                       }
{       eXpert Development Kit                          }
{                                                       }
{       Copyright (c) 1996,97 Sergey Orlik              }
{       - product manager of Borland Russia             }
{                                                       }
{*******************************************************}
unit XDKSnips;

interface
uses
  SysUtils, Classes;

type
  ExdkSnippetError = class(Exception);

  TxdkSnippet = class(TComponent)
  private
    FCode: TStrings;
    FParams: TStrings;
    FParamBracket: char;
    FResultCode : TSTrings;
    procedure SetCode(Value:TStrings);
    procedure SetCodeText(Value:string);
    function  GetCodeText:string;
    procedure SetCodeStream(Value:TStream);
    function  GetCodeStream:TStream;  //create new stream; you need free it after using!
    procedure SetParams(Value:TStrings);
    function  GetParamValue(const ParamName:string):string;
    procedure SetParamValue(const ParamName:string; const Value:string);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function ParamsCount:integer;
    // analize code and replace params to corresponding values in FResultCode;
    // **you need explicit call DoResultCode** in your methods before getting result code.
    procedure ExtractParams; //analize code and fill list of params
    procedure DoResultCode;
    function ResultCode:TStrings;
    function ResultCodeText:string;
    // create new TMemoryStream - you need free it after using!
    function ResultCodeStream:TStream;
    property CodeText: string read GetCodeText write SetCodeText;
    // create new TMemoryStream - you need free it after using!
    property CodeStream: TStream read GetCodeStream write SetCodeStream;
    property Params:TStrings read FParams write SetParams;
    property ParamValues[const ParamName: string]:string read GetParamValue write SetParamValue;
  published
    property Code: TStrings read FCode write SetCode;
    property ParamBracket:char read FParamBracket write  FParamBracket default '%';
  end;

//====================================================================
implementation
//====================================================================

//====================================================================
// TxdkSnippet

constructor TxdkSnippet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCode:=TStringList.Create;
  FParamBracket:='%';
  FParams:=TStringList.Create;
  FResultCode:=TStringList.Create;
end;

destructor TxdkSnippet.Destroy;
begin
  FResultCode.Free;
  FParams.Free;
  FCode.Free;
  inherited Destroy;
end;

function TxdkSnippet.ParamsCount:integer;
begin
  Result:=FParams.Count;
end;

{ working with code template - 'snippet' }
procedure TxdkSnippet.SetCode(Value:TStrings);
begin
  FCode.Assign(Value);
end;

procedure TxdkSnippet.SetCodeText(Value:string);
begin
  FCode.Text:=Value;
end;

function TxdkSnippet.GetCodeText:string;
begin
  Result:=FCode.Text;
end;

procedure TxdkSnippet.SetCodeStream(Value:TStream);
begin
  if Value<>nil then
  begin
    FCode.LoadFromStream(Value);
  end;
end;

function TxdkSnippet.GetCodeStream:TStream;
begin
  Result:=TMemoryStream.Create;
  FCode.SaveToStream(Result);
end;

{ working with params (and values) }

procedure TxdkSnippet.SetParams(Value:TStrings);
begin
  FParams.Assign(Value);
end;

// ExtractParams analize code template and fill list of params (each param in list is unique)
procedure TxdkSnippet.ExtractParams;
var
  CodeBuf : string;
  Len,
  CurPos  : integer;
  CurChar : char;
  isParam : boolean;
  Param   : string;
begin
  FParams.Clear;
  CurPos:=0;
  CodeBuf:=GetCodeText;
  Len:=Length(CodeBuf);
  if Len<3 then Exit;
  isParam:=false;
  repeat
    CurChar:=CodeBuf[CurPos];
    if CurChar=FParamBracket then
    begin
      isParam:=not isParam;
      if isParam then
        Param:=EmptyStr
      else
        if FParams.IndexOfName(Param)=-1 then
          FParams.Append(Param);
      inc(CurPos);
      Continue;
    end;
    if isParam then
      Param:=Param+CurChar;
    inc(CurPos);
  until CurPos>=Len;
end;

function TxdkSnippet.GetParamValue(const ParamName:string):string;
begin
  Result:=FParams.Values[ParamName];
end;

procedure TxdkSnippet.SetParamValue(const ParamName:string; const Value:string);
begin
  FParams.Values[ParamName]:=Value;
end;

{ working with result code snippet }

// DoResultCode analize code template and replace all params to corresponding values
// sorry, this method is working properly, but not optimized ... :(
procedure TxdkSnippet.DoResultCode;
var
  CodeBuf : string;
  i, Len,
  CurPos  : integer;

  function NonCasePos(Substr:string;S:string):integer;
  begin
     Result:=Pos(UpperCase(Substr),UpperCase(S));
  end;

begin
  CodeBuf:=GetCodeText;
  for i:=0 to FParams.Count-1 do
  begin
    if FParams.Values[Params.Names[i]]=EmptyStr then continue;
    repeat
      CurPos:=NonCasePos(FParamBracket+Params.Names[i]+FParamBracket,CodeBuf);
      if CurPos=0 then Break;
      Len:=Length(Params.Names[i])+2;
      System.Delete(CodeBuf,CurPos,Len);
      System.Insert(FParams.Values[Params.Names[i]],CodeBuf,CurPos);
    until CurPos=0;
  end;
  FResultCode.Text:=CodeBuf;
end;

function TxdkSnippet.ResultCode:TStrings;
begin
  Result:=FResultCode;
end;

function TxdkSnippet.ResultCodeText:string;
begin
  Result:=FResultCode.Text;
end;

function TxdkSnippet.ResultCodeStream:TStream;
begin
  Result:=TMemoryStream.Create;
  FResultCode.SaveToStream(Result);
end;

end.