f.bittiandClaude Opus 5
4a01a2ec88
Due programmi che condividono uModbusRTU e uGauge: - Console/PlanciaConsole: plancia nautica descritta da file XML, con modalita' plancia e modalita' configurazione. Comandi, spie, selettori, strumenti e allarmi sonori; il bus gira in un thread suo perche' la finestra non si fermi mai. - ProjectPlancia: il programma di prova piu' vecchio, usato per collaudare i canali. Le plance sono in Console/*.xml, la documentazione in Console/LEGGIMI.md. Esclusi dal versionamento i compilati (.exe, .dcu), i file dell'IDE e un audio da 17 MB. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2931 lines
87 KiB
ObjectPascal
2931 lines
87 KiB
ObjectPascal
unit uConsoleMain;
|
|
|
|
{
|
|
Plancia configurabile, due modalita' decise da riga di comando:
|
|
|
|
PlanciaConsole.exe -> aboard (default)
|
|
PlanciaConsole.exe aboard
|
|
PlanciaConsole.exe config -> configurazione
|
|
PlanciaConsole.exe config -f rotta.xml
|
|
|
|
In "aboard" legge l'XML, si connette da sola e opera: nessun comando di
|
|
modifica a vista, solo la barra di stato.
|
|
In "config" mostra palette, pannello proprieta' e salvataggio, e NON apre
|
|
la porta seriale: cosi' non si comandano relE' per sbaglio mentre si
|
|
disegna la plancia.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
|
|
System.Types, System.UITypes, System.Math, System.Generics.Collections,
|
|
System.IOUtils, System.StrUtils,
|
|
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
|
|
Vcl.ExtCtrls, Vcl.ExtDlgs, Vcl.Buttons,
|
|
uModbusRTU, uModbusWorker, uAlarmSound, uGauge, uImageLib, uPlanciaElements, uPlanciaConfig;
|
|
|
|
type
|
|
TAppMode = (amAboard, amConfig);
|
|
|
|
TElementKinds = set of TElementKind;
|
|
|
|
/// Una bobina da leggere da sola durante l'allineamento iniziale.
|
|
TCoilChannel = record
|
|
Slave: Integer;
|
|
Channel: Integer;
|
|
end;
|
|
|
|
/// Una richiesta Modbus che copre tutti i canali contigui di uno slave.
|
|
TPollGroup = record
|
|
Slave: Integer;
|
|
First: Integer;
|
|
Count: Integer;
|
|
end;
|
|
|
|
TConsoleForm = class(TForm)
|
|
pnlToolbar: TPanel;
|
|
btnNuovo: TButton;
|
|
btnApri: TButton;
|
|
btnSalva: TButton;
|
|
btnSalvaCome: TButton;
|
|
btnAnnulla: TButton;
|
|
btnRipeti: TButton;
|
|
chkGriglia: TCheckBox;
|
|
lblZoom: TLabel;
|
|
cboZoom: TComboBox;
|
|
lblFile: TLabel;
|
|
pnlStatus: TPanel;
|
|
shpLed: TShape;
|
|
lblStatus: TLabel;
|
|
btnModo: TButton;
|
|
btnNotte: TButton;
|
|
cboPlancia: TComboBox;
|
|
btnAllarmi: TButton;
|
|
pnlPalette: TPanel;
|
|
lblPaletteTitle: TLabel;
|
|
gbImmagini: TGroupBox;
|
|
lstImmagini: TListBox;
|
|
btnImgAdd: TButton;
|
|
btnImgDel: TButton;
|
|
gbGenerale: TGroupBox;
|
|
lblPort: TLabel;
|
|
cboPort: TComboBox;
|
|
lblBaud: TLabel;
|
|
cboBaud: TComboBox;
|
|
lblPoll: TLabel;
|
|
edtPoll: TEdit;
|
|
lblTitolo: TLabel;
|
|
edtTitolo: TEdit;
|
|
lblPanelSize: TLabel;
|
|
edtPanelW: TEdit;
|
|
edtPanelH: TEdit;
|
|
lblSfondo: TLabel;
|
|
cboSfondo: TComboBox;
|
|
pnlProps: TPanel;
|
|
lblPropTitle: TLabel;
|
|
lblCap: TLabel;
|
|
edtCaption: TEdit;
|
|
lblFontSize: TLabel;
|
|
edtFontSize: TEdit;
|
|
lblSlave: TLabel;
|
|
edtSlave: TEdit;
|
|
lblCanale: TLabel;
|
|
edtCanale: TEdit;
|
|
lblPos: TLabel;
|
|
edtLeft: TEdit;
|
|
edtTop: TEdit;
|
|
lblSize: TLabel;
|
|
edtWidth: TEdit;
|
|
edtHeight: TEdit;
|
|
lblTipo: TLabel;
|
|
cboTipo: TComboBox;
|
|
gbImgElem: TGroupBox;
|
|
lblShape: TLabel;
|
|
cboShape: TComboBox;
|
|
lblCapPos: TLabel;
|
|
cboCapPos: TComboBox;
|
|
lblOnColor: TLabel;
|
|
edtOnColor: TEdit;
|
|
edtOffColor: TEdit;
|
|
lblImgOff: TLabel;
|
|
cboImgOff: TComboBox;
|
|
lblImgOn: TLabel;
|
|
cboImgOn: TComboBox;
|
|
gbGauge: TGroupBox;
|
|
lblRaw: TLabel;
|
|
edtRawMin: TEdit;
|
|
edtRawMax: TEdit;
|
|
lblEng: TLabel;
|
|
edtEngMin: TEdit;
|
|
edtEngMax: TEdit;
|
|
lblUnits: TLabel;
|
|
edtUnits: TEdit;
|
|
lblWarn: TLabel;
|
|
edtWarnLo: TEdit;
|
|
edtWarnHi: TEdit;
|
|
lblDigits: TLabel;
|
|
edtDigits: TEdit;
|
|
lblDecimals: TLabel;
|
|
edtDecimals: TEdit;
|
|
lblCanale2: TLabel;
|
|
edtCanale2: TEdit;
|
|
chkMolla: TCheckBox;
|
|
gbTesto: TGroupBox;
|
|
lblFontName: TLabel;
|
|
edtFontName: TEdit;
|
|
lblSpacing: TLabel;
|
|
edtSpacing: TEdit;
|
|
lblFrame: TLabel;
|
|
cboFrame: TComboBox;
|
|
edtFrameWidth: TEdit;
|
|
gbSuono: TGroupBox;
|
|
chkAllarme: TCheckBox;
|
|
cboSuono: TComboBox;
|
|
btnSuoniRileggi: TButton;
|
|
gbRotary: TGroupBox;
|
|
lblPositions: TLabel;
|
|
cboPositions: TComboBox;
|
|
lblLegend: TLabel;
|
|
edtLegend: TEdit;
|
|
btnElimina: TButton;
|
|
scrCanvas: TScrollBox;
|
|
pnlCanvas: TPanel;
|
|
tmrPoll: TTimer;
|
|
dlgApri: TOpenDialog;
|
|
dlgSalva: TSaveDialog;
|
|
dlgImmagine: TOpenPictureDialog;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure FormKeyPress(Sender: TObject; var Key: Char);
|
|
procedure btnSuoniRileggiClick(Sender: TObject);
|
|
procedure btnAnnullaClick(Sender: TObject);
|
|
procedure btnRipetiClick(Sender: TObject);
|
|
procedure btnNuovoClick(Sender: TObject);
|
|
procedure btnApriClick(Sender: TObject);
|
|
procedure btnSalvaClick(Sender: TObject);
|
|
procedure btnSalvaComeClick(Sender: TObject);
|
|
procedure btnEliminaClick(Sender: TObject);
|
|
procedure chkGrigliaClick(Sender: TObject);
|
|
procedure ZoomChanged(Sender: TObject);
|
|
procedure btnImgAddClick(Sender: TObject);
|
|
procedure btnImgDelClick(Sender: TObject);
|
|
procedure BackgroundChanged(Sender: TObject);
|
|
procedure PropChanged(Sender: TObject);
|
|
procedure KindChanged(Sender: TObject);
|
|
procedure btnModoClick(Sender: TObject);
|
|
procedure btnNotteClick(Sender: TObject);
|
|
procedure cboPlanciaSelect(Sender: TObject);
|
|
procedure btnAllarmiClick(Sender: TObject);
|
|
procedure GeneralChanged(Sender: TObject);
|
|
procedure CanvasDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
procedure CanvasDragDrop(Sender, Source: TObject; X, Y: Integer);
|
|
procedure CanvasMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure tmrPollTimer(Sender: TObject);
|
|
private
|
|
FMode: TAppMode;
|
|
/// Vero solo se l'applicazione e' partita in configurazione. Una plancia
|
|
/// avviata in servizio non deve offrire la via per essere modificata.
|
|
FCanConfigure: Boolean;
|
|
/// Finestra e zoom di lavoro, messi da parte mentre si sta in plancia:
|
|
/// tornando a configurare si ritrova il posto com'era stato lasciato.
|
|
FConfigBounds: TRect;
|
|
FConfigZoom: Double;
|
|
/// Plancia in modalita' notturna: fondo scuro e colori abbassati.
|
|
FNight: Boolean;
|
|
FConfig: TPlanciaConfig;
|
|
FFileName: string;
|
|
FDirty: Boolean;
|
|
/// Il file corrente non si e' aperto: non ci si salva sopra alla chiusura.
|
|
FLoadFailed: Boolean;
|
|
FElements: TList<TPlanciaElement>;
|
|
FSelected: TPlanciaElement;
|
|
/// Il bus vive qui: un thread che possiede la porta. Il thread
|
|
/// principale gli mette in coda i comandi e ritira le letture.
|
|
FWorker: TModbusWorker;
|
|
/// Suoni di allarme delle spie.
|
|
FAlarms: TAlarmPlayer;
|
|
FUpdatingProps: Boolean;
|
|
FLampPlan: TList<TPollGroup>;
|
|
FGaugePlan: TList<TPollGroup>;
|
|
FSwitchPlan: TList<TPollGroup>;
|
|
FPlanDirty: Boolean;
|
|
/// Primo errore di lettura del ciclo in corso, e quanti ce ne sono stati.
|
|
FPollError: string;
|
|
FPollErrors: Integer;
|
|
/// Fino a quando il messaggio in barra non va sovrascritto.
|
|
FStatusUntil: UInt64;
|
|
/// Prima lettura delle bobine dopo l'ingresso in plancia: serve a mettere
|
|
/// i comandi come sono i rele' veri, pulsanti compresi.
|
|
FAligning: Boolean;
|
|
FAlignReported: Boolean;
|
|
/// Canali di bobina usati dalla plancia, senza doppioni: l'allineamento
|
|
/// iniziale li legge uno per uno.
|
|
FCoilChannels: TArray<TCoilChannel>;
|
|
/// Richieste delle bobine effettivamente in uso: partono raggruppate e si
|
|
/// dividono da sole quando un blocco non risponde.
|
|
FCoilReqs: TArray<TPollRequest>;
|
|
/// Quando ogni bobina e' stata comandata l'ultima volta.
|
|
FCoilWrites: TDictionary<Int64, UInt64>;
|
|
FZoom: Double;
|
|
FBackImage: TImage;
|
|
/// Percorsi delle plance elencate in cboPlancia, nello stesso ordine.
|
|
FPlanciaFiles: TStringList;
|
|
/// Storico delle modifiche in configurazione: fotografie dello stato
|
|
/// prima di ogni modifica (FUndo) e di quelle annullate (FRedo).
|
|
FUndo: TObjectList<TPlanciaSnapshot>;
|
|
FRedo: TObjectList<TPlanciaSnapshot>;
|
|
/// Chiave e ora dell'ultima fotografia: modifiche in fila con la stessa
|
|
/// chiave diventano un passo solo.
|
|
FUndoKey: string;
|
|
FUndoTime: UInt64;
|
|
procedure ParseCommandLine;
|
|
procedure PushUndo(const AKey: string = '');
|
|
procedure ClearUndo;
|
|
procedure StepHistory(AFrom, ATo: TObjectList<TPlanciaSnapshot>);
|
|
procedure UpdateUndoButtons;
|
|
function SelectedIndex: Integer;
|
|
procedure LoadGeneral;
|
|
procedure NudgeSelected(ADX, ADY: Integer; AResize: Boolean);
|
|
procedure FocusCanvas;
|
|
procedure ElementBeginChange(ASender: TPlanciaElement);
|
|
procedure RefreshPlanciaList;
|
|
procedure SwitchPlancia(const AFileName: string);
|
|
procedure LayoutStatusBar;
|
|
procedure BuildPalette;
|
|
procedure PaletteMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure ApplyMode;
|
|
procedure SwitchMode(ANewMode: TAppMode);
|
|
procedure ApplyNight;
|
|
procedure RebuildPanel;
|
|
function CreateElementControl(ADef: TElementDef): TPlanciaElement;
|
|
procedure SelectElement(AElement: TPlanciaElement);
|
|
procedure LoadProps;
|
|
/// Casella della seconda bobina: c'e' solo a tre posizioni, e ricorda
|
|
/// quale canale verrebbe usato lasciandola vuota.
|
|
procedure UpdateRotaryFields(ADef: TElementDef);
|
|
procedure DeleteSelected;
|
|
procedure MarkDirty;
|
|
procedure FitWindowToPanel;
|
|
procedure SetZoom(const AZoom: Double);
|
|
procedure ResizeCanvas;
|
|
procedure RefreshImageLists;
|
|
/// Rilegge la cartella dei suoni e riempie la casella.
|
|
procedure RefreshSoundList;
|
|
/// Fa suonare l'allarme di una spia appena accesa.
|
|
procedure TriggerAlarm(AElement: TPlanciaElement);
|
|
/// Ferma il suono di una spia, se nessun'altra spia accesa lo usa.
|
|
procedure StopAlarm(AElement: TPlanciaElement);
|
|
/// Rimette in moto il suono di un allarme ancora presente, se e' finito.
|
|
procedure KeepAlarmSounding(AElement: TPlanciaElement);
|
|
procedure ElementMuteRequest(ASender: TPlanciaElement);
|
|
/// Rimette in funzione gli allarmi il cui silenzio e' scaduto e aggiorna
|
|
/// il tasto della barra di stato.
|
|
procedure UpdateMutedAlarms;
|
|
procedure UpdateBackground;
|
|
function FindFreeSpot(const APreferred: TPoint;
|
|
AWidth, AHeight: Integer): TPoint;
|
|
procedure UpdateCaptions;
|
|
procedure SetStatus(const AMsg: string; AOk: Boolean);
|
|
/// Come SetStatus, ma il messaggio resta per AHoldMs prima di essere
|
|
/// sostituito dallo stato del bus.
|
|
procedure SetStatusFor(const AMsg: string; AOk: Boolean; AHoldMs: Integer);
|
|
function UniqueCaption(AKind: TElementKind): string;
|
|
function GridStep: Integer;
|
|
procedure DoLoad(const AFileName: string);
|
|
procedure DoSave(const AFileName: string);
|
|
function ConfirmDiscard: Boolean;
|
|
procedure ConnectModbus;
|
|
procedure DisconnectModbus;
|
|
procedure BuildPollPlan;
|
|
/// Spezza a meta' una richiesta di bobine che non risponde.
|
|
procedure SplitCoilRequest(const ARequest: TPollRequest);
|
|
procedure AddToPlan(APlan: TList<TPollGroup>; ASlave, AChannel: Integer);
|
|
procedure NotePollError(const AWhat, AError: string);
|
|
procedure InvalidateGroup(AKinds: TElementKinds;
|
|
const AGroup: TPollGroup);
|
|
procedure ApplyReading(const AReading: TPollReading);
|
|
/// Chiude l'allineamento iniziale quando le bobine sono state lette.
|
|
procedure FinishAligning(const AReadings: TArray<TPollReading>);
|
|
function BusReady: Boolean;
|
|
procedure InvalidateReadings;
|
|
/// Allinea gli altri comandi che stanno sulla stessa bobina.
|
|
procedure MirrorCoil(ASlave, AChannel: Integer; AOn: Boolean;
|
|
AExcept: TPlanciaElement);
|
|
/// Segna l'istante in cui una bobina e' stata comandata.
|
|
procedure NoteCoilWrite(ASlave, AChannel: Integer);
|
|
/// Vero se la risposta e' piu' vecchia dell'ultimo comando su quella
|
|
/// bobina: va scartata, altrimenti il comando torna indietro da solo.
|
|
function ReadingStale(ASlave, AChannel: Integer; ASent: UInt64): Boolean;
|
|
procedure ElementCommand(ASender: TPlanciaElement; AOn: Boolean;
|
|
var AAccepted: Boolean);
|
|
procedure ElementRotary(ASender: TPlanciaElement; APos: Integer;
|
|
var AAccepted: Boolean);
|
|
procedure ElementSelectRequest(ASender: TPlanciaElement);
|
|
procedure ElementGeometryChanged(ASender: TPlanciaElement);
|
|
public
|
|
end;
|
|
|
|
var
|
|
ConsoleForm: TConsoleForm;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
const
|
|
PALETTE_TOP = 26;
|
|
PALETTE_ITEM_H = 30;
|
|
PALETTE_GAP = 4;
|
|
MAX_REGISTERS_PER_READ = 125;
|
|
MAX_BITS_PER_READ = 2000;
|
|
// Passo di ricerca di una posizione libera per un nuovo elemento.
|
|
FREE_SPOT_STEP = 20;
|
|
// Passi di annulla conservati: oltre, i piu' vecchi si perdono.
|
|
UNDO_LIMIT = 100;
|
|
// Entro questo intervallo le modifiche in fila allo stesso campo o allo
|
|
// stesso elemento (cifre digitate, ctrl+freccia tenuto premuto) si fondono.
|
|
UNDO_MERGE_MS = 1500;
|
|
// Quanto resta a video un messaggio importante (comando dato, errore di
|
|
// scrittura) prima che lo stato del bus lo sostituisca.
|
|
STATUS_HOLD_MS = 2500;
|
|
|
|
// Tipi intercambiabili dopo il disegno. Condividono tutti i campi della
|
|
// definizione - canale, colori, forma, immagini, etichetta - e differiscono
|
|
// solo nel funzionamento, quindi il passaggio dall'uno all'altro non perde
|
|
// niente. La spia c'e' perche' su un quadro vero una lente rossa puo' essere
|
|
// un allarme e non un comando, e dalla foto non si capisce. Aggiungerne uno
|
|
// qui basta a renderlo scambiabile.
|
|
SWITCHABLE_KINDS: array[0..2] of TElementKind = (ekButton, ekSwitch, ekLamp);
|
|
|
|
{ avvio }
|
|
|
|
procedure TConsoleForm.FormCreate(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FConfig := TPlanciaConfig.Create;
|
|
FElements := TList<TPlanciaElement>.Create;
|
|
FLampPlan := TList<TPollGroup>.Create;
|
|
FGaugePlan := TList<TPollGroup>.Create;
|
|
FSwitchPlan := TList<TPollGroup>.Create;
|
|
FPlanciaFiles := TStringList.Create;
|
|
FAlarms := TAlarmPlayer.Create;
|
|
FCoilWrites := TDictionary<Int64, UInt64>.Create;
|
|
FUndo := TObjectList<TPlanciaSnapshot>.Create(True);
|
|
FRedo := TObjectList<TPlanciaSnapshot>.Create(True);
|
|
FZoom := 1;
|
|
|
|
for I := 1 to 20 do
|
|
cboPort.Items.Add('COM' + IntToStr(I));
|
|
cboBaud.Items.CommaText := '9600,19200,38400,57600,115200';
|
|
cboZoom.Items.CommaText := '50%,75%,100%,125%,150%,200%';
|
|
cboZoom.ItemIndex := 2;
|
|
cboPositions.Items.CommaText := '2,3';
|
|
for var Sh := Low(TKeyShape) to High(TKeyShape) do
|
|
cboShape.Items.Add(SHAPE_NAMES[Sh]);
|
|
for var Sk := Low(SWITCHABLE_KINDS) to High(SWITCHABLE_KINDS) do
|
|
cboTipo.Items.Add(ELEMENT_NAMES[SWITCHABLE_KINDS[Sk]]);
|
|
for var Cp := Low(TCaptionPos) to High(TCaptionPos) do
|
|
cboCapPos.Items.Add(CAPTION_POS_NAMES[Cp]);
|
|
for var Fr := Low(TFrameKind) to High(TFrameKind) do
|
|
cboFrame.Items.Add(FRAME_NAMES[Fr]);
|
|
|
|
BuildPalette;
|
|
ParseCommandLine;
|
|
// Solo chi e' partito configurando puo' fare avanti e indietro: su una
|
|
// plancia avviata in servizio il pulsante non compare proprio.
|
|
FCanConfigure := FMode = amConfig;
|
|
ApplyMode;
|
|
ApplyNight;
|
|
|
|
if FileExists(FFileName) then
|
|
DoLoad(FFileName)
|
|
else
|
|
begin
|
|
RebuildPanel;
|
|
if FMode = amAboard then
|
|
SetStatus(Format('Configurazione non trovata: %s', [FFileName]), False)
|
|
else
|
|
SetStatus('Nuova plancia. Trascina un elemento dalla palette.', True);
|
|
end;
|
|
|
|
if FMode = amAboard then
|
|
ConnectModbus;
|
|
end;
|
|
|
|
procedure TConsoleForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
tmrPoll.Enabled := False;
|
|
DisconnectModbus;
|
|
FAlarms.Free;
|
|
FCoilWrites.Free;
|
|
FPlanciaFiles.Free;
|
|
FRedo.Free;
|
|
FUndo.Free;
|
|
FSwitchPlan.Free;
|
|
FGaugePlan.Free;
|
|
FLampPlan.Free;
|
|
FElements.Free;
|
|
FConfig.Free;
|
|
end;
|
|
|
|
procedure TConsoleForm.ParseCommandLine;
|
|
var
|
|
I: Integer;
|
|
P, Low: string;
|
|
begin
|
|
FMode := amAboard;
|
|
// Senza indicazioni si riprende la plancia usata l'ultima volta; se non c'e'
|
|
// promemoria, o il file non esiste piu', il predefinito accanto all'exe.
|
|
FFileName := LoadLastFile;
|
|
if FFileName = '' then
|
|
FFileName := DefaultConfigFile;
|
|
FConfigZoom := 1;
|
|
|
|
I := 1;
|
|
while I <= ParamCount do
|
|
begin
|
|
P := ParamStr(I);
|
|
Low := LowerCase(P);
|
|
while (Low <> '') and CharInSet(Low[1], ['-', '/']) do
|
|
Delete(Low, 1, 1);
|
|
|
|
if (Low = 'config') or (Low = 'configuration') or (Low = 'conf') then
|
|
FMode := amConfig
|
|
else if Low = 'aboard' then
|
|
FMode := amAboard
|
|
else if (Low = 'f') or (Low = 'file') then
|
|
begin
|
|
// forma "-f nome.xml"
|
|
Inc(I);
|
|
if I <= ParamCount then
|
|
FFileName := ExpandFileName(ParamStr(I));
|
|
end
|
|
else if Low.StartsWith('file=') then
|
|
FFileName := ExpandFileName(Copy(P, Pos('=', P) + 1, MaxInt))
|
|
else if not P.StartsWith('-') and not P.StartsWith('/') then
|
|
// un parametro libero e' inteso come percorso del file
|
|
FFileName := ExpandFileName(P);
|
|
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
|
|
{ palette }
|
|
|
|
procedure TConsoleForm.BuildPalette;
|
|
var
|
|
K: TElementKind;
|
|
Chip: TPanel;
|
|
Y: Integer;
|
|
begin
|
|
Y := PALETTE_TOP;
|
|
for K := Low(TElementKind) to High(TElementKind) do
|
|
begin
|
|
Chip := TPanel.Create(Self);
|
|
Chip.Parent := pnlPalette;
|
|
Chip.SetBounds(10, Y, pnlPalette.ClientWidth - 24, PALETTE_ITEM_H);
|
|
Chip.Caption := ELEMENT_NAMES[K];
|
|
Chip.BevelOuter := bvRaised;
|
|
Chip.Cursor := crHandPoint;
|
|
Chip.Hint := ELEMENT_HINTS[K] + ' - trascina sul pannello';
|
|
Chip.ShowHint := True;
|
|
Chip.Tag := Ord(K);
|
|
Chip.DragMode := dmManual;
|
|
Chip.OnMouseDown := PaletteMouseDown;
|
|
Inc(Y, PALETTE_ITEM_H + PALETTE_GAP);
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.PaletteMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
// Soglia di 6 px: un click secco non fa partire il trascinamento.
|
|
if (Button = mbLeft) and (FMode = amConfig) then
|
|
TControl(Sender).BeginDrag(False, 6);
|
|
end;
|
|
|
|
{ modalita' e ricostruzione del pannello }
|
|
|
|
procedure TConsoleForm.ApplyMode;
|
|
var
|
|
Editing: Boolean;
|
|
begin
|
|
Editing := FMode = amConfig;
|
|
pnlToolbar.Visible := Editing;
|
|
pnlPalette.Visible := Editing;
|
|
pnlProps.Visible := Editing;
|
|
KeyPreview := Editing;
|
|
pnlCanvas.DoubleBuffered := True;
|
|
|
|
// Il pulsante sta nella barra di stato perche' e' l'unica che resta visibile
|
|
// in plancia: la barra degli strumenti sparisce insieme alla palette.
|
|
btnModo.Visible := FCanConfigure;
|
|
if Editing then
|
|
btnModo.Caption := 'Vai in plancia'
|
|
else
|
|
btnModo.Caption := 'Torna a configurare';
|
|
|
|
RefreshPlanciaList;
|
|
UpdateCaptions;
|
|
end;
|
|
|
|
procedure TConsoleForm.LayoutStatusBar;
|
|
var
|
|
X: Integer;
|
|
|
|
procedure Place(AControl: TControl);
|
|
begin
|
|
if not AControl.Visible then
|
|
Exit;
|
|
AControl.Left := X - AControl.Width;
|
|
X := AControl.Left - 6;
|
|
end;
|
|
|
|
begin
|
|
// Da destra verso sinistra, solo quello che si vede: in aboard il pulsante
|
|
// di configurazione puo' mancare e non deve restare un buco.
|
|
X := pnlStatus.ClientWidth - 10;
|
|
Place(btnModo);
|
|
Place(btnNotte);
|
|
Place(cboPlancia);
|
|
Place(btnAllarmi);
|
|
end;
|
|
|
|
procedure TConsoleForm.RefreshPlanciaList;
|
|
var
|
|
Dir, F, Title: string;
|
|
I: Integer;
|
|
begin
|
|
FPlanciaFiles.Clear;
|
|
cboPlancia.Items.BeginUpdate;
|
|
try
|
|
cboPlancia.Items.Clear;
|
|
// Le plance fra cui scegliere sono gli XML accanto a quella caricata: una
|
|
// plancia si trasporta copiando la sua cartella, e le sorelle viaggiano con
|
|
// lei. Gli XML che non sono plance vengono scartati.
|
|
Dir := ExtractFilePath(ExpandFileName(FFileName));
|
|
if TDirectory.Exists(Dir) then
|
|
for F in TDirectory.GetFiles(Dir, '*.xml') do
|
|
if ReadPanelTitle(F, Title) then
|
|
begin
|
|
if Title = '' then
|
|
Title := ChangeFileExt(ExtractFileName(F), '');
|
|
// Due plance con lo stesso titolo si distinguono dal nome del file.
|
|
if cboPlancia.Items.IndexOf(Title) >= 0 then
|
|
Title := Format('%s (%s)', [Title, ExtractFileName(F)]);
|
|
cboPlancia.Items.Add(Title);
|
|
FPlanciaFiles.Add(F);
|
|
end;
|
|
cboPlancia.ItemIndex := -1;
|
|
for I := 0 to FPlanciaFiles.Count - 1 do
|
|
if SameFileName(FPlanciaFiles[I], ExpandFileName(FFileName)) then
|
|
cboPlancia.ItemIndex := I;
|
|
finally
|
|
cboPlancia.Items.EndUpdate;
|
|
end;
|
|
|
|
// Solo a bordo: in configurazione c'e' gia' "Apri", che chiede anche delle
|
|
// modifiche non salvate. Con una plancia sola non c'e' niente da scegliere.
|
|
cboPlancia.Visible := (FMode = amAboard) and (FPlanciaFiles.Count > 1);
|
|
LayoutStatusBar;
|
|
end;
|
|
|
|
procedure TConsoleForm.cboPlanciaSelect(Sender: TObject);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := cboPlancia.ItemIndex;
|
|
if (I < 0) or (I >= FPlanciaFiles.Count) then
|
|
Exit;
|
|
// Il fuoco va tolto alla casella: con le frecce della tastiera cambierebbe
|
|
// plancia di nuovo a ogni tasto.
|
|
ActiveControl := nil;
|
|
SwitchPlancia(FPlanciaFiles[I]);
|
|
end;
|
|
|
|
procedure TConsoleForm.SwitchPlancia(const AFileName: string);
|
|
var
|
|
Probe: TPlanciaConfig;
|
|
begin
|
|
if SameFileName(ExpandFileName(AFileName), ExpandFileName(FFileName)) then
|
|
Exit;
|
|
|
|
// Prima si legge il file a parte. Se e' rotto la plancia in servizio resta
|
|
// quella di prima: DoLoad in caso di errore lascerebbe un pannello vuoto,
|
|
// e a bordo e' peggio di non aver cambiato niente.
|
|
Probe := TPlanciaConfig.Create;
|
|
try
|
|
try
|
|
Probe.LoadFromFile(AFileName);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
SetStatus(Format('Plancia %s non caricata: %s',
|
|
[ExtractFileName(AFileName), E.Message]), False);
|
|
RefreshPlanciaList;
|
|
Exit;
|
|
end;
|
|
end;
|
|
finally
|
|
Probe.Free;
|
|
end;
|
|
|
|
// La nuova plancia puo' stare su un'altra porta o un altro baud: il bus si
|
|
// chiude e si riapre con i parametri del file. Le bobine non vengono
|
|
// toccate, i rele' restano come sono e la nuova plancia li rilegge.
|
|
DisconnectModbus;
|
|
// Si riparte da 1:1, poi FitWindowToPanel rimpicciolisce se serve.
|
|
SetZoom(1);
|
|
DoLoad(AFileName);
|
|
if FMode = amAboard then
|
|
ConnectModbus;
|
|
RefreshPlanciaList;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnNotteClick(Sender: TObject);
|
|
begin
|
|
FNight := not FNight;
|
|
ApplyNight;
|
|
end;
|
|
|
|
procedure TConsoleForm.ApplyNight;
|
|
var
|
|
E: TPlanciaElement;
|
|
Back: TColor;
|
|
begin
|
|
if FNight then
|
|
begin
|
|
Back := CLR_NIGHT_BG;
|
|
btnNotte.Caption := 'Giorno';
|
|
end
|
|
else
|
|
begin
|
|
Back := clBtnFace;
|
|
btnNotte.Caption := 'Notte';
|
|
end;
|
|
|
|
pnlCanvas.Color := Back;
|
|
scrCanvas.Color := Back;
|
|
for E in FElements do
|
|
begin
|
|
// Gli elementi sono controlli non finestrati: il loro Color e' il fondo su
|
|
// cui disegnano le parti trasparenti, e deve seguire quello del pannello.
|
|
E.Color := Back;
|
|
E.NightMode := FNight;
|
|
end;
|
|
|
|
// Lo sfondo e' un bitmap: non basta cambiare un colore, va rifatto scuro.
|
|
UpdateBackground;
|
|
pnlCanvas.Invalidate;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnModoClick(Sender: TObject);
|
|
begin
|
|
if FMode = amConfig then
|
|
SwitchMode(amAboard)
|
|
else
|
|
SwitchMode(amConfig);
|
|
end;
|
|
|
|
procedure TConsoleForm.SwitchMode(ANewMode: TAppMode);
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
if FMode = ANewMode then
|
|
Exit;
|
|
|
|
// Uscendo dalla configurazione le modifiche non salvate vanno chieste prima,
|
|
// altrimenti passare in plancia le perderebbe in silenzio.
|
|
if (FMode = amConfig) and not ConfirmDiscard then
|
|
Exit;
|
|
|
|
if FMode = amConfig then
|
|
begin
|
|
FConfigBounds := BoundsRect;
|
|
FConfigZoom := FZoom;
|
|
end;
|
|
|
|
FMode := ANewMode;
|
|
|
|
if FMode = amAboard then
|
|
begin
|
|
SelectElement(nil);
|
|
ApplyMode;
|
|
for E in FElements do
|
|
E.EditMode := False;
|
|
// In plancia si riparte sempre da 1:1 e poi si rimpicciolisce solo se lo
|
|
// schermo non basta, esattamente come all'avvio.
|
|
SetZoom(1);
|
|
FitWindowToPanel;
|
|
FPlanDirty := True;
|
|
ConnectModbus;
|
|
end
|
|
else
|
|
begin
|
|
// Configurando si sta spostando roba a video, non comandando il campo: il
|
|
// bus va lasciato libero, cosi' la porta torna disponibile agli strumenti.
|
|
DisconnectModbus;
|
|
// Nessun allarme deve continuare a suonare fuori dalla plancia, e i
|
|
// silenzi non hanno piu' senso: si riparte puliti.
|
|
FAlarms.StopAll;
|
|
for E in FElements do
|
|
E.ClearAlarmMute;
|
|
UpdateMutedAlarms;
|
|
ApplyMode;
|
|
for E in FElements do
|
|
begin
|
|
// Gli stati letti dal campo non valgono piu': lasciarli accesi mostrerebbe
|
|
// una plancia che sembra in servizio mentre non sta leggendo nulla.
|
|
E.SetInvalid;
|
|
E.SyncState(False);
|
|
E.SyncRotary(0);
|
|
E.EditMode := True;
|
|
end;
|
|
if FConfigZoom > 0 then
|
|
SetZoom(FConfigZoom);
|
|
if not FConfigBounds.IsEmpty then
|
|
BoundsRect := FConfigBounds;
|
|
SetStatus('Configurazione.', True);
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.RebuildPanel;
|
|
var
|
|
E: TPlanciaElement;
|
|
D: TElementDef;
|
|
begin
|
|
for E in FElements do
|
|
E.Free;
|
|
FElements.Clear;
|
|
FSelected := nil;
|
|
|
|
// Lo sfondo va creato per primo: i controlli non finestrati vengono
|
|
// disegnati nell'ordine di inserimento, quindi gli elementi restano sopra.
|
|
FreeAndNil(FBackImage);
|
|
FBackImage := TImage.Create(Self);
|
|
FBackImage.Parent := pnlCanvas;
|
|
FBackImage.Align := alClient;
|
|
FBackImage.Stretch := True;
|
|
FBackImage.OnDragOver := CanvasDragOver;
|
|
FBackImage.OnDragDrop := CanvasDragDrop;
|
|
FBackImage.OnMouseDown := CanvasMouseDown;
|
|
|
|
ResizeCanvas;
|
|
UpdateBackground;
|
|
|
|
for D in FConfig.Elements do
|
|
CreateElementControl(D);
|
|
|
|
FPlanDirty := True;
|
|
RefreshImageLists;
|
|
RefreshSoundList;
|
|
LoadProps;
|
|
FitWindowToPanel;
|
|
UpdateCaptions;
|
|
end;
|
|
|
|
procedure TConsoleForm.ResizeCanvas;
|
|
begin
|
|
pnlCanvas.SetBounds(0, 0, Round(FConfig.PanelWidth * FZoom),
|
|
Round(FConfig.PanelHeight * FZoom));
|
|
end;
|
|
|
|
/// Copia scurita di un'immagine, pixel per pixel. Serve per lo sfondo in
|
|
/// modalita' notturna: una lamiera chiara a tutto schermo sarebbe la cosa piu'
|
|
/// abbagliante del quadro, altro che i comandi.
|
|
function DimPicture(APic: TPicture; AFactor: Double): TBitmap;
|
|
var
|
|
X, Y: Integer;
|
|
Row: PByteArray;
|
|
Tab: array[0..255] of Byte;
|
|
begin
|
|
for X := 0 to 255 do
|
|
Tab[X] := Round(X * AFactor);
|
|
|
|
Result := TBitmap.Create;
|
|
try
|
|
Result.PixelFormat := pf24bit;
|
|
Result.SetSize(APic.Width, APic.Height);
|
|
Result.Canvas.Draw(0, 0, APic.Graphic);
|
|
for Y := 0 to Result.Height - 1 do
|
|
begin
|
|
Row := Result.ScanLine[Y];
|
|
for X := 0 to Result.Width * 3 - 1 do
|
|
Row[X] := Tab[Row[X]];
|
|
end;
|
|
except
|
|
Result.Free;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.UpdateBackground;
|
|
var
|
|
Pic: TPicture;
|
|
Dark: TBitmap;
|
|
begin
|
|
if FBackImage = nil then
|
|
Exit;
|
|
Pic := FConfig.Images.Picture(FConfig.Background);
|
|
if Pic = nil then
|
|
begin
|
|
FBackImage.Picture.Assign(nil);
|
|
Exit;
|
|
end;
|
|
|
|
if not FNight then
|
|
begin
|
|
FBackImage.Picture.Assign(Pic);
|
|
Exit;
|
|
end;
|
|
|
|
Dark := DimPicture(Pic, NIGHT_DIM);
|
|
try
|
|
FBackImage.Picture.Assign(Dark);
|
|
finally
|
|
Dark.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.SetZoom(const AZoom: Double);
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
if AZoom <= 0 then
|
|
Exit;
|
|
FZoom := AZoom;
|
|
ResizeCanvas;
|
|
for E in FElements do
|
|
E.Scale := FZoom;
|
|
end;
|
|
|
|
procedure TConsoleForm.ZoomChanged(Sender: TObject);
|
|
var
|
|
S: string;
|
|
begin
|
|
S := StringReplace(cboZoom.Text, '%', '', [rfReplaceAll]);
|
|
SetZoom(StrToIntDef(Trim(S), 100) / 100);
|
|
end;
|
|
|
|
procedure TConsoleForm.FitWindowToPanel;
|
|
var
|
|
Work: TRect;
|
|
W, H, AvailW, AvailH: Integer;
|
|
Z: Double;
|
|
begin
|
|
// In aboard la finestra veste la plancia: niente cornice grigia inutile.
|
|
// In configurazione la finestra resta grande, serve spazio per lavorare.
|
|
if FMode <> amAboard then
|
|
Exit;
|
|
Work := Screen.WorkAreaRect;
|
|
// Margini larghi: se la plancia sfiora il limite compaiono le barre di
|
|
// scorrimento e l'ultima fila di comandi resta tagliata.
|
|
AvailW := Work.Width - 40;
|
|
AvailH := Work.Height - 90 - pnlStatus.Height;
|
|
|
|
// Se la plancia non entra nello schermo si rimpicciolisce, invece di
|
|
// costringere l'operatore a scorrere per raggiungere un comando.
|
|
Z := 1;
|
|
if FConfig.PanelWidth > AvailW then
|
|
Z := Min(Z, AvailW / FConfig.PanelWidth);
|
|
if FConfig.PanelHeight > AvailH then
|
|
Z := Min(Z, AvailH / FConfig.PanelHeight);
|
|
if Z < 1 then
|
|
SetZoom(Z);
|
|
|
|
W := Round(FConfig.PanelWidth * FZoom);
|
|
H := Round(FConfig.PanelHeight * FZoom) + pnlStatus.Height;
|
|
if W > AvailW then
|
|
W := AvailW;
|
|
if H > AvailH + pnlStatus.Height then
|
|
H := AvailH + pnlStatus.Height;
|
|
if W < 320 then
|
|
W := 320;
|
|
if H < 200 then
|
|
H := 200;
|
|
ClientWidth := W;
|
|
ClientHeight := H;
|
|
end;
|
|
|
|
/// Suggerimento a comparsa di un elemento: dice su cosa lavora sul bus.
|
|
function ElementHint(ADef: TElementDef): string;
|
|
begin
|
|
if not ElementHasChannel(ADef.Kind) then
|
|
Exit(ELEMENT_NAMES[ADef.Kind]);
|
|
if not ADef.Configured then
|
|
Exit(ELEMENT_NAMES[ADef.Kind] + ' - nessun canale configurato');
|
|
// Il selettore a tre posizioni comanda due bobine: vanno dette entrambe,
|
|
// perche' la seconda nell'XML puo' non essere scritta da nessuna parte.
|
|
if ADef.CoilCount > 1 then
|
|
Result := Format('%s - slave %d, canali %d e %d',
|
|
[ELEMENT_NAMES[ADef.Kind], ADef.Slave, ADef.Channel, ADef.RightChannel])
|
|
else
|
|
Result := Format('%s - slave %d, canale %d',
|
|
[ELEMENT_NAMES[ADef.Kind], ADef.Slave, ADef.Channel]);
|
|
end;
|
|
|
|
|
|
function TConsoleForm.CreateElementControl(ADef: TElementDef): TPlanciaElement;
|
|
begin
|
|
Result := TPlanciaElement.CreateElement(Self, ADef, FConfig.Images);
|
|
Result.Parent := pnlCanvas;
|
|
Result.Color := pnlCanvas.Color;
|
|
Result.NightMode := FNight;
|
|
Result.InkColor := FConfig.Ink;
|
|
Result.EditMode := FMode = amConfig;
|
|
Result.GridSize := GridStep;
|
|
Result.Scale := FZoom;
|
|
Result.OnCommand := ElementCommand;
|
|
Result.OnRotary := ElementRotary;
|
|
Result.OnSelectRequest := ElementSelectRequest;
|
|
Result.OnGeometryChanged := ElementGeometryChanged;
|
|
Result.OnBeginChange := ElementBeginChange;
|
|
Result.OnMuteRequest := ElementMuteRequest;
|
|
Result.OnDragOver := CanvasDragOver;
|
|
Result.OnDragDrop := CanvasDragDrop;
|
|
Result.Hint := ElementHint(ADef);
|
|
FElements.Add(Result);
|
|
end;
|
|
|
|
function TConsoleForm.GridStep: Integer;
|
|
begin
|
|
if chkGriglia.Checked then
|
|
Result := 10
|
|
else
|
|
Result := 1;
|
|
end;
|
|
|
|
procedure TConsoleForm.chkGrigliaClick(Sender: TObject);
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
for E in FElements do
|
|
E.GridSize := GridStep;
|
|
end;
|
|
|
|
function TConsoleForm.UniqueCaption(AKind: TElementKind): string;
|
|
var
|
|
D: TElementDef;
|
|
N: Integer;
|
|
begin
|
|
N := 0;
|
|
for D in FConfig.Elements do
|
|
if D.Kind = AKind then
|
|
Inc(N);
|
|
Result := Format('%s %d', [ELEMENT_NAMES[AKind], N]);
|
|
end;
|
|
|
|
{ drag & drop dalla palette }
|
|
|
|
procedure TConsoleForm.CanvasDragOver(Sender, Source: TObject; X, Y: Integer;
|
|
State: TDragState; var Accept: Boolean);
|
|
begin
|
|
Accept := (FMode = amConfig) and (Source is TControl) and
|
|
(TControl(Source).Parent = pnlPalette);
|
|
end;
|
|
|
|
function TConsoleForm.FindFreeSpot(const APreferred: TPoint;
|
|
AWidth, AHeight: Integer): TPoint;
|
|
|
|
function Occupied(AX, AY: Integer): Boolean;
|
|
var
|
|
D: TElementDef;
|
|
R, Dummy: TRect;
|
|
begin
|
|
R := Rect(AX, AY, AX + AWidth, AY + AHeight);
|
|
for D in FConfig.Elements do
|
|
if IntersectRect(Dummy, R, D.Bounds) then
|
|
Exit(True);
|
|
Result := False;
|
|
end;
|
|
|
|
var
|
|
Step, X, Y, I: Integer;
|
|
begin
|
|
Result := APreferred;
|
|
if Result.X < 0 then
|
|
Result.X := 0;
|
|
if Result.Y < 0 then
|
|
Result.Y := 0;
|
|
if Result.X + AWidth > FConfig.PanelWidth then
|
|
Result.X := Max(0, FConfig.PanelWidth - AWidth);
|
|
if Result.Y + AHeight > FConfig.PanelHeight then
|
|
Result.Y := Max(0, FConfig.PanelHeight - AHeight);
|
|
if not Occupied(Result.X, Result.Y) then
|
|
Exit;
|
|
|
|
// Occupato: prima si prova a cascata in diagonale, cosi' il nuovo elemento
|
|
// resta vicino a dove e' stato rilasciato invece di saltare altrove.
|
|
Step := Max(GridStep, FREE_SPOT_STEP);
|
|
for I := 1 to 24 do
|
|
begin
|
|
X := Result.X + I * Step;
|
|
Y := Result.Y + I * Step;
|
|
if (X + AWidth > FConfig.PanelWidth) or (Y + AHeight > FConfig.PanelHeight) then
|
|
Break;
|
|
if not Occupied(X, Y) then
|
|
Exit(Point(X, Y));
|
|
end;
|
|
|
|
// Se la diagonale non basta si scandisce tutto il pannello.
|
|
Y := 0;
|
|
while Y + AHeight <= FConfig.PanelHeight do
|
|
begin
|
|
X := 0;
|
|
while X + AWidth <= FConfig.PanelWidth do
|
|
begin
|
|
if not Occupied(X, Y) then
|
|
Exit(Point(X, Y));
|
|
Inc(X, Step);
|
|
end;
|
|
Inc(Y, Step);
|
|
end;
|
|
// Pannello pieno: si lascia dove l'utente ha rilasciato.
|
|
end;
|
|
|
|
procedure TConsoleForm.CanvasDragDrop(Sender, Source: TObject;
|
|
X, Y: Integer);
|
|
var
|
|
P: TPoint;
|
|
Kind: TElementKind;
|
|
Def: TElementDef;
|
|
Step: Integer;
|
|
begin
|
|
if not ((FMode = amConfig) and (Source is TControl) and
|
|
(TControl(Source).Parent = pnlPalette)) then
|
|
Exit;
|
|
|
|
P := Point(X, Y);
|
|
// Se si rilascia sopra un elemento gia' presente, le coordinate arrivano
|
|
// relative a quello: vanno riportate sul pannello.
|
|
if (Sender <> pnlCanvas) and (Sender is TControl) then
|
|
P := TControl(Sender).ClientToParent(P, pnlCanvas);
|
|
// Dalle coordinate a video a quelle logiche del pannello.
|
|
P := Point(Round(P.X / FZoom), Round(P.Y / FZoom));
|
|
|
|
PushUndo;
|
|
Kind := TElementKind(TControl(Source).Tag);
|
|
Def := TElementDef.Create(Kind);
|
|
Def.Caption := UniqueCaption(Kind);
|
|
P := Point(P.X - Def.Width div 2, P.Y - Def.Height div 2);
|
|
Step := GridStep;
|
|
if Step > 1 then
|
|
P := Point(Round(P.X / Step) * Step, Round(P.Y / Step) * Step);
|
|
P := FindFreeSpot(P, Def.Width, Def.Height);
|
|
Def.Left := P.X;
|
|
Def.Top := P.Y;
|
|
|
|
FConfig.Elements.Add(Def);
|
|
SelectElement(CreateElementControl(Def));
|
|
MarkDirty;
|
|
if Def.Caption <> '' then
|
|
SetStatus(Format('Aggiunto: %s', [Def.Caption]), True)
|
|
else
|
|
SetStatus('Aggiunta immagine. Scegli quale nel pannello a destra.', True);
|
|
end;
|
|
|
|
procedure TConsoleForm.CanvasMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
// Click sul vuoto: deseleziona.
|
|
if (FMode = amConfig) and (Button = mbLeft) then
|
|
begin
|
|
SelectElement(nil);
|
|
FocusCanvas;
|
|
end;
|
|
end;
|
|
|
|
{ selezione e proprieta' }
|
|
|
|
procedure TConsoleForm.ElementSelectRequest(ASender: TPlanciaElement);
|
|
begin
|
|
SelectElement(ASender);
|
|
FocusCanvas;
|
|
end;
|
|
|
|
procedure TConsoleForm.FocusCanvas;
|
|
begin
|
|
// Cliccando un elemento il fuoco restava nell'ultima casella delle
|
|
// proprieta': li' ctrl+freccia sposta il cursore nel testo invece
|
|
// dell'elemento. Portarlo sul pannello rende i tasti della plancia.
|
|
if (ActiveControl <> scrCanvas) and scrCanvas.CanFocus then
|
|
scrCanvas.SetFocus;
|
|
end;
|
|
|
|
procedure TConsoleForm.ElementBeginChange(ASender: TPlanciaElement);
|
|
begin
|
|
PushUndo;
|
|
end;
|
|
|
|
procedure TConsoleForm.ElementGeometryChanged(ASender: TPlanciaElement);
|
|
begin
|
|
MarkDirty;
|
|
if ASender = FSelected then
|
|
begin
|
|
FUpdatingProps := True;
|
|
try
|
|
edtLeft.Text := IntToStr(ASender.Def.Left);
|
|
edtTop.Text := IntToStr(ASender.Def.Top);
|
|
edtWidth.Text := IntToStr(ASender.Def.Width);
|
|
edtHeight.Text := IntToStr(ASender.Def.Height);
|
|
finally
|
|
FUpdatingProps := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.SelectElement(AElement: TPlanciaElement);
|
|
begin
|
|
if FSelected <> nil then
|
|
FSelected.Selected := False;
|
|
FSelected := AElement;
|
|
if FSelected <> nil then
|
|
FSelected.Selected := True;
|
|
LoadProps;
|
|
end;
|
|
|
|
procedure TConsoleForm.RefreshImageLists;
|
|
var
|
|
I, Sel: Integer;
|
|
Names: TStringList;
|
|
begin
|
|
Sel := lstImmagini.ItemIndex;
|
|
lstImmagini.Items.BeginUpdate;
|
|
try
|
|
lstImmagini.Items.Clear;
|
|
for I := 0 to FConfig.Images.Count - 1 do
|
|
if FConfig.Images.Item(I).Loaded then
|
|
lstImmagini.Items.Add(FConfig.Images.Item(I).Name)
|
|
else
|
|
// Il file manca o non si apre: va detto subito, non a bordo.
|
|
lstImmagini.Items.Add(FConfig.Images.Item(I).Name + ' [!]');
|
|
finally
|
|
lstImmagini.Items.EndUpdate;
|
|
end;
|
|
if Sel < lstImmagini.Items.Count then
|
|
lstImmagini.ItemIndex := Sel;
|
|
|
|
Names := TStringList.Create;
|
|
try
|
|
FConfig.Images.FillNames(Names, True);
|
|
FUpdatingProps := True;
|
|
try
|
|
cboImgOff.Items.Assign(Names);
|
|
cboImgOn.Items.Assign(Names);
|
|
cboSfondo.Items.Assign(Names);
|
|
cboSfondo.ItemIndex := cboSfondo.Items.IndexOf(FConfig.Background);
|
|
finally
|
|
FUpdatingProps := False;
|
|
end;
|
|
finally
|
|
Names.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.RefreshSoundList;
|
|
var
|
|
F, Scelto: string;
|
|
begin
|
|
// Si ricorda la scelta: rileggendo la cartella non deve sparire il file
|
|
// gia' assegnato alla spia.
|
|
Scelto := cboSuono.Text;
|
|
FUpdatingProps := True;
|
|
try
|
|
cboSuono.Items.BeginUpdate;
|
|
try
|
|
cboSuono.Items.Clear;
|
|
cboSuono.Items.Add('');
|
|
if TDirectory.Exists(FConfig.SoundsDir) then
|
|
for F in TDirectory.GetFiles(FConfig.SoundsDir, '*.*') do
|
|
if MatchStr(LowerCase(ExtractFileExt(F)), ['.mp3', '.wav']) then
|
|
cboSuono.Items.Add(ExtractFileName(F));
|
|
finally
|
|
cboSuono.Items.EndUpdate;
|
|
end;
|
|
// Un file assegnato ma non piu' nella cartella resta in elenco, con un
|
|
// segno: meglio vederlo mancante che vederlo sparire in silenzio.
|
|
if (Scelto <> '') and (cboSuono.Items.IndexOf(Scelto) < 0) then
|
|
cboSuono.Items.Add(Scelto);
|
|
cboSuono.ItemIndex := cboSuono.Items.IndexOf(Scelto);
|
|
finally
|
|
FUpdatingProps := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnSuoniRileggiClick(Sender: TObject);
|
|
begin
|
|
RefreshSoundList;
|
|
if not TDirectory.Exists(FConfig.SoundsDir) then
|
|
SetStatusFor(Format('Cartella dei suoni non trovata: %s',
|
|
[FConfig.SoundsDir]), False, STATUS_HOLD_MS)
|
|
else
|
|
SetStatusFor(Format('%d suoni nella cartella %s',
|
|
[cboSuono.Items.Count - 1, ExtractFileName(FConfig.SoundsDir)]), True,
|
|
STATUS_HOLD_MS);
|
|
end;
|
|
|
|
procedure TConsoleForm.TriggerAlarm(AElement: TPlanciaElement);
|
|
var
|
|
D: TElementDef;
|
|
F: string;
|
|
begin
|
|
D := AElement.Def;
|
|
if (FAlarms = nil) or not D.Alarm or (D.Sound = '') then
|
|
Exit;
|
|
// Zittito: la spia resta accesa e segnata, ma il cicalino tace.
|
|
if AElement.AlarmMuted then
|
|
Exit;
|
|
F := IncludeTrailingPathDelimiter(FConfig.SoundsDir) + D.Sound;
|
|
// In ciclo: finche' l'allarme c'e', il suono ricomincia.
|
|
if not FAlarms.Play(F, True) then
|
|
// Un allarme che non suona va detto: chi sta guardando altrove si fida
|
|
// del cicalino.
|
|
SetStatusFor(Format('%s: allarme muto, %s (%s)',
|
|
[D.Caption, FAlarms.LastError, D.Sound]), False, STATUS_HOLD_MS);
|
|
end;
|
|
|
|
procedure TConsoleForm.KeepAlarmSounding(AElement: TPlanciaElement);
|
|
var
|
|
F: string;
|
|
begin
|
|
if FAlarms = nil then
|
|
Exit;
|
|
F := IncludeTrailingPathDelimiter(FConfig.SoundsDir) + AElement.Def.Sound;
|
|
// In silenzio: se il file manca l'ha gia' detto TriggerAlarm, e ripeterlo
|
|
// dieci volte al secondo riempirebbe la barra di stato.
|
|
if not FAlarms.IsPlaying(F) then
|
|
FAlarms.Play(F, True);
|
|
end;
|
|
|
|
procedure TConsoleForm.StopAlarm(AElement: TPlanciaElement);
|
|
var
|
|
E: TPlanciaElement;
|
|
Suono: string;
|
|
begin
|
|
Suono := AElement.Def.Sound;
|
|
if (FAlarms = nil) or (Suono = '') then
|
|
Exit;
|
|
// Lo stesso file puo' servire a piu' spie: si tace solo se nessun'altra
|
|
// spia accesa lo sta ancora usando, altrimenti si zittirebbe un allarme
|
|
// che c'e' ancora.
|
|
for E in FElements do
|
|
if (E <> AElement) and (E.Def.Kind = ekLamp) and E.Def.Alarm and
|
|
E.State and not E.AlarmMuted and SameText(E.Def.Sound, Suono) then
|
|
Exit;
|
|
FAlarms.Stop(IncludeTrailingPathDelimiter(FConfig.SoundsDir) + Suono);
|
|
end;
|
|
|
|
/// Quanto dura un silenzio, come lo si dice a voce.
|
|
function DurataMuta(ASeconds: Integer): string;
|
|
begin
|
|
if ASeconds >= 3600 then
|
|
Result := 'un''ora'
|
|
else if ASeconds >= 60 then
|
|
Result := Format('%d minuti', [ASeconds div 60])
|
|
else
|
|
Result := Format('%d secondi', [ASeconds]);
|
|
end;
|
|
|
|
procedure TConsoleForm.ElementMuteRequest(ASender: TPlanciaElement);
|
|
var
|
|
Secondi: Integer;
|
|
begin
|
|
Secondi := ASender.PressAlarmMute;
|
|
if Secondi > 0 then
|
|
begin
|
|
// Il suono in corso si ferma subito: aspettare la fine del cicalino
|
|
// mentre si preme non avrebbe senso. Solo il suo, pero': gli altri
|
|
// allarmi non li ha zittiti nessuno.
|
|
StopAlarm(ASender);
|
|
SetStatusFor(Format('%s: allarme zittito per %s. Premi di nuovo per ' +
|
|
'allungare, ancora per riattivarlo.',
|
|
[ASender.Def.Caption, DurataMuta(Secondi)]), True, STATUS_HOLD_MS);
|
|
end
|
|
else
|
|
SetStatusFor(Format('%s: allarme di nuovo attivo.',
|
|
[ASender.Def.Caption]), True, STATUS_HOLD_MS);
|
|
UpdateMutedAlarms;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnAllarmiClick(Sender: TObject);
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
for E in FElements do
|
|
E.ClearAlarmMute;
|
|
SetStatusFor('Allarmi sonori di nuovo attivi.', True, STATUS_HOLD_MS);
|
|
UpdateMutedAlarms;
|
|
end;
|
|
|
|
procedure TConsoleForm.UpdateMutedAlarms;
|
|
var
|
|
E: TPlanciaElement;
|
|
Zittiti, Minimo: Integer;
|
|
Visibile: Boolean;
|
|
begin
|
|
Zittiti := 0;
|
|
Minimo := 0;
|
|
for E in FElements do
|
|
begin
|
|
if E.Def.Kind <> ekLamp then
|
|
Continue;
|
|
if E.AlarmMuted then
|
|
begin
|
|
Inc(Zittiti);
|
|
if (Minimo = 0) or (E.MuteSecondsLeft < Minimo) then
|
|
Minimo := E.MuteSecondsLeft;
|
|
end
|
|
// Solo quando il silenzio finisce, non a ogni giro: zittire "per un
|
|
// minuto" vuol dire che dopo un minuto l'allarme torna a farsi sentire.
|
|
else if E.TakeMuteExpired and E.State then
|
|
TriggerAlarm(E);
|
|
|
|
// Finche' l'allarme c'e', il suono continua: se il file e' finito
|
|
// ricomincia. Un cicalino che suona una volta sola lo si perde se in
|
|
// quel momento si sta guardando altrove.
|
|
if (not E.AlarmMuted) and E.State and E.Def.Alarm and
|
|
(E.Def.Sound <> '') then
|
|
KeepAlarmSounding(E);
|
|
end;
|
|
|
|
Visibile := Zittiti > 0;
|
|
if Visibile then
|
|
if Zittiti = 1 then
|
|
btnAllarmi.Caption := Format('1 allarme zittito (%s) - riattiva',
|
|
[DurataMuta(Minimo)])
|
|
else
|
|
btnAllarmi.Caption := Format('%d allarmi zittiti (%s) - riattiva',
|
|
[Zittiti, DurataMuta(Minimo)]);
|
|
if btnAllarmi.Visible <> Visibile then
|
|
begin
|
|
btnAllarmi.Visible := Visibile;
|
|
LayoutStatusBar;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnImgAddClick(Sender: TObject);
|
|
var
|
|
F: string;
|
|
Entry: TImageEntry;
|
|
begin
|
|
if not dlgImmagine.Execute then
|
|
Exit;
|
|
for F in dlgImmagine.Files do
|
|
begin
|
|
Entry := FConfig.Images.AddFile(F);
|
|
if not Entry.Loaded then
|
|
SetStatus(Format('Immagine "%s" non caricata: %s',
|
|
[Entry.Name, Entry.Error]), False);
|
|
end;
|
|
RefreshImageLists;
|
|
MarkDirty;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnImgDelClick(Sender: TObject);
|
|
var
|
|
Nome: string;
|
|
D: TElementDef;
|
|
Usata: Integer;
|
|
begin
|
|
if lstImmagini.ItemIndex < 0 then
|
|
Exit;
|
|
Nome := FConfig.Images.Item(lstImmagini.ItemIndex).Name;
|
|
|
|
Usata := 0;
|
|
for D in FConfig.Elements do
|
|
if (D.ImageOff = Nome) or (D.ImageOn = Nome) then
|
|
Inc(Usata);
|
|
if (Usata > 0) and (MessageDlg(Format(
|
|
'L''immagine "%s" e'' usata da %d elementi. Rimuoverla comunque?',
|
|
[Nome, Usata]), mtConfirmation, [mbYes, mbNo], 0) <> mrYes) then
|
|
Exit;
|
|
|
|
PushUndo;
|
|
for D in FConfig.Elements do
|
|
begin
|
|
if D.ImageOff = Nome then
|
|
D.ImageOff := '';
|
|
if D.ImageOn = Nome then
|
|
D.ImageOn := '';
|
|
end;
|
|
if FConfig.Background = Nome then
|
|
FConfig.Background := '';
|
|
|
|
FConfig.Images.Delete(Nome);
|
|
RefreshImageLists;
|
|
UpdateBackground;
|
|
RebuildPanel;
|
|
MarkDirty;
|
|
end;
|
|
|
|
procedure TConsoleForm.BackgroundChanged(Sender: TObject);
|
|
begin
|
|
if FUpdatingProps then
|
|
Exit;
|
|
PushUndo('sfondo');
|
|
FConfig.Background := cboSfondo.Text;
|
|
UpdateBackground;
|
|
MarkDirty;
|
|
end;
|
|
|
|
/// Posizione di un tipo dentro SWITCHABLE_KINDS, -1 se non e' scambiabile.
|
|
function SwitchableIndex(AKind: TElementKind): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Low(SWITCHABLE_KINDS) to High(SWITCHABLE_KINDS) do
|
|
if SWITCHABLE_KINDS[I] = AKind then
|
|
Exit(I);
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TConsoleForm.LoadProps;
|
|
var
|
|
Has, IsGauge, IsLamp, IsDisplay, IsRotary, IsKey: Boolean;
|
|
HasChannel, UsesImages, IsPicture: Boolean;
|
|
D: TElementDef;
|
|
begin
|
|
Has := FSelected <> nil;
|
|
IsGauge := Has and (FSelected.Def.Kind = ekGauge);
|
|
IsLamp := Has and (FSelected.Def.Kind = ekLamp);
|
|
IsDisplay := Has and (FSelected.Def.Kind = ekDisplay);
|
|
IsRotary := Has and (FSelected.Def.Kind = ekRotary);
|
|
HasChannel := Has and ElementHasChannel(FSelected.Def.Kind);
|
|
UsesImages := Has and ElementUsesImages(FSelected.Def.Kind);
|
|
IsPicture := Has and (FSelected.Def.Kind = ekImage);
|
|
|
|
// I gruppi occupano lo stesso posto: si mostra solo quello del tipo scelto.
|
|
gbGauge.Visible := IsGauge or IsDisplay;
|
|
gbGauge.Caption := 'Scala del gauge';
|
|
if IsDisplay then
|
|
gbGauge.Caption := 'Scala del display';
|
|
lblDigits.Visible := IsDisplay;
|
|
edtDigits.Visible := IsDisplay;
|
|
lblDecimals.Visible := IsDisplay;
|
|
edtDecimals.Visible := IsDisplay;
|
|
lblWarn.Visible := IsGauge;
|
|
edtWarnLo.Visible := IsGauge;
|
|
edtWarnHi.Visible := IsGauge;
|
|
gbRotary.Visible := IsRotary;
|
|
// L'allarme sonoro e' roba da spie: un pulsante lo si sta premendo, non
|
|
// c'e' niente da segnalare.
|
|
gbSuono.Visible := IsLamp;
|
|
if IsRotary then
|
|
UpdateRotaryFields(FSelected.Def)
|
|
else
|
|
begin
|
|
lblCanale2.Visible := False;
|
|
edtCanale2.Visible := False;
|
|
chkMolla.Visible := False;
|
|
end;
|
|
gbTesto.Visible := Has and (FSelected.Def.Kind = ekLabel);
|
|
gbImgElem.Visible := UsesImages;
|
|
// Tipo e forma valgono per i comandi a tasto e per la spia, che puo'
|
|
// avere lo stesso aspetto di un pulsante (lente tonda, tasto a video).
|
|
IsKey := Has and (FSelected.Def.Kind in [ekButton, ekSwitch, ekLamp]);
|
|
// Il tipo si cambia solo fra i comandi intercambiabili: per un gauge o una
|
|
// scritta la casella non avrebbe niente da offrire.
|
|
lblTipo.Visible := IsKey;
|
|
cboTipo.Visible := IsKey;
|
|
lblShape.Visible := IsKey;
|
|
cboShape.Visible := IsKey;
|
|
lblOnColor.Visible := IsKey or IsLamp;
|
|
edtOnColor.Visible := IsKey or IsLamp;
|
|
edtOffColor.Visible := IsKey or IsLamp;
|
|
lblCapPos.Visible := UsesImages and not IsPicture;
|
|
cboCapPos.Visible := UsesImages and not IsPicture;
|
|
// L'immagine decorativa non ha stato, quindi una sola immagine.
|
|
lblImgOn.Visible := UsesImages and not IsPicture;
|
|
cboImgOn.Visible := UsesImages and not IsPicture;
|
|
if IsPicture then
|
|
lblImgOff.Caption := 'Immagine'
|
|
else
|
|
lblImgOff.Caption := 'Immagine a riposo (vuoto = disegno)';
|
|
btnElimina.Enabled := Has;
|
|
edtCaption.Enabled := Has;
|
|
edtFontSize.Enabled := Has;
|
|
lblSlave.Enabled := HasChannel;
|
|
lblCanale.Enabled := HasChannel;
|
|
edtSlave.Enabled := HasChannel;
|
|
edtCanale.Enabled := HasChannel;
|
|
edtLeft.Enabled := Has;
|
|
edtTop.Enabled := Has;
|
|
edtWidth.Enabled := Has;
|
|
edtHeight.Enabled := Has;
|
|
|
|
FUpdatingProps := True;
|
|
try
|
|
if not Has then
|
|
begin
|
|
lblPropTitle.Caption := 'Nessun elemento selezionato';
|
|
edtCaption.Text := '';
|
|
edtSlave.Text := '';
|
|
edtCanale.Text := '';
|
|
edtLeft.Text := '';
|
|
edtTop.Text := '';
|
|
edtWidth.Text := '';
|
|
edtHeight.Text := '';
|
|
edtFontSize.Text := '';
|
|
cboImgOff.ItemIndex := -1;
|
|
cboImgOn.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
|
|
D := FSelected.Def;
|
|
if IsLamp then
|
|
lblPropTitle.Caption := ELEMENT_NAMES[D.Kind] + ' (ingresso)'
|
|
else
|
|
lblPropTitle.Caption := ELEMENT_NAMES[D.Kind];
|
|
edtCaption.Text := D.Caption;
|
|
if IsKey then
|
|
cboTipo.ItemIndex := SwitchableIndex(D.Kind);
|
|
if HasChannel then
|
|
begin
|
|
edtSlave.Text := IntToStr(D.Slave);
|
|
edtCanale.Text := IntToStr(D.Channel);
|
|
end
|
|
else
|
|
begin
|
|
edtSlave.Text := '';
|
|
edtCanale.Text := '';
|
|
end;
|
|
if D.FontSize > 0 then
|
|
edtFontSize.Text := IntToStr(D.FontSize)
|
|
else
|
|
edtFontSize.Text := '';
|
|
if UsesImages then
|
|
begin
|
|
cboImgOff.ItemIndex := cboImgOff.Items.IndexOf(D.ImageOff);
|
|
cboImgOn.ItemIndex := cboImgOn.Items.IndexOf(D.ImageOn);
|
|
cboCapPos.ItemIndex := Ord(D.CaptionPos);
|
|
cboShape.ItemIndex := Ord(D.Shape);
|
|
edtOnColor.Text := ColorToHtml(D.OnColor);
|
|
if D.OffColor = clNone then
|
|
edtOffColor.Text := ''
|
|
else
|
|
edtOffColor.Text := ColorToHtml(D.OffColor);
|
|
end;
|
|
if IsLamp then
|
|
begin
|
|
chkAllarme.Checked := D.Alarm;
|
|
cboSuono.ItemIndex := cboSuono.Items.IndexOf(D.Sound);
|
|
if (D.Sound <> '') and (cboSuono.ItemIndex < 0) then
|
|
begin
|
|
// Il file assegnato non c'e' piu' nella cartella: si mostra lo stesso,
|
|
// altrimenti salvando si perderebbe il nome.
|
|
cboSuono.Items.Add(D.Sound);
|
|
cboSuono.ItemIndex := cboSuono.Items.IndexOf(D.Sound);
|
|
end;
|
|
end;
|
|
if IsDisplay then
|
|
begin
|
|
edtDigits.Text := IntToStr(D.Digits);
|
|
edtDecimals.Text := IntToStr(D.Decimals);
|
|
end;
|
|
if IsRotary then
|
|
begin
|
|
cboPositions.ItemIndex := cboPositions.Items.IndexOf(IntToStr(D.Positions));
|
|
edtLegend.Text := D.Legend;
|
|
if D.Channel2 >= 0 then
|
|
edtCanale2.Text := IntToStr(D.Channel2)
|
|
else
|
|
edtCanale2.Text := '';
|
|
chkMolla.Checked := D.Momentary;
|
|
end;
|
|
if D.Kind = ekLabel then
|
|
begin
|
|
edtFontName.Text := D.FontName;
|
|
edtSpacing.Text := IntToStr(D.Spacing);
|
|
cboFrame.ItemIndex := Ord(D.Frame);
|
|
edtFrameWidth.Text := IntToStr(D.FrameWidth);
|
|
end;
|
|
edtLeft.Text := IntToStr(D.Left);
|
|
edtTop.Text := IntToStr(D.Top);
|
|
edtWidth.Text := IntToStr(D.Width);
|
|
edtHeight.Text := IntToStr(D.Height);
|
|
if IsGauge or IsDisplay then
|
|
begin
|
|
edtRawMin.Text := IntToStr(D.RawMin);
|
|
edtRawMax.Text := IntToStr(D.RawMax);
|
|
edtEngMin.Text := FloatToStr(D.EngMin);
|
|
edtEngMax.Text := FloatToStr(D.EngMax);
|
|
edtUnits.Text := D.Units;
|
|
if D.WarnBelow <= GAUGE_NO_WARN_LO then
|
|
edtWarnLo.Text := ''
|
|
else
|
|
edtWarnLo.Text := FloatToStr(D.WarnBelow);
|
|
if D.WarnAbove >= GAUGE_NO_WARN_HI then
|
|
edtWarnHi.Text := ''
|
|
else
|
|
edtWarnHi.Text := FloatToStr(D.WarnAbove);
|
|
end;
|
|
finally
|
|
FUpdatingProps := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.UpdateRotaryFields(ADef: TElementDef);
|
|
var
|
|
Is3Pos: Boolean;
|
|
begin
|
|
// La seconda bobina esiste solo a tre posizioni: mostrare la casella su un
|
|
// selettore a due farebbe credere che ne comandi due.
|
|
Is3Pos := (ADef <> nil) and (ADef.Kind = ekRotary) and (ADef.Positions >= 3);
|
|
lblCanale2.Visible := Is3Pos;
|
|
edtCanale2.Visible := Is3Pos;
|
|
if Is3Pos then
|
|
lblCanale2.Caption := Format('Canale lato destro (vuoto = %d)',
|
|
[ADef.Channel + 1]);
|
|
chkMolla.Visible := (ADef <> nil) and (ADef.Kind = ekRotary);
|
|
end;
|
|
|
|
procedure TConsoleForm.PropChanged(Sender: TObject);
|
|
var
|
|
D: TElementDef;
|
|
|
|
function Num(AEdit: TEdit; ADefault: Double): Double;
|
|
begin
|
|
if Trim(AEdit.Text) = '' then
|
|
Exit(ADefault);
|
|
Result := StrToFloatDef(AEdit.Text, ADefault);
|
|
end;
|
|
|
|
begin
|
|
if FUpdatingProps or (FSelected = nil) then
|
|
Exit;
|
|
|
|
D := FSelected.Def;
|
|
// Una cifra alla volta: le battute sullo stesso campo dello stesso elemento
|
|
// diventano un passo solo, altrimenti "120" si annullerebbe in tre volte.
|
|
if Sender is TComponent then
|
|
PushUndo(Format('prop:%s:%p', [TComponent(Sender).Name, Pointer(D)]))
|
|
else
|
|
PushUndo;
|
|
D.Caption := edtCaption.Text;
|
|
if ElementHasChannel(D.Kind) then
|
|
begin
|
|
D.Slave := StrToIntDef(edtSlave.Text, D.Slave);
|
|
D.Channel := StrToIntDef(edtCanale.Text, D.Channel);
|
|
end;
|
|
D.Left := StrToIntDef(edtLeft.Text, D.Left);
|
|
D.Top := StrToIntDef(edtTop.Text, D.Top);
|
|
D.Width := StrToIntDef(edtWidth.Text, D.Width);
|
|
D.Height := StrToIntDef(edtHeight.Text, D.Height);
|
|
if D.Width < MIN_ELEMENT_SIZE then
|
|
D.Width := MIN_ELEMENT_SIZE;
|
|
if D.Height < MIN_ELEMENT_SIZE then
|
|
D.Height := MIN_ELEMENT_SIZE;
|
|
|
|
D.FontSize := StrToIntDef(edtFontSize.Text, 0);
|
|
if D.FontSize < 0 then
|
|
D.FontSize := 0;
|
|
|
|
if ElementUsesImages(D.Kind) then
|
|
begin
|
|
D.ImageOff := cboImgOff.Text;
|
|
if D.Kind = ekImage then
|
|
D.ImageOn := ''
|
|
else
|
|
begin
|
|
D.ImageOn := cboImgOn.Text;
|
|
if cboCapPos.ItemIndex >= 0 then
|
|
D.CaptionPos := TCaptionPos(cboCapPos.ItemIndex);
|
|
D.OnColor := HtmlToColor(edtOnColor.Text, D.OnColor);
|
|
if Trim(edtOffColor.Text) = '' then
|
|
D.OffColor := clNone
|
|
else
|
|
D.OffColor := HtmlToColor(edtOffColor.Text, D.OffColor);
|
|
end;
|
|
if (D.Kind in [ekButton, ekSwitch, ekLamp]) and (cboShape.ItemIndex >= 0) then
|
|
D.Shape := TKeyShape(cboShape.ItemIndex);
|
|
end;
|
|
|
|
if ElementIsAnalog(D.Kind) then
|
|
begin
|
|
D.RawMin := StrToIntDef(edtRawMin.Text, D.RawMin);
|
|
D.RawMax := StrToIntDef(edtRawMax.Text, D.RawMax);
|
|
D.EngMin := Num(edtEngMin, D.EngMin);
|
|
D.EngMax := Num(edtEngMax, D.EngMax);
|
|
D.Units := edtUnits.Text;
|
|
end;
|
|
if D.Kind = ekGauge then
|
|
begin
|
|
D.WarnBelow := Num(edtWarnLo, GAUGE_NO_WARN_LO);
|
|
D.WarnAbove := Num(edtWarnHi, GAUGE_NO_WARN_HI);
|
|
end;
|
|
if D.Kind = ekDisplay then
|
|
begin
|
|
D.Digits := StrToIntDef(edtDigits.Text, D.Digits);
|
|
D.Decimals := StrToIntDef(edtDecimals.Text, D.Decimals);
|
|
if D.Digits < 1 then
|
|
D.Digits := 1;
|
|
if D.Decimals < 0 then
|
|
D.Decimals := 0;
|
|
end;
|
|
if D.Kind = ekLamp then
|
|
begin
|
|
D.Alarm := chkAllarme.Checked;
|
|
D.Sound := cboSuono.Text;
|
|
end;
|
|
if D.Kind = ekRotary then
|
|
begin
|
|
D.Positions := StrToIntDef(cboPositions.Text, D.Positions);
|
|
D.Legend := edtLegend.Text;
|
|
// Vuoto = automatico, cioe' la bobina dopo quella di sinistra.
|
|
if Trim(edtCanale2.Text) = '' then
|
|
D.Channel2 := -1
|
|
else
|
|
D.Channel2 := Max(0, StrToIntDef(edtCanale2.Text, -1));
|
|
D.Momentary := chkMolla.Checked;
|
|
// Diventato a molla, riparte dal centro: e' il suo stato a riposo.
|
|
if D.Momentary then
|
|
FSelected.SyncRotary(0);
|
|
// Il numero di posizioni decide se la seconda bobina si vede, e il
|
|
// suggerimento del canale automatico segue il canale di sinistra.
|
|
// Solo queste due caselle, non LoadProps: riscriverebbe il testo di
|
|
// quella in cui si sta scrivendo, spostando il cursore.
|
|
UpdateRotaryFields(D);
|
|
end;
|
|
if D.Kind = ekLabel then
|
|
begin
|
|
D.FontName := Trim(edtFontName.Text);
|
|
D.Spacing := StrToIntDef(edtSpacing.Text, D.Spacing);
|
|
if cboFrame.ItemIndex >= 0 then
|
|
D.Frame := TFrameKind(cboFrame.ItemIndex);
|
|
D.FrameWidth := Max(1, StrToIntDef(edtFrameWidth.Text, D.FrameWidth));
|
|
end;
|
|
|
|
FSelected.Hint := ElementHint(D);
|
|
FSelected.ApplyDef;
|
|
FPlanDirty := True;
|
|
MarkDirty;
|
|
end;
|
|
|
|
procedure TConsoleForm.KindChanged(Sender: TObject);
|
|
var
|
|
D: TElementDef;
|
|
NewKind, OldKind: TElementKind;
|
|
begin
|
|
if FUpdatingProps or (FSelected = nil) or (cboTipo.ItemIndex < 0) then
|
|
Exit;
|
|
|
|
NewKind := SWITCHABLE_KINDS[cboTipo.ItemIndex];
|
|
D := FSelected.Def;
|
|
if D.Kind = NewKind then
|
|
Exit;
|
|
PushUndo;
|
|
|
|
// L'etichetta di partenza e' il nome del tipo: se l'utente non l'ha ancora
|
|
// cambiata, seguirla al nuovo tipo evita un "Pulsante" che e' un interruttore.
|
|
if D.Caption = ELEMENT_NAMES[D.Kind] then
|
|
D.Caption := ELEMENT_NAMES[NewKind];
|
|
|
|
OldKind := D.Kind;
|
|
D.Kind := NewKind;
|
|
|
|
// Un interruttore acceso che diventa pulsante resterebbe illuminato per
|
|
// sempre: il pulsante non viene riletto dal campo, quindi nessuno lo
|
|
// spegnerebbe piu'. Si riparte da spento e ci pensa il polling.
|
|
FSelected.SyncState(False);
|
|
FSelected.ApplyDef;
|
|
|
|
// Cambia la funzione Modbus con cui il canale viene letto: gli interruttori
|
|
// rileggono le bobine, i pulsanti no, le spie leggono gli ingressi digitali.
|
|
// Il piano di polling va rifatto.
|
|
FPlanDirty := True;
|
|
FSelected.Hint := ElementHint(D);
|
|
MarkDirty;
|
|
// Da comando a spia il canale cambia significato: non e' piu' una bobina
|
|
// da comandare ma un ingresso da leggere. Va detto, perche' il numero resta
|
|
// quello di prima e quasi mai e' giusto.
|
|
if (NewKind = ekLamp) and (OldKind <> ekLamp) then
|
|
SetStatus(Format('%s: ora il canale %d e'' un ingresso digitale da ' +
|
|
'leggere, non piu'' una bobina. Verifica slave e canale.',
|
|
[D.Caption, D.Channel]), True)
|
|
else if (OldKind = ekLamp) and (NewKind <> ekLamp) then
|
|
SetStatus(Format('%s: ora il canale %d e'' una bobina da comandare, non ' +
|
|
'piu'' un ingresso. Verifica slave e canale.',
|
|
[D.Caption, D.Channel]), True);
|
|
|
|
// Titolo e caselle visibili dipendono dal tipo: ricaricare le proprieta'
|
|
// rimette il pannello in pari.
|
|
LoadProps;
|
|
end;
|
|
|
|
procedure TConsoleForm.GeneralChanged(Sender: TObject);
|
|
begin
|
|
if FUpdatingProps then
|
|
Exit;
|
|
if Sender is TComponent then
|
|
PushUndo('generale:' + TComponent(Sender).Name)
|
|
else
|
|
PushUndo;
|
|
FConfig.Port := cboPort.Text;
|
|
FConfig.Baud := StrToIntDef(cboBaud.Text, FConfig.Baud);
|
|
FConfig.PollMs := StrToIntDef(edtPoll.Text, FConfig.PollMs);
|
|
FConfig.Title := edtTitolo.Text;
|
|
FConfig.PanelWidth := StrToIntDef(edtPanelW.Text, FConfig.PanelWidth);
|
|
FConfig.PanelHeight := StrToIntDef(edtPanelH.Text, FConfig.PanelHeight);
|
|
if FConfig.PanelWidth < 100 then
|
|
FConfig.PanelWidth := 100;
|
|
if FConfig.PanelHeight < 100 then
|
|
FConfig.PanelHeight := 100;
|
|
ResizeCanvas;
|
|
MarkDirty;
|
|
end;
|
|
|
|
procedure TConsoleForm.DeleteSelected;
|
|
var
|
|
E: TPlanciaElement;
|
|
D: TElementDef;
|
|
begin
|
|
if (FMode <> amConfig) or (FSelected = nil) then
|
|
Exit;
|
|
PushUndo;
|
|
E := FSelected;
|
|
D := E.Def;
|
|
SelectElement(nil);
|
|
FElements.Remove(E);
|
|
E.Free;
|
|
// La lista possiede le definizioni: Remove la distrugge.
|
|
FConfig.Elements.Remove(D);
|
|
FPlanDirty := True;
|
|
MarkDirty;
|
|
SetStatus('Elemento eliminato.', True);
|
|
end;
|
|
|
|
procedure TConsoleForm.btnEliminaClick(Sender: TObject);
|
|
begin
|
|
DeleteSelected;
|
|
end;
|
|
|
|
procedure TConsoleForm.FormKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
InText: Boolean;
|
|
DX, DY: Integer;
|
|
begin
|
|
if FMode <> amConfig then
|
|
Exit;
|
|
|
|
// Annulla e ripeti valgono ovunque, anche con il fuoco in una casella delle
|
|
// proprieta': ogni battuta li' e' gia' una modifica nello storico, e l'annulla
|
|
// del testo della casella andrebbe per conto suo.
|
|
if (ssCtrl in Shift) and not (ssAlt in Shift) then
|
|
if (Key = Ord('Z')) and not (ssShift in Shift) then
|
|
begin
|
|
StepHistory(FUndo, FRedo);
|
|
Key := 0;
|
|
Exit;
|
|
end
|
|
else if (Key = Ord('Y')) or ((Key = Ord('Z')) and (ssShift in Shift)) then
|
|
begin
|
|
StepHistory(FRedo, FUndo);
|
|
Key := 0;
|
|
Exit;
|
|
end;
|
|
|
|
// Nelle caselle frecce e Canc lavorano sul testo, non sulla plancia.
|
|
InText := (ActiveControl is TCustomEdit) or
|
|
(ActiveControl is TCustomComboBox) or (ActiveControl is TCustomListBox);
|
|
if InText then
|
|
Exit;
|
|
|
|
if Key = VK_DELETE then
|
|
begin
|
|
DeleteSelected;
|
|
Key := 0;
|
|
Exit;
|
|
end;
|
|
|
|
if (FSelected = nil) or not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN]) then
|
|
Exit;
|
|
DX := 0;
|
|
DY := 0;
|
|
case Key of
|
|
VK_LEFT: DX := -1;
|
|
VK_RIGHT: DX := 1;
|
|
VK_UP: DY := -1;
|
|
VK_DOWN: DY := 1;
|
|
end;
|
|
// Ctrl+freccia sposta di un pixel, Maiusc+freccia allarga o stringe:
|
|
// destra e giu' ingrandiscono, sinistra e su rimpiccioliscono.
|
|
if (ssCtrl in Shift) and not (ssShift in Shift) then
|
|
begin
|
|
NudgeSelected(DX, DY, False);
|
|
Key := 0;
|
|
end
|
|
else if (ssShift in Shift) and not (ssCtrl in Shift) then
|
|
begin
|
|
NudgeSelected(DX, DY, True);
|
|
Key := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.FormKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
// Ctrl+Z e Ctrl+Y arrivano anche come carattere: senza fermarli qui la
|
|
// casella col fuoco farebbe il proprio annulla del testo, e quello
|
|
// riscriverebbe la proprieta' appena riportata indietro.
|
|
if (FMode = amConfig) and ((Key = #26) or (Key = #25)) then
|
|
Key := #0;
|
|
end;
|
|
|
|
procedure TConsoleForm.NudgeSelected(ADX, ADY: Integer; AResize: Boolean);
|
|
var
|
|
D: TElementDef;
|
|
L, T, W, H: Integer;
|
|
begin
|
|
if FSelected = nil then
|
|
Exit;
|
|
D := FSelected.Def;
|
|
L := D.Left;
|
|
T := D.Top;
|
|
W := D.Width;
|
|
H := D.Height;
|
|
// Un pixel esatto, senza griglia: e' proprio quello che la griglia non
|
|
// permette di fare col mouse. Si resta dentro il pannello.
|
|
if AResize then
|
|
begin
|
|
W := EnsureRange(W + ADX, MIN_ELEMENT_SIZE,
|
|
Max(MIN_ELEMENT_SIZE, FConfig.PanelWidth - L));
|
|
H := EnsureRange(H + ADY, MIN_ELEMENT_SIZE,
|
|
Max(MIN_ELEMENT_SIZE, FConfig.PanelHeight - T));
|
|
end
|
|
else
|
|
begin
|
|
L := EnsureRange(L + ADX, 0, Max(0, FConfig.PanelWidth - W));
|
|
T := EnsureRange(T + ADY, 0, Max(0, FConfig.PanelHeight - H));
|
|
end;
|
|
if (L = D.Left) and (T = D.Top) and (W = D.Width) and (H = D.Height) then
|
|
Exit;
|
|
|
|
// Tenendo premuto il tasto si fa un passo di annulla solo.
|
|
if AResize then
|
|
PushUndo(Format('misura:%p', [Pointer(D)]))
|
|
else
|
|
PushUndo(Format('sposta:%p', [Pointer(D)]));
|
|
D.Left := L;
|
|
D.Top := T;
|
|
D.Width := W;
|
|
D.Height := H;
|
|
FSelected.ApplyDef;
|
|
ElementGeometryChanged(FSelected);
|
|
end;
|
|
|
|
{ annulla e ripeti }
|
|
|
|
function TConsoleForm.SelectedIndex: Integer;
|
|
begin
|
|
if FSelected = nil then
|
|
Result := -1
|
|
else
|
|
Result := FConfig.Elements.IndexOf(FSelected.Def);
|
|
end;
|
|
|
|
procedure TConsoleForm.PushUndo(const AKey: string);
|
|
var
|
|
Snap: TPlanciaSnapshot;
|
|
Now: UInt64;
|
|
begin
|
|
if FMode <> amConfig then
|
|
Exit;
|
|
Now := GetTickCount64;
|
|
if (AKey <> '') and (AKey = FUndoKey) and (FUndo.Count > 0) and
|
|
(Now - FUndoTime < UNDO_MERGE_MS) then
|
|
begin
|
|
// Stessa modifica che continua: la foto di partenza c'e' gia'.
|
|
FUndoTime := Now;
|
|
Exit;
|
|
end;
|
|
|
|
Snap := FConfig.TakeSnapshot;
|
|
Snap.Selected := SelectedIndex;
|
|
FUndo.Add(Snap);
|
|
while FUndo.Count > UNDO_LIMIT do
|
|
FUndo.Delete(0);
|
|
// Una modifica nuova chiude la strada a quelle annullate.
|
|
FRedo.Clear;
|
|
FUndoKey := AKey;
|
|
FUndoTime := Now;
|
|
UpdateUndoButtons;
|
|
end;
|
|
|
|
procedure TConsoleForm.ClearUndo;
|
|
begin
|
|
FUndo.Clear;
|
|
FRedo.Clear;
|
|
FUndoKey := '';
|
|
UpdateUndoButtons;
|
|
end;
|
|
|
|
procedure TConsoleForm.UpdateUndoButtons;
|
|
begin
|
|
btnAnnulla.Enabled := FUndo.Count > 0;
|
|
btnRipeti.Enabled := FRedo.Count > 0;
|
|
end;
|
|
|
|
procedure TConsoleForm.StepHistory(AFrom, ATo: TObjectList<TPlanciaSnapshot>);
|
|
var
|
|
Snap, Current: TPlanciaSnapshot;
|
|
Sel: Integer;
|
|
begin
|
|
if (FMode <> amConfig) or (AFrom.Count = 0) then
|
|
Exit;
|
|
// A trascinamento in corso il pannello non si ricostruisce: si
|
|
// distruggerebbe l'elemento che ha il mouse in mano.
|
|
if GetKeyState(VK_LBUTTON) < 0 then
|
|
Exit;
|
|
|
|
Current := FConfig.TakeSnapshot;
|
|
Current.Selected := SelectedIndex;
|
|
ATo.Add(Current);
|
|
|
|
Snap := AFrom.Extract(AFrom.Last);
|
|
try
|
|
FConfig.RestoreSnapshot(Snap);
|
|
Sel := Snap.Selected;
|
|
finally
|
|
Snap.Free;
|
|
end;
|
|
// La prossima modifica e' comunque un passo nuovo.
|
|
FUndoKey := '';
|
|
|
|
LoadGeneral;
|
|
RebuildPanel;
|
|
if (Sel >= 0) and (Sel < FElements.Count) then
|
|
SelectElement(FElements[Sel]);
|
|
FPlanDirty := True;
|
|
MarkDirty;
|
|
UpdateUndoButtons;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnAnnullaClick(Sender: TObject);
|
|
begin
|
|
StepHistory(FUndo, FRedo);
|
|
end;
|
|
|
|
procedure TConsoleForm.btnRipetiClick(Sender: TObject);
|
|
begin
|
|
StepHistory(FRedo, FUndo);
|
|
end;
|
|
|
|
{ file }
|
|
|
|
procedure TConsoleForm.MarkDirty;
|
|
begin
|
|
FDirty := True;
|
|
UpdateCaptions;
|
|
end;
|
|
|
|
procedure TConsoleForm.UpdateCaptions;
|
|
var
|
|
Star: string;
|
|
begin
|
|
if FMode = amAboard then
|
|
begin
|
|
Caption := FConfig.Title;
|
|
Exit;
|
|
end;
|
|
if FDirty then
|
|
Star := ' *'
|
|
else
|
|
Star := '';
|
|
Caption := Format('Plancia - Configurazione - %s%s',
|
|
[ExtractFileName(FFileName), Star]);
|
|
lblFile.Caption := FFileName + Star;
|
|
end;
|
|
|
|
procedure TConsoleForm.SetStatus(const AMsg: string; AOk: Boolean);
|
|
var
|
|
Conn: string;
|
|
begin
|
|
if AOk then
|
|
shpLed.Brush.Color := clLime
|
|
else
|
|
shpLed.Brush.Color := clRed;
|
|
if (FMode = amAboard) and (FConfig <> nil) then
|
|
Conn := Format('%s %d - ', [FConfig.Port, FConfig.Baud])
|
|
else
|
|
Conn := '';
|
|
lblStatus.Caption := Conn + AMsg;
|
|
end;
|
|
|
|
procedure TConsoleForm.SetStatusFor(const AMsg: string; AOk: Boolean;
|
|
AHoldMs: Integer);
|
|
begin
|
|
SetStatus(AMsg, AOk);
|
|
FStatusUntil := GetTickCount64 + UInt64(AHoldMs);
|
|
end;
|
|
|
|
function TConsoleForm.ConfirmDiscard: Boolean;
|
|
begin
|
|
Result := True;
|
|
if (FMode <> amConfig) or not FDirty then
|
|
Exit;
|
|
case MessageDlg('La plancia e'' stata modificata. Salvare le modifiche?',
|
|
mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
|
|
mrYes:
|
|
begin
|
|
btnSalvaClick(nil);
|
|
Result := not FDirty;
|
|
end;
|
|
mrNo:
|
|
Result := True;
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.DoLoad(const AFileName: string);
|
|
begin
|
|
try
|
|
FConfig.LoadFromFile(AFileName);
|
|
FFileName := AFileName;
|
|
FDirty := False;
|
|
FLoadFailed := False;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
// La lettura fallita lascia la configurazione vuota: il file va segnato
|
|
// come non caricato, altrimenti chiudendo ci si salverebbe sopra un
|
|
// pannello vuoto, cancellando quello che c'era.
|
|
FFileName := AFileName;
|
|
FLoadFailed := True;
|
|
FDirty := False;
|
|
RebuildPanel;
|
|
SetStatusFor(Format('%s non si apre: %s',
|
|
[ExtractFileName(AFileName), E.Message]), False, 60000);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
// Anche solo aperta, questa diventa la plancia da riaprire la prossima volta.
|
|
SaveLastFile(FFileName);
|
|
// Lo storico appartiene al file: annullare dopo un Apri riporterebbe la
|
|
// plancia precedente dentro quella nuova.
|
|
ClearUndo;
|
|
LoadGeneral;
|
|
RebuildPanel;
|
|
SetStatus(Format('Caricati %d elementi da %s',
|
|
[FConfig.Elements.Count, ExtractFileName(FFileName)]), True);
|
|
end;
|
|
|
|
procedure TConsoleForm.LoadGeneral;
|
|
begin
|
|
FUpdatingProps := True;
|
|
try
|
|
if cboPort.Items.IndexOf(FConfig.Port) < 0 then
|
|
cboPort.Items.Add(FConfig.Port);
|
|
cboPort.ItemIndex := cboPort.Items.IndexOf(FConfig.Port);
|
|
if cboBaud.Items.IndexOf(IntToStr(FConfig.Baud)) < 0 then
|
|
cboBaud.Items.Add(IntToStr(FConfig.Baud));
|
|
cboBaud.ItemIndex := cboBaud.Items.IndexOf(IntToStr(FConfig.Baud));
|
|
edtPoll.Text := IntToStr(FConfig.PollMs);
|
|
edtTitolo.Text := FConfig.Title;
|
|
edtPanelW.Text := IntToStr(FConfig.PanelWidth);
|
|
edtPanelH.Text := IntToStr(FConfig.PanelHeight);
|
|
finally
|
|
FUpdatingProps := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.DoSave(const AFileName: string);
|
|
begin
|
|
try
|
|
FConfig.SaveToFile(AFileName);
|
|
FFileName := AFileName;
|
|
FDirty := False;
|
|
// Ora il file c'e' e si apre: e' tornato un file su cui salvare.
|
|
FLoadFailed := False;
|
|
SaveLastFile(FFileName);
|
|
UpdateCaptions;
|
|
SetStatus('Salvato in ' + FFileName, True);
|
|
except
|
|
on E: Exception do
|
|
SetStatus('Errore di salvataggio: ' + E.Message, False);
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.btnNuovoClick(Sender: TObject);
|
|
begin
|
|
if not ConfirmDiscard then
|
|
Exit;
|
|
FConfig.Clear;
|
|
FFileName := DefaultConfigFile;
|
|
FDirty := False;
|
|
ClearUndo;
|
|
LoadGeneral;
|
|
RebuildPanel;
|
|
SetStatus('Nuova plancia.', True);
|
|
end;
|
|
|
|
procedure TConsoleForm.btnApriClick(Sender: TObject);
|
|
begin
|
|
if not ConfirmDiscard then
|
|
Exit;
|
|
dlgApri.FileName := FFileName;
|
|
if dlgApri.Execute then
|
|
DoLoad(dlgApri.FileName);
|
|
end;
|
|
|
|
procedure TConsoleForm.btnSalvaClick(Sender: TObject);
|
|
begin
|
|
DoSave(FFileName);
|
|
end;
|
|
|
|
procedure TConsoleForm.btnSalvaComeClick(Sender: TObject);
|
|
begin
|
|
dlgSalva.FileName := FFileName;
|
|
if dlgSalva.Execute then
|
|
DoSave(dlgSalva.FileName);
|
|
end;
|
|
|
|
procedure TConsoleForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
CanClose := True;
|
|
if (FMode <> amConfig) or not FDirty then
|
|
Exit;
|
|
|
|
// Il file non si era aperto: salvarci sopra il pannello vuoto lo
|
|
// cancellerebbe. Meglio chiedere dove metterlo.
|
|
if FLoadFailed then
|
|
begin
|
|
if MessageDlg(Format('%s non era stato letto, e salvarci sopra ora ' +
|
|
'cancellerebbe quello che contiene.' + sLineBreak +
|
|
'Salvare il lavoro in un altro file?', [ExtractFileName(FFileName)]),
|
|
mtWarning, [mbYes, mbNo], 0) = mrYes then
|
|
begin
|
|
btnSalvaComeClick(nil);
|
|
CanClose := not FDirty;
|
|
end;
|
|
Exit;
|
|
end;
|
|
|
|
// Chiudendo la configurazione il lavoro si salva da solo, senza chiedere:
|
|
// e' il file su cui si stava lavorando, ed e' quello che verra' riaperto.
|
|
DoSave(FFileName);
|
|
// Salvataggio fallito (disco pieno, file di sola lettura): qui la domanda
|
|
// serve, altrimenti si chiuderebbe perdendo tutto in silenzio.
|
|
if FDirty then
|
|
CanClose := MessageDlg(Format('Non riesco a salvare %s.' + sLineBreak +
|
|
'Chiudere comunque, perdendo le modifiche?', [FFileName]),
|
|
mtWarning, [mbYes, mbNo], 0) = mrYes;
|
|
end;
|
|
|
|
{ Modbus }
|
|
|
|
procedure TConsoleForm.ConnectModbus;
|
|
begin
|
|
// La porta la apre il thread del bus, che non fa aspettare la finestra:
|
|
// se la COM non c'e' il tentativo, e il suo timeout, avvengono la'.
|
|
FWorker := TModbusWorker.Create(FConfig.Port, FConfig.Baud,
|
|
FConfig.TimeoutMs, FConfig.PollMs);
|
|
FPlanDirty := True;
|
|
// Entrando in plancia la prima lettura delle bobine non serve solo a
|
|
// controllare: serve a mettere comandi e selettori nella posizione in cui
|
|
// sono i rele' veri, pulsanti compresi. Da li' in avanti i pulsanti non si
|
|
// rileggono piu', perche' il loro stato lo decide il mouse.
|
|
FAligning := True;
|
|
FAlignReported := False;
|
|
// Le divisioni imparate valgono per il modulo di prima: si riparte da capo.
|
|
SetLength(FCoilReqs, 0);
|
|
// Il timer ora non parla col bus: ritira quello che il thread ha letto.
|
|
// Piu' fitto del polling, cosi' le letture arrivano a video appena pronte.
|
|
tmrPoll.Interval := Max(50, FConfig.PollMs div 4);
|
|
tmrPoll.Enabled := True;
|
|
SetStatus('Apertura porta, lettura dei canali uno per uno...', True);
|
|
end;
|
|
|
|
procedure TConsoleForm.DisconnectModbus;
|
|
begin
|
|
tmrPoll.Enabled := False;
|
|
if FWorker <> nil then
|
|
begin
|
|
// Stop sveglia il thread; l'attesa dura al massimo la richiesta in corso.
|
|
FWorker.Stop;
|
|
FreeAndNil(FWorker);
|
|
end;
|
|
end;
|
|
|
|
function TConsoleForm.BusReady: Boolean;
|
|
begin
|
|
Result := (FWorker <> nil) and FWorker.IsBusConnected;
|
|
if not Result then
|
|
SetStatus('Comando ignorato: non connesso.', False);
|
|
end;
|
|
|
|
/// Chiave di una bobina nel registro delle scritture appena fatte.
|
|
function CoilKey(ASlave, AChannel: Integer): Int64;
|
|
begin
|
|
Result := Int64(ASlave) * 1000000 + AChannel;
|
|
end;
|
|
|
|
procedure TConsoleForm.NoteCoilWrite(ASlave, AChannel: Integer);
|
|
begin
|
|
// Si segna quando: una risposta partita prima di questo momento parla di
|
|
// una bobina che nel frattempo e' stata comandata, e non va creduta.
|
|
FCoilWrites.AddOrSetValue(CoilKey(ASlave, AChannel), GetTickCount64);
|
|
end;
|
|
|
|
function TConsoleForm.ReadingStale(ASlave, AChannel: Integer;
|
|
ASent: UInt64): Boolean;
|
|
var
|
|
Scritto: UInt64;
|
|
begin
|
|
Result := FCoilWrites.TryGetValue(CoilKey(ASlave, AChannel), Scritto) and
|
|
(Scritto >= ASent);
|
|
end;
|
|
|
|
procedure TConsoleForm.MirrorCoil(ASlave, AChannel: Integer; AOn: Boolean;
|
|
AExcept: TPlanciaElement);
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
// Sulla stessa bobina possono stare piu' comandi: lo stesso rele' comandato
|
|
// da due punti della plancia, o un pulsante e un interruttore. Premendone
|
|
// uno gli altri si muovono subito, senza aspettare la rilettura: mezzo
|
|
// secondo di disaccordo fra due comandi che sono la stessa cosa si vede.
|
|
// Le spie no: leggono gli ingressi, che sono un altro spazio di indirizzi.
|
|
for E in FElements do
|
|
begin
|
|
if (E = AExcept) or (E.Def.Slave <> ASlave) then
|
|
Continue;
|
|
case E.Def.Kind of
|
|
ekButton, ekSwitch:
|
|
if E.Def.Channel = AChannel then
|
|
E.SyncState(AOn);
|
|
ekRotary:
|
|
if E.Def.CoilCount > 1 then
|
|
begin
|
|
// Tre posizioni: la bobina dice da che lato, l'altra resta com'e'.
|
|
if E.Def.Channel = AChannel then
|
|
begin
|
|
if AOn then
|
|
E.SyncRotary(-1)
|
|
else if E.Rotary < 0 then
|
|
E.SyncRotary(0);
|
|
end
|
|
else if E.Def.RightChannel = AChannel then
|
|
begin
|
|
if AOn then
|
|
E.SyncRotary(1)
|
|
else if E.Rotary > 0 then
|
|
E.SyncRotary(0);
|
|
end;
|
|
end
|
|
else if E.Def.Channel = AChannel then
|
|
E.SyncRotary(Ord(AOn));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.ElementCommand(ASender: TPlanciaElement; AOn: Boolean;
|
|
var AAccepted: Boolean);
|
|
begin
|
|
if not ASender.Def.Configured then
|
|
begin
|
|
AAccepted := False;
|
|
SetStatusFor(Format('%s: nessun canale configurato, non comanda niente.',
|
|
[ASender.Def.Caption]), False, STATUS_HOLD_MS);
|
|
Exit;
|
|
end;
|
|
if not BusReady then
|
|
begin
|
|
AAccepted := False;
|
|
Exit;
|
|
end;
|
|
|
|
// Il comando va in coda e il click torna subito. L'elemento si accende
|
|
// fidandosi: se la scrittura non andra' a segno lo dira' la barra di stato,
|
|
// e la rilettura delle bobine lo rimettera' a posto entro un ciclo.
|
|
FWorker.EnqueueWrite(ASender.Def.Slave, ASender.Def.Channel, AOn,
|
|
ASender.Def.Caption);
|
|
NoteCoilWrite(ASender.Def.Slave, ASender.Def.Channel);
|
|
MirrorCoil(ASender.Def.Slave, ASender.Def.Channel, AOn, ASender);
|
|
AAccepted := True;
|
|
SetStatusFor(Format('%s -> %s', [ASender.Def.Caption, BoolToStr(AOn, True)]),
|
|
True, STATUS_HOLD_MS);
|
|
end;
|
|
|
|
procedure TConsoleForm.ElementRotary(ASender: TPlanciaElement; APos: Integer;
|
|
var AAccepted: Boolean);
|
|
var
|
|
D: TElementDef;
|
|
begin
|
|
if not ASender.Def.Configured then
|
|
begin
|
|
AAccepted := False;
|
|
SetStatusFor(Format('%s: nessun canale configurato, non comanda niente.',
|
|
[ASender.Def.Caption]), False, STATUS_HOLD_MS);
|
|
Exit;
|
|
end;
|
|
if not BusReady then
|
|
begin
|
|
AAccepted := False;
|
|
Exit;
|
|
end;
|
|
|
|
D := ASender.Def;
|
|
if D.CoilCount > 1 then
|
|
begin
|
|
// Tre posizioni, due bobine: la prima e' il lato sinistro, la seconda il
|
|
// destro; al centro sono entrambe aperte. Non devono mai essere chiuse
|
|
// insieme, quindi si apre SEMPRE prima quella del lato opposto e solo
|
|
// dopo si chiude l'altra. La coda mantiene l'ordine, quindi sul filo le
|
|
// due scritture partono in questa sequenza.
|
|
if APos < 0 then
|
|
begin
|
|
FWorker.EnqueueWrite(D.Slave, D.RightChannel, False, D.Caption);
|
|
FWorker.EnqueueWrite(D.Slave, D.Channel, True, D.Caption);
|
|
end
|
|
else
|
|
begin
|
|
FWorker.EnqueueWrite(D.Slave, D.Channel, False, D.Caption);
|
|
FWorker.EnqueueWrite(D.Slave, D.RightChannel, APos > 0, D.Caption);
|
|
end;
|
|
NoteCoilWrite(D.Slave, D.Channel);
|
|
NoteCoilWrite(D.Slave, D.RightChannel);
|
|
MirrorCoil(D.Slave, D.Channel, APos < 0, ASender);
|
|
MirrorCoil(D.Slave, D.RightChannel, APos > 0, ASender);
|
|
end
|
|
else
|
|
begin
|
|
FWorker.EnqueueWrite(D.Slave, D.Channel, APos > 0, D.Caption);
|
|
NoteCoilWrite(D.Slave, D.Channel);
|
|
MirrorCoil(D.Slave, D.Channel, APos > 0, ASender);
|
|
end;
|
|
AAccepted := True;
|
|
SetStatusFor(Format('%s -> posizione %d', [D.Caption, APos]), True,
|
|
STATUS_HOLD_MS);
|
|
end;
|
|
|
|
{ polling }
|
|
|
|
procedure TConsoleForm.AddToPlan(APlan: TList<TPollGroup>;
|
|
ASlave, AChannel: Integer);
|
|
var
|
|
I: Integer;
|
|
G: TPollGroup;
|
|
begin
|
|
for I := 0 to APlan.Count - 1 do
|
|
begin
|
|
G := APlan[I];
|
|
if G.Slave <> ASlave then
|
|
Continue;
|
|
if AChannel < G.First then
|
|
begin
|
|
G.Count := G.Count + (G.First - AChannel);
|
|
G.First := AChannel;
|
|
end
|
|
else if AChannel >= G.First + G.Count then
|
|
G.Count := AChannel - G.First + 1;
|
|
APlan[I] := G;
|
|
Exit;
|
|
end;
|
|
|
|
G.Slave := ASlave;
|
|
G.First := AChannel;
|
|
G.Count := 1;
|
|
APlan.Add(G);
|
|
end;
|
|
|
|
procedure TConsoleForm.BuildPollPlan;
|
|
var
|
|
D: TElementDef;
|
|
G: TPollGroup;
|
|
Plan: TArray<TPollRequest>;
|
|
I: Integer;
|
|
|
|
procedure Add(AKind: TRequestKind; const AGroup: TPollGroup; AMax: Integer);
|
|
var
|
|
Req: TPollRequest;
|
|
begin
|
|
if AGroup.Count > AMax then
|
|
begin
|
|
// Un solo elemento con un canale altissimo allargherebbe la richiesta
|
|
// oltre quello che una trama Modbus puo' portare.
|
|
SetStatusFor(Format('Slave %d: intervallo troppo ampio (%d canali), ' +
|
|
'richiesta saltata.', [AGroup.Slave, AGroup.Count]), False,
|
|
STATUS_HOLD_MS);
|
|
Exit;
|
|
end;
|
|
Req.Kind := AKind;
|
|
Req.Slave := AGroup.Slave;
|
|
Req.First := AGroup.First;
|
|
Req.Count := AGroup.Count;
|
|
Plan := Plan + [Req];
|
|
end;
|
|
|
|
/// Un canale di bobina da leggere da solo, senza doppioni: due comandi
|
|
/// sulla stessa bobina si leggono una volta.
|
|
procedure AddCoilChannel(ASlave, AChannel: Integer);
|
|
var
|
|
I: Integer;
|
|
C: TCoilChannel;
|
|
begin
|
|
for I := 0 to High(FCoilChannels) do
|
|
if (FCoilChannels[I].Slave = ASlave) and
|
|
(FCoilChannels[I].Channel = AChannel) then
|
|
Exit;
|
|
C.Slave := ASlave;
|
|
C.Channel := AChannel;
|
|
FCoilChannels := FCoilChannels + [C];
|
|
end;
|
|
|
|
begin
|
|
FLampPlan.Clear;
|
|
FGaugePlan.Clear;
|
|
FSwitchPlan.Clear;
|
|
SetLength(FCoilChannels, 0);
|
|
for D in FConfig.Elements do
|
|
begin
|
|
// Un elemento senza modulo non entra nel piano: non si legge e non si
|
|
// comanda, sta sulla plancia come disegno finche' non gli si da' un
|
|
// canale.
|
|
if not D.Configured then
|
|
Continue;
|
|
case D.Kind of
|
|
ekLamp: AddToPlan(FLampPlan, D.Slave, D.Channel);
|
|
ekGauge, ekDisplay: AddToPlan(FGaugePlan, D.Slave, D.Channel);
|
|
// Anche i pulsanti: il loro canale serve nella prima lettura, per
|
|
// mettere la plancia nella posizione in cui sono le bobine vere.
|
|
// Contigui agli altri non allargano nemmeno la richiesta.
|
|
ekSwitch, ekButton:
|
|
begin
|
|
AddToPlan(FSwitchPlan, D.Slave, D.Channel);
|
|
AddCoilChannel(D.Slave, D.Channel);
|
|
end;
|
|
ekRotary:
|
|
begin
|
|
AddToPlan(FSwitchPlan, D.Slave, D.Channel);
|
|
AddCoilChannel(D.Slave, D.Channel);
|
|
if D.CoilCount > 1 then
|
|
begin
|
|
AddToPlan(FSwitchPlan, D.Slave, D.RightChannel);
|
|
AddCoilChannel(D.Slave, D.RightChannel);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Il piano passa al thread del bus, che dal giro dopo legge questo.
|
|
SetLength(Plan, 0);
|
|
for G in FLampPlan do
|
|
Add(rqInputs, G, MAX_BITS_PER_READ);
|
|
for G in FGaugePlan do
|
|
Add(rqRegisters, G, MAX_REGISTERS_PER_READ);
|
|
|
|
if FAligning then
|
|
// All'ingresso in plancia le bobine si leggono UNA PER UNA. Un blocco che
|
|
// arriva oltre l'ultimo canale del modulo fallisce tutto, e con lui
|
|
// fallirebbe l'allineamento di tutti i comandi, compresi quelli su canali
|
|
// che esistono: cosi' invece fallisce solo la richiesta del canale che non
|
|
// c'e'. Costa un giro piu' lento, ma si fa una volta sola.
|
|
for I := 0 to High(FCoilChannels) do
|
|
begin
|
|
G.Slave := FCoilChannels[I].Slave;
|
|
G.First := FCoilChannels[I].Channel;
|
|
G.Count := 1;
|
|
Add(rqCoils, G, MAX_BITS_PER_READ);
|
|
end
|
|
else
|
|
begin
|
|
// A regime le bobine si leggono raggruppate, una richiesta per slave.
|
|
// Se una richiesta fallisce viene spezzata a meta' (vedi SplitCoilRequest)
|
|
// e qui si usa la divisione gia' imparata: un modulo da 32 canali
|
|
// interrogato fino al 38 continua cosi' a dare i suoi primi 32, invece di
|
|
// far fallire tutto il blocco.
|
|
if Length(FCoilReqs) = 0 then
|
|
for G in FSwitchPlan do
|
|
Add(rqCoils, G, MAX_BITS_PER_READ)
|
|
else
|
|
for I := 0 to High(FCoilReqs) do
|
|
Plan := Plan + [FCoilReqs[I]];
|
|
end;
|
|
// Le richieste delle bobine si ricordano: e' su quelle che si impara come
|
|
// il modulo risponde.
|
|
if not FAligning then
|
|
begin
|
|
SetLength(FCoilReqs, 0);
|
|
for I := 0 to High(Plan) do
|
|
if Plan[I].Kind = rqCoils then
|
|
FCoilReqs := FCoilReqs + [Plan[I]];
|
|
end;
|
|
|
|
if FWorker <> nil then
|
|
FWorker.SetPlan(Plan);
|
|
|
|
FPlanDirty := False;
|
|
end;
|
|
|
|
procedure TConsoleForm.SplitCoilRequest(const ARequest: TPollRequest);
|
|
var
|
|
I, Meta: Integer;
|
|
A, B: TPollRequest;
|
|
begin
|
|
// Una richiesta di un canale solo non si puo' dividere: quel canale non c'e'
|
|
// o non risponde, e va lasciato fallire da solo.
|
|
if (ARequest.Count < 2) or FAligning then
|
|
Exit;
|
|
for I := 0 to High(FCoilReqs) do
|
|
if (FCoilReqs[I].Kind = rqCoils) and
|
|
(FCoilReqs[I].Slave = ARequest.Slave) and
|
|
(FCoilReqs[I].First = ARequest.First) and
|
|
(FCoilReqs[I].Count = ARequest.Count) then
|
|
begin
|
|
Meta := ARequest.Count div 2;
|
|
A := ARequest;
|
|
A.Count := Meta;
|
|
B := ARequest;
|
|
B.First := ARequest.First + Meta;
|
|
B.Count := ARequest.Count - Meta;
|
|
FCoilReqs[I] := A;
|
|
FCoilReqs := FCoilReqs + [B];
|
|
FPlanDirty := True;
|
|
SetStatusFor(Format('Slave %d: la lettura delle bobine %d-%d non ' +
|
|
'riesce, la divido in %d-%d e %d-%d.',
|
|
[ARequest.Slave, ARequest.First, ARequest.First + ARequest.Count - 1,
|
|
A.First, A.First + A.Count - 1, B.First, B.First + B.Count - 1]),
|
|
False, STATUS_HOLD_MS);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.InvalidateReadings;
|
|
var
|
|
E: TPlanciaElement;
|
|
begin
|
|
for E in FElements do
|
|
if E.Def.Kind in [ekLamp, ekGauge, ekDisplay] then
|
|
E.SetInvalid;
|
|
end;
|
|
|
|
procedure TConsoleForm.NotePollError(const AWhat, AError: string);
|
|
begin
|
|
// Il primo errore del ciclo e' quello che si mostra, con il conto di quanti
|
|
// altri ce n'erano: la barra di stato ha una riga, e una plancia con tre
|
|
// moduli assenti non deve farla lampeggiare fra tre messaggi diversi.
|
|
Inc(FPollErrors);
|
|
if FPollError = '' then
|
|
FPollError := Format('%s: %s', [AWhat, AError]);
|
|
end;
|
|
|
|
procedure TConsoleForm.InvalidateGroup(AKinds: TElementKinds;
|
|
const AGroup: TPollGroup);
|
|
var
|
|
E: TPlanciaElement;
|
|
Idx: Integer;
|
|
begin
|
|
// Solo gli elementi che quella richiesta doveva leggere: gli altri stanno
|
|
// su moduli che rispondono, e non c'e' motivo di spegnerli.
|
|
for E in FElements do
|
|
if (E.Def.Kind in AKinds) and (E.Def.Slave = AGroup.Slave) then
|
|
begin
|
|
Idx := E.Def.Channel - AGroup.First;
|
|
if (Idx >= 0) and (Idx < AGroup.Count) then
|
|
E.SetInvalid;
|
|
end;
|
|
end;
|
|
|
|
/// Come si chiama sul bus quello che una richiesta va a leggere: serve nei
|
|
/// messaggi, perche' "lettura fallita" senza dire cosa non aiuta nessuno.
|
|
function RequestName(const ARequest: TPollRequest): string;
|
|
const
|
|
NAMES: array[TRequestKind] of string =
|
|
('bobine %d-%d (FC01)', 'ingressi %d-%d (FC02)', 'registri %d-%d (FC03)');
|
|
begin
|
|
Result := Format('slave %d, ' + NAMES[ARequest.Kind],
|
|
[ARequest.Slave, ARequest.First, ARequest.First + ARequest.Count - 1]);
|
|
end;
|
|
|
|
procedure TConsoleForm.ApplyReading(const AReading: TPollReading);
|
|
var
|
|
E: TPlanciaElement;
|
|
G: TPollGroup;
|
|
Idx, Idx2: Integer;
|
|
WasOn: Boolean;
|
|
begin
|
|
G.Slave := AReading.Request.Slave;
|
|
G.First := AReading.Request.First;
|
|
G.Count := AReading.Request.Count;
|
|
|
|
if not AReading.Ok then
|
|
begin
|
|
NotePollError(RequestName(AReading.Request), AReading.Error);
|
|
// Un blocco di bobine che non risponde viene spezzato: forse una parte
|
|
// dei canali esiste e va letta lo stesso.
|
|
if AReading.Request.Kind = rqCoils then
|
|
SplitCoilRequest(AReading.Request);
|
|
// Gli strumenti passano a "dato non disponibile": un numero vecchio
|
|
// spacciato per buono e' peggio di nessun numero.
|
|
//
|
|
// Le spie no: tengono l'ultimo stato letto. Spegnerle a ogni lettura
|
|
// fallita faceva sparire un allarme che c'e' ancora, e al ritorno della
|
|
// lettura buona il fronte di salita faceva ripartire il cicalino: la spia
|
|
// lampeggiava e il suono andava a singhiozzo. Che la lettura non sia
|
|
// riuscita lo dice la barra di stato.
|
|
if AReading.Request.Kind = rqRegisters then
|
|
InvalidateGroup([ekGauge, ekDisplay], G);
|
|
Exit;
|
|
end;
|
|
|
|
for E in FElements do
|
|
begin
|
|
if E.Def.Slave <> G.Slave then
|
|
Continue;
|
|
Idx := E.Def.Channel - G.First;
|
|
case AReading.Request.Kind of
|
|
rqInputs:
|
|
if (E.Def.Kind = ekLamp) and (Idx >= 0) and
|
|
(Idx < Length(AReading.Bits)) then
|
|
begin
|
|
// L'allarme suona sul fronte: quando la spia passa da spenta ad
|
|
// accesa, non a ogni ciclo mentre resta accesa.
|
|
WasOn := E.State;
|
|
E.SyncState(AReading.Bits[Idx]);
|
|
if E.State and not WasOn then
|
|
TriggerAlarm(E)
|
|
else if WasOn and not E.State then
|
|
begin
|
|
// Allarme rientrato: il suono si ferma subito, senza aspettare
|
|
// la fine del file, e il silenzio non serve piu': la prossima
|
|
// volta si ricomincia da un minuto.
|
|
StopAlarm(E);
|
|
E.ClearAlarmMute;
|
|
end;
|
|
end;
|
|
rqRegisters:
|
|
if ElementIsAnalog(E.Def.Kind) and (Idx >= 0) and
|
|
(Idx < Length(AReading.Regs)) then
|
|
E.SetAnalogValue(E.Def.RawToEng(AReading.Regs[Idx]));
|
|
rqCoils:
|
|
begin
|
|
if (Idx < 0) or (Idx >= Length(AReading.Bits)) then
|
|
Continue;
|
|
// Risposta piu' vecchia del comando appena dato: parla di com'era
|
|
// la bobina prima, e crederle farebbe tornare indietro il comando
|
|
// per un giro, con il lampeggio che si vede premendo.
|
|
if ReadingStale(E.Def.Slave, E.Def.Channel, AReading.Sent) or
|
|
((E.Def.Kind = ekRotary) and (E.Def.CoilCount > 1) and
|
|
ReadingStale(E.Def.Slave, E.Def.RightChannel, AReading.Sent)) then
|
|
Continue;
|
|
case E.Def.Kind of
|
|
ekSwitch:
|
|
E.SyncState(AReading.Bits[Idx]);
|
|
ekButton:
|
|
// Solo all'ingresso in plancia: un pulsante momentaneo con la
|
|
// bobina chiusa va mostrato chiuso, ma dopo il suo stato
|
|
// dipende dal mouse e rileggerlo lo farebbe lampeggiare.
|
|
if FAligning then
|
|
E.SyncState(AReading.Bits[Idx]);
|
|
ekRotary:
|
|
if E.Def.CoilCount > 1 then
|
|
begin
|
|
// Serve anche la bobina di destra, che non e' detto sia
|
|
// quella subito dopo: puo' essere indicata a parte.
|
|
Idx2 := E.Def.RightChannel - G.First;
|
|
if (Idx2 < 0) or (Idx2 >= Length(AReading.Bits)) then
|
|
Continue;
|
|
if AReading.Bits[Idx] then
|
|
E.SyncRotary(-1)
|
|
else if AReading.Bits[Idx2] then
|
|
E.SyncRotary(1)
|
|
else
|
|
E.SyncRotary(0);
|
|
end
|
|
else
|
|
E.SyncRotary(Ord(AReading.Bits[Idx]));
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TConsoleForm.FinishAligning(const AReadings: TArray<TPollReading>);
|
|
var
|
|
R: TPollReading;
|
|
E: TPlanciaElement;
|
|
Letto: Boolean;
|
|
Chiusi, Muti: Integer;
|
|
begin
|
|
if not FAligning then
|
|
Exit;
|
|
// L'allineamento vale solo se le bobine si sono davvero lette: se il modulo
|
|
// non ha risposto si riprova al giro dopo, invece di dare per aperto
|
|
// quello che non si sa.
|
|
Letto := False;
|
|
Muti := 0;
|
|
for R in AReadings do
|
|
if R.Request.Kind = rqCoils then
|
|
if R.Ok then
|
|
Letto := True
|
|
else
|
|
Inc(Muti);
|
|
if not Letto then
|
|
Exit;
|
|
|
|
FAligning := False;
|
|
// Letti i canali uno per uno, si torna alle richieste raggruppate: una sola
|
|
// richiesta per slave, che e' quello che tiene leggero il polling.
|
|
FPlanDirty := True;
|
|
if FAlignReported then
|
|
Exit;
|
|
FAlignReported := True;
|
|
|
|
Chiusi := 0;
|
|
for E in FElements do
|
|
case E.Def.Kind of
|
|
ekButton, ekSwitch:
|
|
if E.State then
|
|
Inc(Chiusi);
|
|
ekRotary:
|
|
if E.Rotary <> 0 then
|
|
Inc(Chiusi);
|
|
end;
|
|
if Muti > 0 then
|
|
// I canali che il modulo non ha (o che non risponde) vanno detti: sono
|
|
// comandi che a video restano aperti senza che nessuno lo sappia.
|
|
SetStatusFor(Format('Allineato ai rele'': %d comandi chiusi, %d canali ' +
|
|
'senza risposta su %d letti.',
|
|
[Chiusi, Muti, Length(FCoilChannels)]), False, STATUS_HOLD_MS)
|
|
else if Chiusi = 0 then
|
|
SetStatusFor(Format('Allineato ai rele'': %d canali letti, tutti i ' +
|
|
'comandi aperti.', [Length(FCoilChannels)]), True, STATUS_HOLD_MS)
|
|
else if Chiusi = 1 then
|
|
SetStatusFor(Format('Allineato ai rele'': %d canali letti, 1 comando ' +
|
|
'risulta chiuso.', [Length(FCoilChannels)]), True, STATUS_HOLD_MS)
|
|
else
|
|
SetStatusFor(Format('Allineato ai rele'': %d canali letti, %d comandi ' +
|
|
'risultano chiusi.', [Length(FCoilChannels), Chiusi]), True,
|
|
STATUS_HOLD_MS);
|
|
end;
|
|
|
|
procedure TConsoleForm.tmrPollTimer(Sender: TObject);
|
|
var
|
|
Readings: TArray<TPollReading>;
|
|
Outcomes: TArray<TWriteOutcome>;
|
|
R: TPollReading;
|
|
O: TWriteOutcome;
|
|
Msg: string;
|
|
Ok: Boolean;
|
|
begin
|
|
// Questo timer non parla col bus: ritira quello che il thread ha letto e
|
|
// scritto. Qualunque timeout e' costato tempo al thread, non a questa
|
|
// finestra.
|
|
if FWorker = nil then
|
|
Exit;
|
|
if FPlanDirty then
|
|
BuildPollPlan;
|
|
|
|
// Esiti dei comandi: una scrittura fallita e' l'unico modo di sapere che un
|
|
// rele' non ha sentito, e resta a video qualche secondo.
|
|
Outcomes := FWorker.TakeOutcomes;
|
|
for O in Outcomes do
|
|
if not O.Ok then
|
|
SetStatusFor(Format('Errore su %s: %s', [O.Caption, O.Error]), False,
|
|
STATUS_HOLD_MS);
|
|
|
|
if not FWorker.IsBusConnected then
|
|
begin
|
|
// Porta chiusa o caduta: niente piu' letture valide a video.
|
|
InvalidateReadings;
|
|
FWorker.CurrentStatus(Msg, Ok);
|
|
SetStatusFor(Msg, Ok, 0);
|
|
Exit;
|
|
end;
|
|
|
|
// Silenzi scaduti e conto di quelli in corso: va fatto a ogni giro, non
|
|
// solo quando arrivano letture nuove.
|
|
UpdateMutedAlarms;
|
|
|
|
if not FWorker.TakeReadings(Readings) then
|
|
Exit;
|
|
|
|
FPollError := '';
|
|
FPollErrors := 0;
|
|
for R in Readings do
|
|
ApplyReading(R);
|
|
FinishAligning(Readings);
|
|
|
|
// Un messaggio appena mostrato resta il tempo di leggerlo.
|
|
if GetTickCount64 < FStatusUntil then
|
|
Exit;
|
|
if FPollError = '' then
|
|
SetStatus('Connesso.', True)
|
|
else if FPollErrors > 1 then
|
|
SetStatus(Format('Lettura fallita su %d richieste, la prima: %s',
|
|
[FPollErrors, FPollError]), False)
|
|
else
|
|
SetStatus('Lettura fallita: ' + FPollError, False);
|
|
end;
|
|
|
|
end.
|