Plancia/uMain.pas

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Buttons,
  System.Generics.Collections, System.Win.Registry, System.StrUtils,
  uModbusRTU, uGauge;

type
  TMainForm = class(TForm)
    pnlTop: TPanel;
    lblPort: TLabel;
    cboPort: TComboBox;
    lblBaud: TLabel;
    cboBaud: TComboBox;
    btnConnect: TButton;
    lblStatus: TLabel;
    lblSlaveRele: TLabel;
    edtSlaveRele: TEdit;
    lblSlaveIO: TLabel;
    edtSlaveIO: TEdit;
    lblSlaveAnalog: TLabel;
    edtSlaveAnalog: TEdit;
    pgcMain: TPageControl;
    tsInterruttori: TTabSheet;
    tsPulsanti: TTabSheet;
    tsInputs: TTabSheet;
    tsAnalog: TTabSheet;
    pnlInterruttori: TPanel;
    pnlPulsanti: TPanel;
    pnlInputs: TPanel;
    pnlAnalog: TPanel;
    mmoLog: TMemo;
    tmrPoll: TTimer;
    CBReadInput: TCheckBox;
    CBReadAnalog: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure tmrPollTimer(Sender: TObject);
  private
    FModbus: TModbusRTU;
    FSwitchButtons: array[0..15] of TSpeedButton;
    FPulseButtons: array[0..15] of TSpeedButton;
    FInputShapes: array[0..7] of TShape;
    FInputLabels: array[0..7] of TLabel;
    FAnalogLabels: array[0..3] of TLabel;
    FAnalogGauges: array[0..3] of TTankGauge;
    /// Ultimo stato mostrato per ogni ingresso, per registrare a log solo le
    /// transizioni: un contatto che si chiude e' un evento, non un livello.
    FInputState: array[0..7] of Boolean;
    FInputValid: array[0..7] of Boolean;
    /// Ultimo errore gia' registrato, per non riempire il log con lo stesso
    /// messaggio due volte al secondo finche' il bus resta muto.
    FInputErr: string;
    FAnalogErr: string;
    procedure Log(const AMsg: string);
    procedure SetInputVisual(AIndex: Integer; AValid, AClosed: Boolean);
    procedure InvalidateInputs;
    procedure BuildSwitchControls;
    procedure BuildPulseControls;
    procedure BuildInputControls;
    procedure BuildAnalogControls;
    procedure SwitchButtonClick(Sender: TObject);
    procedure PulseButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PulseButtonMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetPulseState(ABtn: TSpeedButton; AOn: Boolean);
    procedure UpdateButtonVisual(ABtn: TSpeedButton; AOn: Boolean);
    procedure SetConnectedState(AConnected: Boolean);
  public
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

type
  /// Scalatura di un canale analogico: dal valore grezzo del registro Modbus
  /// al valore ingegneristico mostrato dal gauge.
  TAnalogCfg = record
    Title: string;
    RawMin: Integer;
    RawMax: Integer;
    EngMin: Double;
    EngMax: Double;
    Units: string;
    WarnBelow: Double;
    WarnAbove: Double;
  end;

const
  GRID_COLS = 4;
  CTRL_W = 90;
  CTRL_H = 30;
  MARGIN = 12;
  HDR_H = 24;
  GAUGE_W = 130;
  GAUGE_H = 200;
  // Passo fra una spia d'ingresso e l'altra: deve stare larga la didascalia
  // su due righe, altrimenti le scritte si accavallano.
  INPUT_SPACING = 84;

  // Configurazione dei 4 canali analogici. RawMin/RawMax vanno allineati al
  // fondo scala del modulo (4095 = ADC a 12 bit); EngMin/EngMax sono i valori
  // reali corrispondenti. WarnBelow/WarnAbove colorano di rosso la colonna.
  ANALOG_CFG: array[0..3] of TAnalogCfg = (
    (Title: 'Temperatura'; RawMin: 0; RawMax: 4095;
     EngMin: 0; EngMax: 120; Units: '°C';
     WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: 100),
    (Title: 'Livello serbatoio'; RawMin: 0; RawMax: 4095;
     EngMin: 0; EngMax: 100; Units: '%';
     WarnBelow: 15; WarnAbove: GAUGE_NO_WARN_HI),
    (Title: 'Canale 2'; RawMin: 0; RawMax: 4095;
     EngMin: 0; EngMax: 100; Units: '%';
     WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: GAUGE_NO_WARN_HI),
    (Title: 'Canale 3'; RawMin: 0; RawMax: 4095;
     EngMin: 0; EngMax: 100; Units: '%';
     WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: GAUGE_NO_WARN_HI)
  );

  // Etichette dei pulsanti momentanei: stringa vuota = 'Canale N'.
  // Es.: impostare PULSE_NAMES[0] := 'Horn' per il canale 0.
  PULSE_NAMES: array[0..15] of string = (
    '', '', '', '', '', '', '', '',
    '', '', '', '', '', '', '', ''
  );

