unit VisButton;

interface

uses
{$ifdef VER150}
  DesignIntf, DesignEditors, DesignWindows, DsnConst,
{$else}
  DsgnIntf,
{$endif}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, stdctrls, ScadaBase, Buttons;


type

//  TSetTagValueEvent = procedure(TagIndex: integer; Value: integer) of object;
  TCanClickEvent = procedure(Sender: TObject; var Can: boolean) of object;
  TDownChangeEvent = procedure(Sender: TObject) of object;

  TVisButton = class(TCustomScadaObject)
  private
    { Private declarations }
//    FOnSetTagValue: TSetTagValueEvent;
    FCanClickEvent: TCanClickEvent;
    FDownChangeEvent: TDownChangeEvent;
    FCaptionUp: string;
    FCaptionDown: string;
    FQueryTextUp: string;
    FQueryTextDown: string;

    FTagName: TTagName;
//    FTagPath: TTagPath;
    FValueUp: integer;
    FValueDown: integer;
    FMask: integer;
    FAllowUp: boolean;

    // Поля изображения
    FButton: TSpeedButton;

  protected
    FTagIndex: integer;
    procedure SetButtonStatus(Value: integer);
    procedure SetCaptionUp(Value: string);
    procedure OnButtonClick(Sender: TObject);
  public
    { Public declarations }

    constructor Create(AOwner: TComponent); override;
    procedure Init; override;
    procedure Process; override;
  published
    { Published declarations }
    property TagName: TTagName read FTagName write FTagName;
    property TagIndex: integer read FTagIndex;
//    property TagPath: TTagPath read FTagPath write FTagPath;
    property ValueDown: integer read FValueDown write FValueDown;
    property ValueUp: integer read FValueUp write FValueUp;
    property Mask: integer read FMask write FMask;
    property CaptionUp: string read FCaptionUp write SetCaptionUp;
    property CaptionDown: string read FCaptionDown write FCaptionDown;
    property QueryTextUp: string read FQueryTextUp write FQueryTextUp;
    property QueryTextDown: string read FQueryTextDown write FQueryTextDown;

//    property OnSetTagValue: TSetTagValueEvent read FOnSetTagValue write FOnSetTagValue;
    property OnCanClick: TCanClickEvent read FCanClickEvent write FCanClickEvent;
    property OnDownChange: TDownChangeEvent read FDownChangeEvent write FDownChangeEvent;
    property Font;

    property objButton: TSpeedButton read FButton;
    property AllowUp: boolean read FAllowUp write FAllowUp;
  end;

procedure Register;

implementation
uses
  infodlg,
  TagStorage,
  ExtDlgs,
  RpVisualGlobal,
  RpVisualUtils,
  users;

procedure Register;
begin
  RegisterComponents('Scada', [TVisButton]);
end;

{ TVisualDevice }

constructor TVisButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 100;
  Height := 50;
  ShowHint := true;

  // Создание изображения
  FButton := TSpeedButton.Create(Self);
  FButton.Name := 'objButton';
  FButton.Parent := self;
  FButton.SetSubComponent(true);
  FButton.Visible := true;
  FButton.Align := alClient;
  FButton.GroupIndex := 1;
  FButton.AllowAllUp := true;
  FButton.OnClick := OnButtonClick;

  FAllowUp := true;
  
  FTagIndex := -1;
end;


procedure TVisButton.SetButtonStatus(Value: integer);
begin
  if ((Value = FValueDown) xor FButton.Down) then begin
    FButton.Down := (Value = FValueDown);
    if FButton.Down then
      FButton.Caption := FCaptionDown
    else
      FButton.Caption := FCaptionUp;
    if Assigned(OnDownChange) then
      OnDownChange(self);
  end;
end;


procedure TVisButton.SetCaptionUp(Value: string);
begin
  FCaptionUp := value;
  FButton.Caption := value;
end;



// INIT
procedure TVisButton.Init;
var
  _tagname: string;
begin
  inherited;
  
  _tagname := repl(TagName, TagIdRoot, TagRoot);
  FQueryTextUp := replaceAllMarkers(FQueryTextUp);
  FQueryTextDown := replaceAllMarkers(FQueryTextDown);

  FTagIndex := GetTagIndex( TagPath + '.' + _TagName );
  IsConnectionBad := (FTagIndex<0);
end;

// PROCESS HANDLER
procedure TVisButton.Process;
var
  value: integer;
begin
//  inherited;

  value := GetTagValue(FTagIndex);
  if FMask>0 then value:=value and FMask;
  SetButtonStatus(value);
  IsValueBad := (value < 0);
end;



procedure TVisButton.OnButtonClick(Sender: TObject);

  procedure set_new_value(value: integer);
  var
    old_val: integer;
  begin
    if FMask>0 then begin
      old_val := GetTagValue(FTagIndex);
      value := (old_val and ($FFFF-FMask)) + value;
    end;
    SetTagValue(FTagIndex, value);
  end;

var
  flag, can: boolean;
begin
  if not CheckAccess(PREVILEG_ZAPRET_BUTTON, true, true) then exit;

  if (not FButton.Down) and (not AllowUp) then begin
    exit;
  end;

  flag := FButton.Down;
  FButton.Down := not flag;


  if Assigned(OnCanClick) then begin
    can := true;
    OnCanClick(self, can);
    if not can then exit;
  end;


  if FTagIndex < 0 then exit;

  if flag then begin
    if sender <> nil then
      if length(FQueryTextDown) > 0 then
        if showInfoDlg(FQueryTextDown, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
          exit;
    set_new_value(FValueDown)
  end else begin
    if sender <> nil then
      if length(FQueryTextUp) > 0 then
        if showInfoDlg(FQueryTextUp, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
          exit;
    set_new_value(FValueUp)
  end;

  if Assigned(OnClick) then OnClick(Self);
end;


end.
