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; Analog: TArray; 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.