/// Le porte realmente presenti, lette dal registro di Windows. Elencarle a
/// mano significa non vedere l'adattatore USB quando si presenta con un numero
/// diverso da quelli previsti.
procedure EnumSerialPorts(AList: TStrings);
var
  Reg: TRegistry;
  Names: TStringList;
  Name: string;
begin
  AList.Clear;
  Reg := TRegistry.Create(KEY_READ);
  Names := TStringList.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
    begin
      Reg.GetValueNames(Names);
      for Name in Names do
        AList.Add(Reg.ReadString(Name));
      Reg.CloseKey;
    end;
  finally
    Names.Free;
    Reg.Free;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  EnumSerialPorts(cboPort.Items);
  if cboPort.Items.Count = 0 then
    // Nessuna porta trovata: meglio una lista di ripiego che una casella vuota.
    for I := 1 to 10 do
      cboPort.Items.Add('COM' + IntToStr(I));
  I := cboPort.Items.IndexOf('COM7');
  if I < 0 then
    I := 0;
  cboPort.ItemIndex := I;

  cboBaud.Items.CommaText := '9600,19200,38400,57600,115200';
  cboBaud.ItemIndex := 0;

  edtSlaveRele.Text := '1';
  edtSlaveIO.Text := '2';
  edtSlaveAnalog.Text := '5';

  BuildSwitchControls;
  BuildPulseControls;
  BuildInputControls;
  BuildAnalogControls;

  SetConnectedState(False);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  tmrPoll.Enabled := False;
  if Assigned(FModbus) then
  begin
    FModbus.Disconnect;
    FModbus.Free;
  end;
end;

procedure TMainForm.Log(const AMsg: string);
begin
  mmoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + '  ' + AMsg);
end;

function ChannelCaption(AIndex: Integer): string;
begin
  if PULSE_NAMES[AIndex] <> '' then
    Result := PULSE_NAMES[AIndex]
  else
    Result := 'Canale ' + IntToStr(AIndex);
end;

procedure TMainForm.BuildSwitchControls;
var
  I, Row, Col: Integer;
  Hdr: TLabel;
  Btn: TSpeedButton;
begin
  Hdr := TLabel.Create(Self);
  Hdr.Parent := pnlInterruttori;
  Hdr.Caption := 'Il canale resta chiuso finché il pulsante è premuto giù.';
  Hdr.Left := MARGIN;
  Hdr.Top := MARGIN;

  for I := 0 to 15 do
  begin
    Row := I div GRID_COLS;
    Col := I mod GRID_COLS;
    Btn := TSpeedButton.Create(Self);
    Btn.Parent := pnlInterruttori;
    Btn.Caption := 'Canale ' + IntToStr(I);
    Btn.Left := MARGIN + Col * (CTRL_W + MARGIN);
    Btn.Top := HDR_H + MARGIN + Row * (CTRL_H + 6);
    Btn.Width := CTRL_W;
    Btn.Height := CTRL_H;
    Btn.Tag := I;
    // GroupIndex univoco + AllowAllUp: il pulsante resta premuto e si sgancia
    // al click successivo, senza influenzare gli altri canali.
    Btn.GroupIndex := I + 1;
    Btn.AllowAllUp := True;
    Btn.Down := False;
    Btn.OnClick := SwitchButtonClick;
    FSwitchButtons[I] := Btn;
    UpdateButtonVisual(Btn, False);
  end;
end;

procedure TMainForm.BuildPulseControls;
var
  I, Row, Col: Integer;
  Hdr: TLabel;
  Btn: TSpeedButton;
