unit avBase;

interface
uses
  classes, Graphics, pFIBDataSet, pFIBDatabase, DbChart, sysutils;

type
  TavGroup = class;

  //
  TavVisulizatorItem = class
    Condition: string;
    Expression: string;
    UseColor: boolean;
    FontColor: TColor;
    BackColor: TColor;
  end;

  //
  TavVisulizator = class
    Name: string;
    Items: array of TavVisulizatorItem;

    procedure Clear;
    destructor Destroy; override;
  end;

  TVisulizators = class
    Items: array of TavVisulizator;
    procedure Clear;
    destructor Destroy; override;
  end;

  //
  TavTag = class
    TagName: string;
    Transform: string;
    Visulizator: TavVisulizator;

    IdTag: integer;
    ArcName: string;
    FontColor: TColor;
    BackColor: TColor;

    function TransformValue(x: integer; var ColorChanged: boolean): string;
  end;

  //
  TavStroka = class
    Group: TavGroup;

    Name: string;
    Descr: string;
    Tags: array of TavTag;

    procedure Clear;
    destructor Destroy; override;
  end;

  TavColumn = class
    Name: string;
    Width: integer;
    Alignment: TAlignment;
  end;

  //
  TavGroup = class
    Name: string;
    ColWidthName: integer;
    ColWidthDescr: integer;
    Stroki: array of TavStroka;
    Columns: array of TavColumn;

    procedure ClearStroki;
    procedure ClearColumns;
    destructor Destroy; override;
  end;


implementation

uses
  DB, hyperstr, rp_pars, variants;

{ TavGroup }

procedure TavGroup.ClearStroki;
var
  i: integer;
begin
  for i:=0 to length(Stroki)-1 do Stroki[i].Free;
  Stroki := nil;
end;

procedure TavGroup.ClearColumns;
var
  i: integer;
begin
  for i:=0 to length(Columns)-1 do Columns[i].Free;
  Columns := nil;
end;

destructor TavGroup.Destroy;
begin
  ClearStroki;
  ClearColumns;
  inherited;
end;



{ TavStroka }

procedure TavStroka.Clear;
var
  i: integer;
begin
  for i:=0 to length(Tags)-1 do Tags[i].Free;
  Tags := nil;
end;

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



{ TavVisulizator }

procedure TavVisulizator.Clear;
var
  i: integer;
begin
  for i:=0 to length(Items)-1 do Items[i].Free;
  Items := nil;
end;

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

{ TVisulizators }

procedure TVisulizators.Clear;
var
  i: integer;
begin
  for i:=0 to length(Items)-1 do Items[i].Free;
  Items := nil;
end;

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

{ TavTag }

function TavTag.TransformValue(x: integer; var ColorChanged: boolean): string;
var
  s, sexpr, scnd, sval: string;
  i: integer;
  flag: boolean;
  prs: TfrParser;
  v: variant;
  new_FontColor: TColor;
  new_BackColor: TColor;
begin
  prs := TfrParser.Create;
  sval := inttostr(x);

  flag := false;
  if trim(Transform) <> '' then begin
    s := trim(uppercase(Transform));
    replaceS(s, '%I', sval);
    try
      v := prs.Calc(s);
      sval := VarToStr(v);
    except
      result := 'err transform';
      flag := true;
    end;
  end;

  if flag then exit;


  result := sval;
  ColorChanged := false;
  new_FontColor := clBlack;
  new_BackColor := clWindow;

  if Visulizator<>nil then begin

    prs := TfrParser.Create;
    try

      for i:=0 to length(Visulizator.Items)-1 do begin
        scnd := trim(uppercase(Visulizator.items[i].Condition));
        sexpr := trim(uppercase(Visulizator.items[i].Expression));

        replaceS(scnd, '%I', sval);
        replaceS(sexpr, '%I', sval);

        flag := scnd = '';

        if not flag then
          try
            v := prs.Calc(scnd);
            flag := v>0;
          except
            result := 'err cnd ' + inttostr(i);
            break;
          end;

        if flag then begin
          try
            if copy(sexpr,1,1)='$' then
              result := copy(sexpr, 2, length(sexpr))
            else begin
              v := prs.Calc(sexpr);
              result := VarToStr(v);
            end;

            if Visulizator.items[i].UseColor then begin
              new_FontColor := Visulizator.items[i].FontColor;
              new_BackColor := Visulizator.items[i].BackColor;
            end;
          except
            result := 'err expr ' + inttostr(i);
          end;
          break;
        end;

      end;

    finally
      prs.Free;
    end;
  end;

  ColorChanged := (new_FontColor <> FontColor) or (new_BackColor <> BackColor);
  FontColor := new_FontColor;
  BackColor := new_BackColor;

end;

end.
