unit VisComboBox;

interface

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

type
  TVisComboBox = 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;
    FComboBox: TComboBox;
    FAutoUpdateApply: boolean;
    FApplying: boolean;
    FControlChangeDisabled: boolean;

  protected
    procedure OnControlChange(Sender: TObject);

    procedure ComboBoxDropDown(Sender: TObject);
    procedure ComboBoxEnter(Sender: TObject);
    procedure ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ComboBoxKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ScriptProcess(ForceExecute: boolean);

    procedure onTagStatusChanged(good: Boolean); override;

  public
    constructor Create(AOwner: TComponent); override;
    procedure Init; override;
    procedure Process; override;
    function IsApplying: boolean;

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

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

    procedure DoApply;
    procedure DoUpdate;

  published
    property OnCanClick: TCanClickEvent read FCanClickEvent write FCanClickEvent;
    property AutoUpdateApply: boolean read FAutoUpdateApply write FAutoUpdateApply;
    property objComboBox: TComboBox read FComboBox;

    property Align;
    property Anchors;
    property Enabled;
    property Visible;
  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,
  RpVisualGlobal,
  TagStorage,
  numbers,
  VisControlScriptEdit,
  hyperstr, Users;

var
  PSScript: TPSScript;
  PSScript_refcount: integer;
  PSVisComboBox: TVisComboBox;

  tmp_compile_src, tmp_compile_out: string;

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

{ TVisualDevice }

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

  // Создание метки
  FComboBox := TComboBox.Create(Self);
  FComboBox.Name := 'objCheckBox';
  FComboBox.Text := '';
  FComboBox.Parent := self;
  FComboBox.Visible := true;
  FComboBox.SetSubComponent(true);
  FComboBox.OnChange := OnControlChange;
  FComboBox.OnDropDown := ComboBoxDropDown;
  FComboBox.OnEnter := ComboBoxEnter;
  FComboBox.OnKeyDown := ComboBoxKeyDown;
  FComboBox.OnKeyUp := ComboBoxKeyUp;
  FComboBox.Anchors := [akLeft, akTop, akRight, akBottom];

  Width := FComboBox.Width;
  Height := FComboBox.Height;

  FAutoUpdateApply := true;
  FControlChangeDisabled := false;

  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;
end;


// INIT
procedure TVisComboBox.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;

end;


// PROCESS HANDLER
procedure TVisComboBox.Process;
begin
  if not FAutoUpdateApply then 
    exit;

  if objComboBox.DroppedDown then 
    exit;

  FApplying := false;
  ScriptProcess(false);
end;

procedure TVisComboBox.DoApply;
begin
  if FControlChangeDisabled then exit;

  FApplying := true;
  ScriptProcess(true);
  ExecuteProcessEvent;
end;

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

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

procedure TVisComboBox.ScriptProcess(ForceExecute: boolean);
var
  fl: boolean;
begin
  FControlChangeDisabled := true;
  IsValueBad := false;
  fl := updateTags();

  if FScriptDefEnabled then
    begin
      // Обработчик по умолчанию (вместо скрипта)
      if FApplying then begin
        SetTagVal(0, objComboBox.ItemIndex)
      end else
        if objComboBox.ItemIndex < objComboBox.Items.Count then
          objComboBox.ItemIndex := gettagval(0);
    end;


  if (fl) or (not FExecuteOnTagChange) or (FApplying) or (ForceExecute) then begin
    if FScriptEnabled then
      ExecuteScript;
  end;

  FControlChangeDisabled := false;
end;



procedure TVisComboBox.OnControlChange(Sender: TObject);
var
  can: boolean;
begin
  if Assigned(OnCanClick) then begin
    FAutoUpdateApply := false;
    can := true;
    OnCanClick(self, can);
    FAutoUpdateApply := true;
    if not can then begin
      exit;
    end;
  end;

  if not CheckAccess(PREVILEG_ZAPRET_COMBOBOX, true, true) then Exit;

  if FAutoUpdateApply then DoApply;
  OnDeviceClick(sender);
end;

//Забиваем попытки редактирования
procedure TVisComboBox.ComboBoxDropDown(Sender: TObject);
begin
  if not CheckAccess(PREVILEG_ZAPRET_COMBOBOX, false, true) then
    begin
      (Sender as TComboBox).Enabled := NOT (Sender as TComboBox).Enabled;
      (Sender as TComboBox).Enabled := NOT (Sender as TComboBox).Enabled;
    end;
end;
procedure TVisComboBox.ComboBoxEnter(Sender: TObject);
begin
  if not CheckAccess(PREVILEG_ZAPRET_COMBOBOX, false, true) then
    begin
      (Sender as TComboBox).Enabled := NOT (Sender as TComboBox).Enabled;
      (Sender as TComboBox).Enabled := NOT (Sender as TComboBox).Enabled;
    end;
end;
procedure TVisComboBox.ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if not CheckAccess(PREVILEG_ZAPRET_COMBOBOX, false, true) then
    key := 0;
end;
procedure TVisComboBox.ComboBoxKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if CheckAccess(PREVILEG_ZAPRET_COMBOBOX, false, true) then
    key := 0;
end;


procedure TVisComboBox.setcolors(AFontColor: integer; ABackColor: integer);
begin
  objComboBox.Font.Color := AFontColor;
end;


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

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


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

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

function TVisComboBox.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
    PSVisComboBox := 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 TVisComboBox.ExecuteScript;
begin
  if IsCompileScriptOk then begin
    PSVisComboBox := 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.
