unit fmuStatus;

////////////////////////////////////////////////////////////////////////////////////////////////////
//                                                             //
////////////////////////////////////////////////////////////////////////////////////////////////////

interface

uses

  // VLC
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComObj, ActiveX,
  // This
  untUtil,
  untType,
  xObj;

type

  { TfmStatus }

  TfmStatus = class(TForm)
    Panel2: TPanel;
    pnlDescription: TPanel;
    Shape1: TShape;
    lblResultCode: TLabel;
    lblResultDescription: TLabel;
    edtResultCode: TEdit;
    edtResultDescription: TEdit;
    Panel4: TPanel;
    pnlStatus: TPanel;
    Panel12: TPanel;
    LBoxStatus: TMemo;
    pnlButtons: TPanel;
    btnGetStatus: TButton;
    btnTerminateWaiting: TButton;
    btnClose: TButton;
    Panel1: TPanel;
    chbDeviceEnabled: TCheckBox;
    btnGetServerStatus: TButton;
    procedure btnClearClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure EditorClick(Sender: TObject);
    procedure EditorChange(Sender: TObject);
  private
    function ChangePropertyValue(Sender: TObject): Boolean;
    procedure PerformMethodValue(Sender: TObject);
    procedure UpdateControls;
    procedure PerformEnableControls(Value: Boolean);
    procedure Init(ADriver: TObjX; AShowMessage: Boolean; AFont: TFont);
  private
    fDriver: TObjX;
    fShowMessage: Boolean;
    property Driver: TObjX read fDriver;
    function DriverException(E: Exception): Boolean;
  private
    procedure UpdateObject_DeviceEnabled;
    procedure Perfrom_GetStatus;
    procedure Perfrom_GetServerStatus;
    procedure Perform_TerminateWaiting;
    procedure UpdateLBox;
    procedure UpdateLBoxServer;
  end;

procedure ExecuteStatusDialog(ADriver: TObjX; AShowMessage: Boolean; AFont: TFont);

implementation

{$R *.DFM}

procedure ExecuteStatusDialog(ADriver: TObjX; AShowMessage: Boolean; AFont: TFont);
var
  fm: TfmStatus;
begin
  fm := TfmStatus.Create(nil);
  try
    with fm do
    begin
      Init(ADriver, AShowMessage, AFont);
      ShowModal;
    end;
  finally
    fm.Free;
  end;
end;

procedure TfmStatus.Init(ADriver: TobjX; AShowMessage: Boolean; AFont: TFont);
begin
  fShowMessage := AShowMessage;
  fDriver := ADriver;
  Font := AFont;
  UpdateControls;
end;

(****************************      ********************************)

function TfmStatus.DriverException(E: Exception): Boolean;
begin
  Result := (E is EOleSysError)
    and (ResultFacility(EOleSysError(E).ErrorCode) = FACILITY_ITF);
  if Result then
  begin
    if fShowMessage then
    begin
      with Application do
        MessageBox(PChar(E.Message), PChar(Title), mb_IconStop or mb_Ok);
    end;
  end
  else
  begin
    if E is EConvertError then
    begin
      E.Message := '    .' + #13 +
        ': ' + E.Message;
      Result := not fShowMessage;
    end;
  end;
end;

function TfmStatus.ChangePropertyValue(Sender: TObject): Boolean;
begin
  Result := True;
  try
    try
      if Sender = chbDeviceEnabled then UpdateObject_DeviceEnabled;
    finally
      UpdateControls;
    end;
  except
    on E: Exception do
    begin
      Result := False;
      if (Sender is TWinControl)
         and (TWinControl(Sender).Visible)
         and (TWinControl(Sender).Enabled) then TWinControl(Sender).SetFocus;
      if not DriverException(E) then raise;
    end;
  end;
end;

