unit VisLabel;

interface

uses
  DesignIntf, DesignEditors,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, stdctrls, uPSComponent, uPSCompiler, uPSRuntime,
  VisControl;

type
  TVisLabel = class(TVisControl)
    procedure PSScriptCompile(Sender: TPSScript);
    procedure PSScriptCompImport(Sender: TObject; x: TPSPascalCompiler);
    procedure PSScriptExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
    procedure PSScriptExecute(Sender: TPSScript); 
  protected
    FLabel: TLabel;
    FShape: TShape;

    procedure onTagStatusChanged(good: Boolean); override;
    function createLabel: TLabel; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Init; override;
    procedure Process; override;

    procedure setcolors(AFontColor: integer; ABackColor: integer);

    procedure FloatCaption(X: double; width, decimals: integer);

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

    procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);

  published
    property objLabel: TLabel read FLabel;
    property objShape: TShape read FShape;

    property Align;
    property Anchors;
    property Enabled;
    property Visible;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

//    property OnProcess;
  end;


//  TVisLabel_ScriptPropEdit =class(TClassProperty)
//  public
//    function GetAttributes: TPropertyAttributes; override;
//    procedure Edit; override;
//  end;
//
//  TVisLabelEditor = class(TComponentEditor)
//  public
//    procedure Edit; override;
//  end;



procedure Register;

implementation
uses
  uPSR_std,
  uPSC_std,
  uPSR_stdctrls,
  uPSC_stdctrls,
  uPSR_extctrls,
  uPSC_extctrls,
  uPSR_forms,
  uPSC_forms,
  uPSC_graphics,
  uPSC_controls,
  uPSC_classes,
  uPSR_graphics,
  uPSR_controls,
  uPSR_classes,
  uPSR_visscada,
  uPSC_visscada,
  RpVisualUtils,
  RpVisualGlobal,
  TagStorage,
  numbers,
  VisControlScriptEdit,
  hyperstr;

var
  PSScript: TPSScript;
  PSScript_refcount: integer;
  PSVisLabel: TVisLabel;

  tmp_compile_src, tmp_compile_out: string;

procedure Register;
begin
  RegisterComponents('Scada', [TVisLabel]);
  RegisterComponentEditor(TVisLabel, TVisControlEditor);
end;

{ TVisualDevice }

constructor TVisLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ShowHint := true;

  // Создание shape
  FShape := TShape.Create(Self);
  FShape.Name := 'objShape';
  FShape.Parent := self;
  FShape.Visible := true;
  FShape.SetSubComponent(true);
  FShape.OnMouseUp := ShapeMouseUp;

  // Создание метки
  FLabel := createLabel;
//  FLabel := TLabel.Create(Self);
  FLabel.Name := 'objLabel';
  FLabel.Caption := '';
  FLabel.Parent := self;
  FLabel.Visible := true;
  FLabel.SetSubComponent(true);
  FLabel.OnClick := OnDeviceClick;
  FLabel.OnDblClick := OnDeviceDblClick;

  Width := FLabel.Width;
  Height := FLabel.Height;

  if PSScript = nil then begin
    PSScript := TPSScript.Create(nil);
    PSScript.OnCompile := PSScriptCompile;
    PSScript.OnCompImport := PSScriptCompImport;
    PSScript.OnExecImport := PSScriptExecImport;
    PSScript.OnExecute := PSScriptExecute;
    inc(PSScript_refcount);
  end;

  FShape.OnMouseMove := OnMouseMove;
  FLabel.OnMouseMove := OnMouseMove;
end;


function TVisLabel.createLabel: TLabel;
begin
  result := TLabel.Create(Self);
//  result.Name := 'objLabel';
//  result.Caption := '';
//  result.Parent := self;
//  result.Visible := true;
//  result.SetSubComponent(true);
//  result.OnClick := OnDeviceClick;
//  result.OnDblClick := OnDeviceDblClick;
end;


// INIT
procedure TVisLabel.Init;
var
  s, _tags: string;
  i,k: integer;
  use_path: boolean;
begin
  inherited;

  _tags := '';
  TagRoot := trim(TagRoot);
  TagIdRoot := trim(TagIdRoot);
  TagPath := trim(TagPath);

  TagPath := ReplaceStr(TagPath, TagIdRoot, TagRoot);

  SetLength(Tags, FTagNames.Count);

  IsConnectionBad := false;
  for i:=0 to FTagNames.Count-1 do begin

    s:=FTagNames[i];

    use_path := true;
    if copy(s,1,1)='$' then begin
      use_path := false;
      delete(s,1,1);
    end;

    if length(TagRoot)>0 then begin
      k:=pos(TagIdRoot, s);
      if k>0 then begin
        delete(s, k, length(TagIdRoot));
        insert(TagRoot, s, k);
      end;
    end;

    if (use_path) and (length(TagPath)>0) then begin
      s := TagPath + '.' + s;
    end;

    _tags := _tags + s + ' ';
    Tags[i].idx := GetTagIndex(s);
    Tags[i].value := 0;

    if Tags[i].idx < 0 then
      _tags := _tags + s + '- NOT FOUND! ';

    IsConnectionBad := (IsConnectionBad) or (Tags[i].idx < 0);
  end;

  CompileScript(s);
  for i:=0 to length(Tags)-1 do begin
    Tags[i].value := 0;
    Tags[i].valLong := 0;
    Tags[i].valDouble := 0.0;
    Tags[i].valString := '';
  end;


  if FHint = '' then FHint := trim(Hint);
  if not(FHint='') then begin
    if debugTagNotFoundHint then
      Hint := FHint + #13 + 'Теги: ' + _tags
    else
      Hint := FHint;
  end;

  Hint := ReplaceStr(Hint, TagIdRoot, TagRoot);

