unit VisControl;

interface
uses
  DesignIntf, DesignEditors,
  Math,
  scadabase,
  StdCtrls,
  ExtCtrls,
  Graphics,
  Controls,
  Classes,
  sysutils,
  forms,
  dialogs;

Const
  ModeMarginX = 6;
  ModeMarginY = 3;

  BlokMarginX = 4;
  BlokMarginY = 1;

Type
  TPicName = string;
  TTagName = string;
  TTagPath = string;
  TDeviceName = string;
  TChannelName = string;



Type

  TVisTagRec = record
    idx: integer;
    value: integer;
    valString: string;
    valDouble: Double;
    valLong: Int64;
    good: boolean;
    empty: boolean;
  end;

  TVisTagRecs = array of TVisTagRec;


  TVisControl = class(TCustomScadaObject)
  private
    procedure SetTagNames(Value: TStringList);
    procedure SetScript(Value: TStringList);

  protected
    FHint: string;
    FTagNames: TStringList;

    FScript: TStringList;
    FScriptEnabled: boolean;
    FScriptDefEnabled: boolean;
    FExecuteOnTagChange: boolean;
    CompiledScript: string;

    FBadColorsEnabled: boolean;
    FBadColorBack: TColor;
    FBadColorFont: TColor;
    FGoodColorFont: TColor;
    FGoodColorBack1: TColor;
    FGoodColorBack2: TColor;
    FTagStatusGood: Boolean;

    function updateTags: Boolean;
    procedure onTagStatusChanged(good: Boolean); virtual;
    procedure putColorGood(colorFont, colorBack1, colorBack2: TColor);
    
  public
    Tags: TVisTagRecs;
    IsCompileScriptOk: boolean;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ExecuteProcessEvent; 

    function gettagval(AIndex: integer): integer;
    function gettagidx(AIndex: integer): integer;
    procedure settagval(AIndex: integer; AValue: integer);

    procedure settagvalbool(AIndex: integer; AValue: boolean);
    function gettagvalbool(AIndex: integer): boolean;

    procedure settagvalint(AIndex: integer; AValue: integer);
    function gettagvalint(AIndex: integer): integer;

    procedure settagvallong(AIndex: integer; AValue: int64);
    function gettagvallong(AIndex: integer): int64;

    procedure settagvaldouble(AIndex: integer; AValue: double);
    function gettagvaldouble(AIndex: integer): double;
    function isTagNan(AIndex: integer): boolean;

    procedure settagvalstring(AIndex: integer; AValue: string);
    function gettagvalstring(AIndex: integer): string;

    function istaggood(AIndex: integer): boolean;

    function CompileScript(var Messages: string): boolean; virtual;
    procedure ExecuteScript; virtual;

  published
    property TagNames: TStringList read FTagNames write SetTagNames;

    property BadColorsEnabled: boolean read FBadColorsEnabled write FBadColorsEnabled;
    property BadColorFont: TColor read FBadColorFont write FBadColorFont;
    property BadColorBack: TColor read FBadColorBack write FBadColorBack;

    property Script: TStringList read FScript write SetScript;
    property ScriptEnabled: boolean read FScriptEnabled write FScriptEnabled;
    property ScriptDefEnabled: boolean read FScriptDefEnabled write FScriptDefEnabled;
    property ExecuteOnTagChange: boolean read FExecuteOnTagChange write FExecuteOnTagChange;

    property OnProcess;
  end;


  TVisControlEditor = class(TComponentEditor)
  public
    procedure Edit; override;
  end;


implementation
uses
  VisControlScriptEdit,
  DataClientBase,
  Numbers,
  TagStorage,
  RpVisualGlobal;


constructor TVisControl.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := True;

  FHint := '';
  FTagNames := TStringList.Create;

  FScriptEnabled := true;
  FScriptDefEnabled := true;
  FScript := TStringList.Create;
  FScript.Text := 'begin'#13#10'end.';
  IsCompileScriptOk := false;

  FTagStatusGood := true;
  FBadColorBack := clRed;
  FBadColorFont := clWhite;
  FBadColorsEnabled := false;

end;

destructor TVisControl.Destroy;
begin
  FTagNames.Free;
  FScript.Free;
  inherited;
end;

procedure TVisControl.SetTagNames(Value: TStringList);
begin
  FTagNames.Assign(Value);
end;

procedure TVisControl.SetScript(Value: TStringList);
begin
  FScript.Assign(Value);
end;



function TVisControl.updateTags: Boolean;
var
  i, tt: integer;
  good, allgood: boolean;