procedure TfmStatus.PerformMethodValue(Sender: TObject);
begin
  try
    try
      if Sender = btnGetStatus then Perfrom_GetStatus
      else if Sender = btnGetServerStatus then Perfrom_GetServerStatus
      else if Sender = btnTerminateWaiting then Perform_TerminateWaiting;
    finally
      UpdateControls;
    end;
   except
    on E: Exception do
    begin
      if (Sender is TWinControl)
         and TWinControl(Sender).Visible
         and (TWinControl(Sender).Enabled) then TWinControl(Sender).SetFocus;
      if not DriverException(E) then raise;
    end;
  end;
end;

procedure TfmStatus.UpdateControls;
var
  V: OleVariant;
begin
  V := Driver.ControlInterface;
  SafeSetEdit(edtResultCode, IntToStr(V.ResultCode));
  SafeSetEdit(edtResultDescription, V.ResultDescription);
  SafeSetChecked(chbDeviceEnabled, V.DeviceEnabled);
end;

procedure TfmStatus.PerformEnableControls(Value: Boolean);
begin
  lblResultCode.Enabled := Value;
  edtResultCode.Enabled := Value;
  lblResultDescription.Enabled := Value;
  edtResultDescription.Enabled := Value;
  chbDeviceEnabled.Enabled := Value;
  btnClose.Enabled := Value;
  btnGetStatus.Enabled := Value;
  btnGetServerStatus.Enabled := Value;
  btnTerminateWaiting.Enabled := not btnGetStatus.Enabled;
end;

procedure TfmStatus.UpdateLBox;
var
  I, cnt: Integer;
  vl, IsErr: Boolean;
  V: OleVariant;
begin
  V := Driver.ControlInterface;
  cnt := V.StatusErrorCount;
  IsErr := False;
  LBoxStatus.Lines.Add('');
  for I := 0 to cnt - 1 do
  begin
    V.StatusErrorIndex := I;
    vl := V.StatusErrorValue;
    if vl then IsErr := True;
    LBoxStatus.Lines.Add(format('    (%d) %s - %s',
      [I, V.StatusErrorDescription, BOOLSTR[vl]]));
  end;
  if IsErr then LBoxStatus.Lines.Insert(0, '   []')
    else LBoxStatus.Lines.Insert(0, '   [ ]');
end;

procedure TfmStatus.UpdateLBoxServer;
var
  V: OleVariant;
begin
  V := Driver.ControlInterface;
  with LBoxStatus.Lines do
  begin
    Add(format('  [%s]', [V.ServerDescription]));
    Add('');
    Add(format('     - %s',   [V.DeviceDescription]));
    Add(format('      - %s', [PortNumberToStr(V.PortNumber)]));
    if (V.PortNumber <= 32) then Add(format('      - %s', [BaudrateToStr[IntToEnumBaudRate(V.BaudRate)]]));
  end;
end;

(*************************************    ******************************************)

procedure TfmStatus.UpdateObject_DeviceEnabled;
begin
  Driver.ControlInterface.DeviceEnabled := chbDeviceEnabled.Checked;
end;

procedure TfmStatus.Perfrom_GetStatus;
begin
  LBoxStatus.Clear;
  PerformEnableControls(False);
  try
    Driver.ControlInterface.GetStatus;
    UpdateLBox;
  finally
    PerformEnableControls(True);
  end;
end;

procedure TfmStatus.Perfrom_GetServerStatus;
begin
  LBoxStatus.Clear;
  PerformEnableControls(False);
  try
    Driver.ControlInterface.CheckServerState;
    UpdateLBoxServer;
  finally
    PerformEnableControls(True);
  end;
end;

procedure TfmStatus.Perform_TerminateWaiting;
begin
  Driver.ControlInterface.TerminateWaiting
end;

(************************************   *****************************************)

procedure TfmStatus.EditorClick(Sender: TObject);
begin
  PerformMethodValue(Sender);
end;

procedure TfmStatus.EditorChange(Sender: TObject);
begin
  ChangePropertyValue(Sender);
end;

procedure TfmStatus.btnClearClick(Sender: TObject);
begin
  LBoxStatus.Clear;
end;

procedure TfmStatus.btnCloseClick(Sender: TObject);
begin
  Close;
end;

end.
