unit VisRadioButton;

interface

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

   
type
  TVisRadioButton = class(TVisControl)
    procedure PSScriptCompile(Sender: TPSScript);
    procedure PSScriptCompImport(Sender: TObject; x: TPSPascalCompiler);
    procedure PSScriptExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
    procedure PSScriptExecute(Sender: TPSScript);
  private
    FCanClickEvent: TCanClickEvent;
    FRadioButton: TRadioButton;
    FAutoUpdateApply: boolean;
    FApplying: boolean;

    FChangeTime: Cardinal;
    FChangeState: Boolean;

    FCheckQuery: string;

  protected
    CompiledScript: string;
    procedure OnControlMouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure ScriptProcess(ForceExecute: boolean);
    procedure RadioButtonEnter(Sender: TObject);

    procedure onTagStatusChanged(good: Boolean); override;

  public
    constructor Create(AOwner: TComponent); override;
    procedure Init; override;
    procedure Process; override;
    function IsApplying: boolean;
    function CompileScript(var Messages: string): boolean; override;
    procedure ExecuteScript;override;

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

    procedure DoApply;
    procedure DoUpdate;


  published
    property OnCanClick: TCanClickEvent read FCanClickEvent write FCanClickEvent;
    property AutoUpdateApply: boolean read FAutoUpdateApply write FAutoUpdateApply;
    property objRadioButton: TRadioButton read FRadioButton;

    property QueryCheck: string read FCheckQuery write FCheckQuery;

    property Align;
    property Anchors;
    property Enabled;
    property Visible;
  end;




procedure Register;

implementation
uses
  infodlg,
  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,
  RpVisualGlobal,
  RpVisualUtils,
  TagStorage,
  numbers,
  VisControlScriptEdit,
  hyperstr,
  Users;

var
  PSScript: TPSScript;
  PSScript_refcount: integer;
  PSVisRadioButton: TVisRadioButton;

  tmp_compile_src, tmp_compile_out: string;

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

{ TVisualDevice }

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

  // Создание метки
  FRadioButton := TRadioButton.Create(Self);
  FRadioButton.Name := 'objRadioButton';
  FRadioButton.Caption := '';
  FRadioButton.Parent := self;
  FRadioButton.Visible := true;
  FRadioButton.SetSubComponent(true);
  FRadioButton.OnMouseUp := OnControlMouseUp;
  FRadioButton.OnEnter := RadioButtonEnter;

  FRadioButton.Anchors := [akLeft, akTop, akRight, akBottom];

  Width := FRadioButton.Width;
  Height := FRadioButton.Height;

  FAutoUpdateApply := true;

  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;
  FRadioButton.OnMouseMove := OnMouseMove;
end;


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

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

  SetLength(Tags, FTagNames.Count);

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

    s:=FTagNames[i];

    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 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 := -1;
  end;

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

//  FCheckQuery := ReplaceStr(FCheckQuery, TagIdRoot, TagRoot);
//  FRadioButton.Caption := ReplaceStr(FRadioButton.Caption, TagIdRoot, TagRoot);

  FCheckQuery := replaceAllMarkers(FCheckQuery);
  FRadioButton.Caption := replaceAllMarkers(FRadioButton.Caption);

end;


// PROCESS HANDLER
procedure TVisRadioButton.Process;
begin
  if FAutoUpdateApply then begin
    FApplying := false;
    ScriptProcess(false);
    ExecuteProcessEvent;
  end;
end;

procedure TVisRadioButton.DoApply;
begin
  FApplying := true;
  ScriptProcess(true);
end;

procedure TVisRadioButton.DoUpdate;
begin
  FApplying := false;
  ScriptProcess(true);
end;

function TVisRadioButton.IsApplying: boolean;
begin
  result := FApplying;
end;

procedure TVisRadioButton.ScriptProcess(ForceExecute: boolean);
var
  fl: boolean;
begin
  IsValueBad := false;

  fl := updateTags();


  if (fl) or (not FExecuteOnTagChange) or (FApplying) or (ForceExecute) then begin

    if FScriptDefEnabled then
    begin
      // Обработчик по умолчанию (вместо скрипта)
      if FApplying then begin

        if (GetTickCount - FChangeTime) < 3000 then begin
          objRadioButton.Checked := FChangeState
        end else

        if objRadioButton.Checked then begin
          SetTagVal(0, 1);
          FChangeTime := GetTickCount;
          FChangeState := true;
        end else begin
          SetTagVal(0, 0);
          FChangeTime := GetTickCount;
          FChangeState := false;
        end;

      end else begin
        objRadioButton.Checked := gettagval(0) > 0;
      end;
    end;

    if FScriptEnabled then
      ExecuteScript;
  end;
end;


procedure TVisRadioButton.OnControlMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  Sibling: TControl;
  can: boolean;
begin
  if Assigned(OnCanClick) then begin
    can := true;
    OnCanClick(self, can);
    if not can then begin
      objRadioButton.Checked := not objRadioButton.Checked;
      exit;
    end;
  end;


  if (FScriptDefEnabled) and (gettagval(0) > 0) then
    exit;

  if not CheckAccess(PREVILEG_ZAPRET_RADIOBOX, true, true) then exit;

  if FCheckQuery <> '' then begin
    objRadioButton.Parent.SetFocus;
    objRadioButton.Checked := false;
    if not (showInfoDlg(FCheckQuery, mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
      exit;
    end;
    objRadioButton.Checked := true;
  end;

  if (objRadioButton.Checked) and (Parent <> nil) then
    with Parent do
      for i := 0 to ControlCount - 1 do begin
        Sibling := Controls[i];
        if (Sibling <> Self) and (Sibling is TVisRadioButton) then begin
          TVisRadioButton(Sibling).objRadioButton.Checked := False;
          if TVisRadioButton(Sibling).FAutoUpdateApply then
            TVisRadioButton(Sibling).DoApply;
        end;
      end;

  if FAutoUpdateApply then
    DoApply;

  OnDeviceClick(self);

end;


procedure TVisRadioButton.RadioButtonEnter(Sender: TObject);
begin
  if not CheckAccess(PREVILEG_ZAPRET_RADIOBOX, false, true) then
    begin
      (Sender as TRadioButton).Enabled := NOT (Sender as TRadioButton).Enabled;
      (Sender as TRadioButton).Enabled := NOT (Sender as TRadioButton).Enabled;
    end;

end;


procedure TVisRadioButton.setcolors(AFontColor: integer; ABackColor: integer);
begin
  objRadioButton.Font.Color := AFontColor;
end;


procedure TVisRadioButton.onTagStatusChanged(good: Boolean);
begin
  if (not FBadColorsEnabled) or (not rvgLogIn) then  exit;

  if good then begin
    objRadioButton.Font.Color := FGoodColorFont;
    objRadioButton.Color := FGoodColorBack1;
  end else begin
    putColorGood( objRadioButton.Font.Color, objRadioButton.Color, 0);
    objRadioButton.Font.Color := FBadColorFont;
    objRadioButton.Color := FBadColorBack;
  end;
end;


//==============================================================================
procedure TVisRadioButton.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 TVisRadioButton.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 TVisRadioButton.PSScriptCompile(Sender: TPSScript);
begin
  Sender.AddRegisteredPTRVariable('self', 'TVisRadioButton');
end;

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

function TVisRadioButton.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
    PSVisRadioButton := 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;
  end;

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

  result := True;
end;

procedure TVisRadioButton.ExecuteScript;
begin
  if IsCompileScriptOk then begin
    PSVisRadioButton := self;
    PSScript.SetCompiled(CompiledScript);
    PSScript.Execute;
  end;
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.