begin
  Result := false;
  allgood := True;
  for i:=0 to length(Tags)-1 do begin
    tt := getTagType(tags[i].idx);
    good := istaggood(i);
    allgood := allgood and good;

    if good <> Tags[i].good then begin
      Tags[i].good := good;
      Result := true;
    end;

    case tt of
      TAGTYPE_BOOL, TAGTYPE_INT:
        if (Tags[i].value <> gettagvalint(i)) or (Tags[i].empty) then begin
          Tags[i].value := gettagvalint(i);
          Tags[i].empty := false;
          Result := true;
        end;
      TAGTYPE_LONG:
        if (Tags[i].valLong <> gettagvallong(i)) or (Tags[i].empty) then begin
          Tags[i].valLong := gettagvallong(i);
          Tags[i].value := Integer(Tags[i].valLong);
          Tags[i].empty := false;
          Result := true;
        end;
      TAGTYPE_DOUBLE:
        if (Tags[i].valDouble <> gettagvaldouble(i)) or (Tags[i].empty) then begin
          Tags[i].valDouble := gettagvaldouble(i);
          Tags[i].value := Integer(Trunc(Tags[i].valDouble));
          Tags[i].empty := false;
          Result := true;
        end;
      TAGTYPE_STRING:
        if (Tags[i].valString <> gettagvalstring(i)) or (Tags[i].empty) then begin
          Tags[i].valString := gettagvalstring(i);
          Tags[i].empty := false;
          Result := true;
        end;
    end;
  end;

  if (rvgLogIn) and (FTagStatusGood <> allgood) then begin
    FTagStatusGood := allgood;
    onTagStatusChanged( FTagStatusGood );
  end;

  if (blinkingBadStatus) and (rvgLogIn) and (not allgood) then
    Visible := not Visible;

end;


procedure TVisControl.onTagStatusChanged(good: Boolean);
begin
  // to be overridden
end;


procedure TVisControl.putColorGood(colorFont, colorBack1, colorBack2: TColor);
begin
  FGoodColorFont := colorFont;
  FGoodColorBack1 := colorBack1;
  FGoodColorBack2 := colorBack2;
end;


// old tag getters and setters
function TVisControl.gettagval(AIndex: integer): integer;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := Tags[AIndex].value
  else
    result := 0;
end;

function TVisControl.gettagidx(AIndex: integer): integer;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := Tags[AIndex].idx
  else
    result := 0;
end;

procedure TVisControl.settagval(AIndex, AValue: integer);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
      SetTagValue(Tags[AIndex].idx, AValue)
end;


// tag getters
function TVisControl.gettagvalbool(AIndex: integer): boolean;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := GetTagValueBool( Tags[AIndex].idx )
  else
    result := false;
end;

function TVisControl.gettagvalint(AIndex: integer): integer;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := GetTagValueInt( Tags[AIndex].idx )
  else
    result := 0;
end;

function TVisControl.gettagvallong(AIndex: integer): int64;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := GetTagValueLong( Tags[AIndex].idx )
  else
    result := 0;
end;

function TVisControl.gettagvaldouble(AIndex: integer): double;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then begin
    result := GetTagValueDouble( Tags[AIndex].idx );
    if IsNaN(result) or IsInfinite(result) then
      Result := 0.0;
  end else
    result := 0.0;
end;

function TVisControl.isTagNan(AIndex: integer): boolean;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then begin
    result := IsNaN(GetTagValueDouble( Tags[AIndex].idx )) or IsInfinite(GetTagValueDouble( Tags[AIndex].idx ));
  end else
    result := false;
end;

function TVisControl.gettagvalstring(AIndex: integer): string;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := GetTagValueString( Tags[AIndex].idx )
  else
    result := '';
end;

function TVisControl.istaggood(AIndex: integer): boolean;
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    result := (not rvgLogIn) or (IsTagStatusGood( Tags[AIndex].idx ))
  else
    result := false;
end;



// tag setters
procedure TVisControl.settagvalbool(AIndex: Integer; AValue: boolean);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    SetTagValueBool( Tags[AIndex].idx, AValue );
end;

procedure TVisControl.settagvalint(AIndex: Integer; AValue: integer);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    SetTagValueInt( Tags[AIndex].idx, AValue );
end;

procedure TVisControl.settagvallong(AIndex: Integer; AValue: int64);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    SetTagValueLong( Tags[AIndex].idx, AValue );
end;

procedure TVisControl.settagvaldouble(AIndex: Integer; AValue: double);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    SetTagValueDouble( Tags[AIndex].idx, AValue );
end;

procedure TVisControl.settagvalstring(AIndex: Integer; AValue: string);
begin
  if (AIndex>=0) and (AIndex<Length(Tags)) then
    SetTagValueString( Tags[AIndex].idx, AValue );
end;



function TVisControl.CompileScript(var Messages: string): boolean;
begin
  Result := true;
end;


procedure TVisControl.ExecuteScript;
begin
//
end;


procedure TVisControlEditor.Edit;
begin
  inherited;
  if ShowScriptEdit(Component as TVisControl) then
     Designer.Modified;
end;


procedure TVisControl.ExecuteProcessEvent;
begin
//  inherited;
  if Assigned(FScadaObjectProcessEvent) then
    FScadaObjectProcessEvent(self);

end;

end.