//  updateTags();
//  ExecuteScript;
end;

// PROCESS HANDLER
procedure TVisLabel.Process;
var
  fl: boolean;
begin
//  if Assigned(OnProcess) then
//    OnProcess(self);

  IsValueBad := false;

  fl := updateTags();

  if (fl) or (not FExecuteOnTagChange) then
    ExecuteScript;

  ExecuteProcessEvent;
end;


procedure TVisLabel.FloatCaption(X: double; width, decimals: integer);
var
  s: string;
begin
  str(X:width:decimals, s);
  objLabel.Caption := trim(s);
end;

procedure TVisLabel.setcolors(AFontColor: integer; ABackColor: integer);
begin
  objLabel.Font.Color := AFontColor;
  objShape.Brush.Color := ABackColor;
end;


procedure TVisLabel.onTagStatusChanged(good: Boolean);
begin
  if (not FBadColorsEnabled) then  exit;

  if good then begin
    objLabel.Font.Color := FGoodColorFont;

    objLabel.Color := FGoodColorBack1 and $FFFFFF;
    objLabel.Transparent := (FGoodColorBack1 and $1000000) > 0;

    objShape.Brush.Color := FGoodColorBack2 and $FFFFFF;
    if (FGoodColorBack2 and $1000000) > 0 then
      objShape.Brush.Style := bsClear;

  end else begin
    putColorGood(
          objLabel.Font.Color,
          objLabel.Color + iif(objLabel.Transparent, $1000000, 0),
          objShape.Brush.Color + iif(objShape.Brush.Style = bsClear, $1000000, 0));

    objLabel.Font.Color := FBadColorFont;
    objLabel.Color := FBadColorBack;
    objLabel.Transparent := False;
    objShape.Brush.Color := FBadColorBack;
  end;
end;


//==============================================================================
procedure TVisLabel.PSScriptCompImport(Sender: TObject; x: TPSPascalCompiler);
begin
  SIRegister_Std(x);
  SIRegister_Classes(x, true);
  SIRegister_Graphics(x, true);
  SIRegister_Controls(x);
  SIRegister_stdctrls(x);
  SIRegister_extctrls(x);
  SIRegister_Forms(x);
  SIRegister_visscada(x);
end;

procedure TVisLabel.PSScriptExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_extctrls(x);
  RIRegister_Forms(x);
  RIRegister_visscada(x);
end;

procedure TVisLabel.PSScriptCompile(Sender: TPSScript);
begin
  Sender.AddRegisteredPTRVariable('self', 'TVisLabel');
end;

procedure TVisLabel.PSScriptExecute(Sender: TPSScript);
begin
  Sender.SetPointerToData('self', @PSVisLabel, sender.FindNamedType('TVisLabel'));
end;

function TVisLabel.CompileScript(var Messages: string): boolean;
var
  i: integer;
begin
  if SameText(tmp_compile_src, Script.Text) then begin
    CompiledScript := tmp_compile_out;
    IsCompileScriptOk := true;
  end else begin
    try
      PSVisLabel := self;
      PSScript.Script.Text := Script.Text;
      IsCompileScriptOk := PSScript.Compile;

      if IsCompileScriptOk then begin
        PSScript.GetCompiled(CompiledScript);
        tmp_compile_src := Script.Text;
        tmp_compile_out := CompiledScript;
      end;

      Messages := '';
      for i:=0 to PSScript.CompilerMessageCount-1 do
        Messages := Messages + PSScript.CompilerMessages[i].MessageToString + #13#10;
    except
      on E: Exception do begin
        Messages := Messages + E.Message + #13#10;
      end;
    end;
  end;

  if IsCompileScriptOk then
    Messages := Messages + 'Successfully compiled!'#13#10;

  result := True;
end;

procedure TVisLabel.ExecuteScript;
begin
  if IsCompileScriptOk then begin
    PSVisLabel := self;
    PSScript.SetCompiled(CompiledScript);
    PSScript.Execute;
  end;
end;



procedure TVisLabel.ShapeMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(OnClick) then Onclick(self);
end;

initialization
  PSScript := nil;
  PSScript_refcount := 0;

  tmp_compile_src := '*';
  tmp_compile_out := '';

finalization
  dec(PSScript_refcount);
  if PSScript_refcount = 0 then begin
    PSScript.Free;
    PSScript := nil;
  end;

end.