begin
  Hdr := TLabel.Create(Self);
  Hdr.Parent := pnlPulsanti;
  Hdr.Caption := 'Il canale resta chiuso solo mentre il pulsante è premuto ' +
    '(contatto momentaneo, es. horn).';
  Hdr.Left := MARGIN;
  Hdr.Top := MARGIN;

  for I := 0 to 15 do
  begin
    Row := I div GRID_COLS;
    Col := I mod GRID_COLS;
    Btn := TSpeedButton.Create(Self);
    Btn.Parent := pnlPulsanti;
    Btn.Caption := ChannelCaption(I);
    Btn.Left := MARGIN + Col * (CTRL_W + MARGIN);
    Btn.Top := HDR_H + MARGIN + Row * (CTRL_H + 6);
    Btn.Width := CTRL_W;
    Btn.Height := CTRL_H;
    Btn.Tag := I;
    // Nessun GroupIndex: il pulsante non resta giù. Il comando è legato a
    // MouseDown/MouseUp, non a OnClick, per chiudere e riaprire il contatto.
    Btn.OnMouseDown := PulseButtonMouseDown;
    Btn.OnMouseUp := PulseButtonMouseUp;
    FPulseButtons[I] := Btn;
    UpdateButtonVisual(Btn, False);
  end;
end;

procedure TMainForm.UpdateButtonVisual(ABtn: TSpeedButton; AOn: Boolean);
begin
  ABtn.ParentFont := False;
  if AOn then
  begin
    ABtn.Font.Style := [fsBold];
    ABtn.Font.Color := clGreen;
  end
  else
  begin
    ABtn.Font.Style := [];
    ABtn.Font.Color := clWindowText;
  end;
end;

procedure TMainForm.BuildInputControls;
var
  I: Integer;
  Shp: TShape;
  Lbl: TLabel;
  Hdr: TLabel;
begin
  Hdr := TLabel.Create(Self);
  Hdr.Parent := pnlInputs;
  Hdr.Caption := 'Contatto chiuso = spia verde. Grigio = aperto. ' +
    'Bordo rosso = dato non disponibile, non fidarsi di quello che mostra.';
  Hdr.Left := MARGIN;
  Hdr.Top := MARGIN;

  for I := 0 to 7 do
  begin
    Shp := TShape.Create(Self);
    Shp.Parent := pnlInputs;
    Shp.Shape := stCircle;
    Shp.Width := 24;
    Shp.Height := 24;
    Shp.Left := MARGIN + I * INPUT_SPACING;
    Shp.Top := HDR_H + MARGIN;
    FInputShapes[I] := Shp;

    // La serigrafia del modulo parte da DI1, i canali Modbus da 0: tenere
    // tutti e due sotto gli occhi evita di sbagliare morsetto in barca.
    Lbl := TLabel.Create(Self);
    Lbl.Parent := pnlInputs;
    Lbl.Left := Shp.Left;
    Lbl.Top := Shp.Top + 30;
    FInputLabels[I] := Lbl;

    FInputValid[I] := False;
    FInputState[I] := False;
    SetInputVisual(I, False, False);
  end;
end;

/// Distingue tre casi, non due: chiuso, aperto, e "non lo so". Un bus caduto
/// non deve somigliare a un contatto aperto.
procedure TMainForm.SetInputVisual(AIndex: Integer; AValid, AClosed: Boolean);
var
  Shp: TShape;
begin
  Shp := FInputShapes[AIndex];
  if not AValid then
  begin
    Shp.Brush.Color := clSilver;
    Shp.Pen.Color := clRed;
    Shp.Pen.Width := 2;
    FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'n/d', [AIndex + 1, AIndex]);
  end
  else if AClosed then
  begin
    Shp.Brush.Color := clLime;
    Shp.Pen.Color := clGreen;
    Shp.Pen.Width := 1;
    FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'CHIUSO', [AIndex + 1, AIndex]);
  end
  else
  begin
    Shp.Brush.Color := clGray;
    Shp.Pen.Color := clBlack;
    Shp.Pen.Width := 1;
    FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'aperto', [AIndex + 1, AIndex]);
  end;
end;

procedure TMainForm.InvalidateInputs;
var
  I: Integer;
begin
  for I := 0 to 7 do
  begin
    FInputValid[I] := False;
    SetInputVisual(I, False, False);
  end;
end;

function RawToEng(AIndex: Integer; ARaw: Word): Double;
var
  Cfg: TAnalogCfg;
