unit TermoPdv;

interface
uses
  Types,
  Graphics,
  StdCtrls,
  SysUtils,
  Classes,
  Dialogs,
  ExtCtrls,
  Controls,
  ScadaBase;

type
  PTermoPdvTagRec =^ TTermoPdvTagRec;
  TTermoPdvTagRec = record
    name: string;
    tagname: string;
    idx: Integer;
    value: Integer;
    shape: TShape;
  end;

  TTermoPdv = class( TCustomScadaObject )
  public
    Tags: array of TTermoPdvTagRec;
    TagTmpl: string;
    TagRoots: string;
    DeviceName: string;
    ColorScheme: Integer;
    Divisor: Integer;

    memo: TMemo;

    procedure createTags;
    procedure Init; override;
    procedure Process; override;

    procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure PdvClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  end;

  function createTermoPodvesControl(var parent: TPanel; DeviceName: string;
        tagtmpl: string; tagroots: string; Divisor: Integer=1; ColorScheme: integer=0): TTermoPdv;

  procedure createTermoPodvesLegend(var parent: TPanel; ColorScheme: integer=0);


implementation
uses
  RpVisualGlobal,
  TermoPdvProp,
  TermoPdvColors,
  TagStorage,
  HyperStr,
  logger;

var
  last_ShapeMouseMove_Sender: TObject;



function createTermoPodvesControl(var parent: TPanel; DeviceName: string;
        tagtmpl: string; tagroots: string; Divisor: Integer=1; ColorScheme: integer=0): TTermoPdv;
var
  pdv: TTermoPdv;
begin
  if Divisor<=0 then Divisor:=1;

  pdv := TTermoPdv.Create(parent);
  pdv.parent := parent;
  pdv.Align := alClient;
  pdv.Width := parent.Width;
  pdv.Height := parent.Height;
  pdv.Left  :=0;
  pdv.Visible := true;

  parent.BevelOuter:=bvNone;

  pdv.Show;

  pdv.TagTmpl := tagtmpl;
  pdv.TagRoots := tagroots;
  pdv.DeviceName := DeviceName;
  pdv.ColorScheme := ColorScheme;
  pdv.Divisor := Divisor;

  pdv.createTags;

  result := pdv;
end;





procedure createTermoPodvesLegend(var parent: TPanel; ColorScheme: integer=0);
var
  n,i: Integer;
  h:Real;
  pnl: TPanel;
  p: PTermoPdvColorRec;
begin
  n := getSchemeItemsCount(ColorScheme);
  if n=0 then Exit;

  h := parent.Height / n;

  for i:=0 to n-1 do begin
    p := getSchemeItem(ColorScheme, i);

    pnl := TPanel.Create(parent);
    pnl.Parent := parent;
    pnl.Visible := true;
    pnl.BevelOuter := bvNone;
    pnl.Left := 0;
    pnl.Width := parent.Width;
    pnl.Top := Round((parent.Height-h) - i*h - 1);
    pnl.Height := Round(h+1);
    pnl.Color := p.color;
    pnl.Caption := IntToStr(p.fromValue);
    pnl.Show;
  end;

end;



{ TTermoPdv }

procedure TTermoPdv.createTags;
var
  i,n,k: Integer;
  h:real;
  s: string;
  shp: TShape;
begin
  SetDelimiter(';');
  n := GetTokenCnt(TagRoots);
  h := (Height-1) / n;

  SetLength(Tags, n);

  k := 1;
  for i:=0 to n-1 do begin
    // make tagname
    s := Parse(TagRoots, ';', k);
    Tags[i].name := s;
    Tags[i].tagname := TagTmpl;
    ReplaceS(Tags[i].tagname, '^', s);
    Tags[i].value := 0;

    // make shape
    shp := TShape.Create(self);
    shp.Parent := Self;
    shp.Visible := true;
    shp.Name := 'shape_' + Tags[i].name;
    shp.Left := 0;
    shp.Width := Width;
    shp.Top := Round(Height-(i+1)*h)-1;
    shp.Height := Round(Height-i*h) - Round(Height-(i+1)*h)+1 ;
    shp.Brush.Color := random($FFFFFF);
    shp.OnMouseMove := ShapeMouseMove;
    shp.OnMouseUp := PdvClick;
    shp.ShowHint := True;
    shp.Cursor := crHandPoint;
    shp.Show;
    Tags[i].shape := shp;
  end;
end;






procedure TTermoPdv.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  s,s1,s2: string;
  i,n: Integer;
begin
  if (sender <> last_ShapeMouseMove_Sender) and ((Sender as TShape).ShowHint) then begin
    (Sender as TShape).ShowHint := False;
    Exit;
  end;

  if sender = last_ShapeMouseMove_Sender then
    Exit;

  last_ShapeMouseMove_Sender := sender;

  s := DeviceName+':'#13;

  n := Length(Tags)-1;
  for i:=n downto 0 do begin
    if sender = Tags[i].shape then begin
      s1 := '<< ';
      s2 := ' >>';
    end else begin
      s1 := '      ';
      s2 := '      ';
    end;

    if Tags[i].idx < 0 then
      s := s + s1 + Tags[i].name + '  -  Тег не найден!' + s2 + #13
    else
      s := s + s1 + Tags[i].name + ':    ' + inttostr(Tags[i].value) + s2 + #13;
  end;

  for i:=0 to Length(Tags)-1 do
    Tags[i].shape.Hint := s;

  Hint := s;
  Parent.Hint := s;

  (Sender as TShape).ShowHint := true;
end;



procedure TTermoPdv.PdvClick(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not rvgLogIn then Exit;
  with TTermoPdvPropForm.Create(nil) do
    try
      M := self;
      ShowModal;
    finally
      Free;
    end;
end;




procedure TTermoPdv.Init;
var
  i: Integer;
begin
  inherited;
  for i:=0 to Length(tags)-1 do begin
    Tags[i].idx := GetTagIndex(Tags[i].tagname);
    if Tags[i].idx < 0 then begin
      Tags[i].shape.Brush.Color := clBlack;
      Tags[i].shape.Brush.Style := bsDiagCross;
    end else
      Tags[i].shape.Brush.Style := bsSolid;
  end;
end;


procedure TTermoPdv.Process;
var
  i,j: Integer;
begin
  inherited;
  for i:=0 to Length(tags)-1 do
    if Tags[i].idx >= 0 then begin
      Tags[i].value := Round( GetTagValue(Tags[i].idx) / divisor);

      j := getTermoPdvColor(ColorScheme, Tags[i].value );
      if (j  <= $FFFFFF)
         then
           begin
             Tags[i].shape.Brush.Style := bsSolid;
             Tags[i].shape.Brush.Color :=  j;
           end
         else
           begin
             Tags[i].shape.Brush.Style := bsBDiagonal;
             Tags[i].shape.Brush.Color :=  j;
           end;
    end;
end;

end.