begin
  Cfg := ANALOG_CFG[AIndex];
  if Cfg.RawMax = Cfg.RawMin then
    Exit(Cfg.EngMin);
  Result := Cfg.EngMin +
    (Integer(ARaw) - Cfg.RawMin) * (Cfg.EngMax - Cfg.EngMin) /
    (Cfg.RawMax - Cfg.RawMin);
end;

procedure TMainForm.BuildAnalogControls;
var
  I: Integer;
  Lbl: TLabel;
  Gauge: TTankGauge;
begin
  // Il gauge è un TGraphicControl: senza doppio buffering la colonna
  // sfarfalla ad ogni ciclo di polling.
  pnlAnalog.DoubleBuffered := True;

  for I := 0 to 3 do
  begin
    Gauge := TTankGauge.Create(Self);
    Gauge.Parent := pnlAnalog;
    Gauge.Left := MARGIN + I * (GAUGE_W + MARGIN);
    Gauge.Top := MARGIN;
    Gauge.Width := GAUGE_W;
    Gauge.Height := GAUGE_H;
    Gauge.Title := ANALOG_CFG[I].Title;
    Gauge.Units := ANALOG_CFG[I].Units;
    Gauge.SetRange(ANALOG_CFG[I].EngMin, ANALOG_CFG[I].EngMax);
    Gauge.SetWarnings(ANALOG_CFG[I].WarnBelow, ANALOG_CFG[I].WarnAbove);
    FAnalogGauges[I] := Gauge;

    // Sotto al gauge resta il valore grezzo letto dal registro.
    Lbl := TLabel.Create(Self);
    Lbl.Parent := pnlAnalog;
    Lbl.Caption := 'Registro: --';
    Lbl.Left := Gauge.Left;
    Lbl.Top := Gauge.Top + GAUGE_H + 4;
    FAnalogLabels[I] := Lbl;
  end;
end;

procedure TMainForm.SetConnectedState(AConnected: Boolean);
var
  I: Integer;
begin
  if not AConnected then
  begin
    // Senza polling i valori a video sarebbero fermi all'ultima lettura.
    for I := 0 to 3 do
    begin
      FAnalogGauges[I].Valid := False;
      FAnalogLabels[I].Caption := 'Registro: --';
    end;
    InvalidateInputs;
  end;

  if AConnected then
  begin
    btnConnect.Caption := 'Disconnetti';
    lblStatus.Caption := 'Stato: Connesso';
    lblStatus.Font.Color := clGreen;
  end
  else
  begin
    btnConnect.Caption := 'Connetti';
    lblStatus.Caption := 'Stato: Disconnesso';
    lblStatus.Font.Color := clRed;
  end;
  cboPort.Enabled := not AConnected;
  cboBaud.Enabled := not AConnected;
  tmrPoll.Enabled := AConnected;
end;

procedure TMainForm.btnConnectClick(Sender: TObject);
begin
  if Assigned(FModbus) and FModbus.IsConnected then
  begin
    FModbus.Disconnect;
    FreeAndNil(FModbus);
    SetConnectedState(False);
    Log('Disconnesso.');
    Exit;
  end;

  try
    FModbus := TModbusRTU.Create(cboPort.Text, StrToInt(cboBaud.Text), 500);
    FModbus.Connect;
    SetConnectedState(True);
    Log('Connesso a ' + cboPort.Text + ' @ ' + cboBaud.Text + ' baud.');
  except
    on E: Exception do
    begin
      Log('ERRORE connessione: ' + E.Message);
      FreeAndNil(FModbus);
      SetConnectedState(False);
    end;
  end;
end;

procedure TMainForm.SwitchButtonClick(Sender: TObject);
var
  Btn: TSpeedButton;
  Idx: Integer;
  SlaveAddr: Integer;
begin
  Btn := TSpeedButton(Sender);
  UpdateButtonVisual(Btn, Btn.Down);

  if not (Assigned(FModbus) and FModbus.IsConnected) then
  begin
    Log('Impossibile comandare il relè: non connesso.');
    //Btn.Down := not Btn.Down;
    //UpdateButtonVisual(Btn, Btn.Down);
    Exit;
  end;

  Idx := Btn.Tag;
  SlaveAddr := StrToIntDef(edtSlaveRele.Text, 1);
  try
    FModbus.WriteSingleCoil(SlaveAddr, Idx, Btn.Down);
    Log(Format('Interruttore canale %d -> %s', [Idx, BoolToStr(Btn.Down, True)]));
  except
    on E: Exception do
    begin
      Log('ERRORE scrittura relè: ' + E.Message);
      Btn.Down := not Btn.Down;
      UpdateButtonVisual(Btn, Btn.Down);
    end;
  end;
end;

procedure TMainForm.PulseButtonMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    SetPulseState(TSpeedButton(Sender), True);
end;

procedure TMainForm.PulseButtonMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // Il mouse è catturato dal pulsante: il MouseUp arriva anche se il cursore
  // è stato trascinato fuori, quindi il contatto viene sempre riaperto.
  if Button = mbLeft then
    SetPulseState(TSpeedButton(Sender), False);
end;

procedure TMainForm.SetPulseState(ABtn: TSpeedButton; AOn: Boolean);
var
  Idx: Integer;
  SlaveAddr: Integer;
begin
  UpdateButtonVisual(ABtn, AOn);

  if not (Assigned(FModbus) and FModbus.IsConnected) then
  begin
    if AOn then
      Log('Impossibile comandare il relè: non connesso.');
    Exit;
  end;

  Idx := ABtn.Tag;
  SlaveAddr := StrToIntDef(edtSlaveRele.Text, 1);
  try
    FModbus.WriteSingleCoil(SlaveAddr, Idx, AOn);
    Log(Format('Pulsante %s -> %s', [ChannelCaption(Idx), BoolToStr(AOn, True)]));
  except
    on E: Exception do
      // Nessun rollback: se fallisce la chiusura si tenta comunque l'apertura
      // al rilascio, così il canale non resta eccitato per un errore.
      Log('ERRORE scrittura relè: ' + E.Message);
  end;
end;

procedure TMainForm.tmrPollTimer(Sender: TObject);
var
  Inputs: TArray<Boolean>;
  Analog: TArray<Word>;
  I: Integer;
  SlaveIO, SlaveAnalog: Integer;
begin
  if not (Assigned(FModbus) and FModbus.IsConnected) then Exit;

  SlaveIO := StrToIntDef(edtSlaveIO.Text, 2);
  SlaveAnalog := StrToIntDef(edtSlaveAnalog.Text, 5);

  if CBReadInput.Checked then
  begin
    try
      Inputs := FModbus.ReadDiscreteInputs(SlaveIO, 0, 8);
      for I := 0 to 7 do
      begin
        // Il log registra le transizioni, non i livelli: su una barca interessa
        // sapere *quando* un contatto si e' chiuso, non che e' chiuso da un'ora.
        if (not FInputValid[I]) or (Inputs[I] <> FInputState[I]) then
          Log(Format('DI%d (ch%d) -> %s', [I + 1, I,
            IfThen(Inputs[I], 'CHIUSO', 'aperto')]));
        FInputState[I] := Inputs[I];
        FInputValid[I] := True;
        SetInputVisual(I, True, Inputs[I]);
      end;
      FInputErr := '';
    except
      on E: Exception do
      begin
        // Le spie vanno spente a "non so": lasciarle com'erano farebbe passare
        // un bus caduto per un quadro tutto a posto.
        if E.Message <> FInputErr then
        begin
          Log(Format('ERRORE lettura ingressi slave %d: %s', [SlaveIO, E.Message]));
          FInputErr := E.Message;
        end;
        InvalidateInputs;
      end;
    end;
  end
  else
    InvalidateInputs;

  if CBReadAnalog.Checked then
  begin
    try
      Analog := FModbus.ReadHoldingRegisters(SlaveAnalog, 0, 4);
      for I := 0 to 3 do
      begin
        FAnalogLabels[I].Caption := 'Registro: ' + IntToStr(Analog[I]);
        FAnalogGauges[I].Value := RawToEng(I, Analog[I]);
      end;
      FAnalogErr := '';
    except
      on E: Exception do
      begin
        if E.Message <> FAnalogErr then
        begin
          Log(Format('ERRORE lettura analogici slave %d: %s', [SlaveAnalog, E.Message]));
          FAnalogErr := E.Message;
        end;
        for I := 0 to 3 do
        begin
          FAnalogGauges[I].Valid := False;
          FAnalogLabels[I].Caption := 'Registro: --';
        end;
      end;
    end;
  end;
end;

end.