commit 4a01a2ec88064926614fa0bc55077e9f156f5894 Author: Fabrizio Bitti Date: Tue Sep 22 16:56:34 2026 +0200 Plancia configurabile su Modbus RTU 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 diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..50e1776 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,11 @@ +# Progetto Delphi per Windows: i sorgenti stanno a CRLF. +* text=auto eol=crlf + +*.png binary +*.jpg binary +*.bmp binary +*.ico binary +*.wav binary +*.mp3 binary +*.res binary +*.exe binary diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f09bbeb --- /dev/null +++ b/.gitignore @@ -0,0 +1,26 @@ +# Compilati e roba dell'IDE: si rifanno dal sorgente, non vanno versionati. +*.exe +*.dcu +*.dsk +*.local +*.identcache +*.tvsconfig +__history/ +__recovery/ +Win32/ +Win64/ +*.~* + +# Copie di sicurezza e file di appoggio +*.bak +*.tmp + +# Stato del programma, non configurazione: dice solo quale plancia era aperta +# l'ultima volta su questa macchina. +plancia-ultima.txt + +# Impostazioni locali dell'ambiente, personali di questa macchina. +.claude/settings.local.json + +# Audio troppo pesante per stare in git: resta solo sul disco. +Console/suoni/u_md6l89el2t-alarm-520411.mp3 diff --git a/Console/LEGGIMI.md b/Console/LEGGIMI.md new file mode 100644 index 0000000..36e8ec0 --- /dev/null +++ b/Console/LEGGIMI.md @@ -0,0 +1,740 @@ +# PlanciaConsole + +Plancia configurabile su Modbus RTU / RS485. Due modalità, decise dalla riga di +comando; la configurazione vive in un file XML letto all'avvio. + +Riusa `..\uModbusRTU.pas` e `..\uGauge.pas` del programma di test +(`ProjectPlancia`): i due progetti condividono quei due file, non ne esistono +copie. Il bus gira in un thread a parte (`uModbusWorker.pas`), così la finestra +non si ferma mai; vedi "Il bus in un thread a parte". + +## Avvio + + PlanciaConsole.exe aboard, legge plancia.xml + PlanciaConsole.exe aboard + PlanciaConsole.exe config configurazione + PlanciaConsole.exe config -f rotta.xml configurazione su un altro file + PlanciaConsole.exe rotta.xml aboard su un altro file + +Senza indicazioni viene riaperta l'ultima plancia usata, e in mancanza di +quella `plancia.xml` accanto all'eseguibile. `-f `, +`-file=` o un parametro libero indicano un file diverso. + +### Modalità aboard + +Legge l'XML, apre la porta seriale indicata nel file, si connette da sola e +opera. A vista c'è solo la plancia più una barra di stato con porta, baud, LED +verde/rosso e ultimo messaggio. Nessun comando di configurazione. + +La finestra si dimensiona sulla plancia. Se il pannello è più grande dello +schermo lo zoom si riduce automaticamente per farcelo stare: a bordo è meglio +una plancia rimpicciolita che una da raggiungere scorrendo. + +### Cambiare plancia a bordo + +In fondo a destra, nella barra di stato, una casella elenca le plance della +stessa cartella del file caricato: tutti gli XML che sono configurazioni di +plancia, mostrati con il loro titolo. Scegliendone una: + +- la porta seriale viene chiusa e riaperta con porta e baud del nuovo file; +- la finestra si ridimensiona sul nuovo pannello; +- **le bobine non vengono toccate**: i relè restano come sono e la nuova plancia + ne rilegge lo stato al primo ciclo di polling. + +Il file viene letto per prova prima di lasciare quello in servizio: se è rotto +resta la plancia di prima e l'errore compare nella barra di stato. + +La casella compare solo in aboard e solo se nella cartella ci sono almeno due +plance. In configurazione si usa "Apri", che chiede anche delle modifiche non +salvate. Dopo la scelta il fuoco viene tolto alla casella, così le frecce della +tastiera non cambiano plancia per sbaglio. + +### Modalità configuration + +Palette a sinistra, pannello a destra con le proprietà dell'elemento +selezionato, barra in alto con Nuovo / Apri / Salva / Salva con nome, griglia e +zoom. + +- **Inserire**: trascina una voce della palette sul pannello. L'elemento nasce + centrato sul punto di rilascio; se lì c'è già qualcosa scala in diagonale + finché trova posto libero, così non si impilano tutti nello stesso punto. +- **Spostare**: trascina l'elemento. Un click senza trascinare non lo sposta: + il movimento parte solo oltre la soglia di trascinamento di Windows (pochi + pixel), e un asse su cui il mouse non si è mosso non viene riagganciato alla + griglia. +- **Ridimensionare**: trascina una delle otto maniglie dell'elemento + selezionato, oppure scrivi larghezza e altezza nel pannello proprietà. +- **Ritocchi da tastiera**, sull'elemento selezionato: **Ctrl+freccia** lo + sposta di un pixel, **Maiusc+freccia** cambia le misure di un pixel (destra + e giù ingrandiscono, sinistra e su rimpiccioliscono). Un pixel esatto anche + con la griglia attiva. Non funzionano mentre si scrive in una casella, dove + le frecce restano del testo: cliccare l'elemento riporta i tasti sul pannello. +- **Annulla / Ripeti**: pulsanti nella barra, oppure **Ctrl+Z** e **Ctrl+Y** + (o Ctrl+Maiusc+Z). Coprono spostamenti, misure, proprietà, tipo, elementi + aggiunti e cancellati e le impostazioni generali, fino a 100 passi. Le + modifiche in fila sulla stessa cosa, entro un secondo e mezzo l'una + dall'altra, contano come un passo solo: le cifre di una larghezza digitata, + o Ctrl+freccia tenuto premuto. Lo storico si azzera con Nuovo e Apri. + Un'immagine rimossa dalla libreria non torna con Annulla: tornano i + riferimenti degli elementi, ma il file va riaggiunto. +- **Griglia**: con "Griglia 10 px" attiva posizioni e bordi si agganciano a + multipli di 10. +- **Zoom**: da 50% a 200%. È solo una lente di lavoro: le coordinate salvate + nell'XML restano sempre quelle reali al 100%. +- **Configurare**: seleziona l'elemento e compila i campi. Le modifiche si + vedono subito. +- **Eliminare**: pulsante "Elimina elemento" o tasto Canc. +- **Chiusura**: chiudendo la finestra la plancia viene **salvata da sola** nel + file su cui si stava lavorando, senza chiedere niente. Solo se il + salvataggio non riesce (disco pieno, file di sola lettura) viene chiesto se + chiudere comunque. Nuovo, Apri e il passaggio in plancia invece continuano a + chiedere cosa fare delle modifiche: lì si può volerle buttare. + +**Come viene scritto il file.** Il salvataggio non scrive mai sopra il file +buono: scrive un `.tmp` accanto e poi scambia i nomi, tenendo la versione +precedente come `.bak`. Così un programma chiuso male, un disco pieno o due +copie del programma che salvano insieme non possono lasciare un XML troncato, +che alla riapertura non si leggerebbe più. Se un file non si apre, accanto c'è +il `.bak` della volta prima: si rinomina e si riparte da lì. + +**Se il file non si è aperto**, chiudendo non ci si salva sopra: il programma +avverte e propone "Salva con nome", perché salvare il pannello vuoto +cancellerebbe quello che il file contiene. + +All'avvio senza indicazioni viene riaperta **l'ultima plancia usata**: il +percorso è ricordato in `plancia-ultima.txt` accanto all'eseguibile, e si +aggiorna a ogni apertura, salvataggio e cambio di plancia a bordo. Se quel file +non c'è, o la plancia è stata spostata, si riparte da `plancia.xml`. Un file +indicato sulla riga di comando ha comunque la precedenza. + +In configurazione la porta seriale **non** viene aperta: si disegna la plancia +senza rischiare di comandare relè per sbaglio. Per provare i canali si usa il +programma di test `ProjectPlancia`. + +### Passare da una modalità all'altra + +Chi è partito con `config` trova in fondo a destra, nella barra di stato, un +pulsante **"Vai in plancia"**: la palette e le proprietà spariscono, la finestra +si veste sulla plancia e la porta seriale si apre. Da lì il pulsante diventa +**"Torna a configurare"** e riporta indietro, chiudendo la porta. + +Serve a provare quello che si è appena disegnato senza chiudere e riaprire il +programma con un'altra riga di comando. + +Tre cose da sapere: + +- Se ci sono modifiche non salvate viene chiesto cosa farne **prima** di passare + in plancia, altrimenti si perderebbero in silenzio. +- Tornando a configurare la porta seriale viene **chiusa**, e le spie tornano a + "dato non disponibile": una plancia che non sta leggendo non deve sembrare in + servizio. +- Posizione della finestra e zoom di lavoro vengono ritrovati come li si era + lasciati, perché in plancia la finestra si ridimensiona sul pannello. + +**Chi è partito in `aboard` non vede il pulsante.** Una plancia avviata in +servizio non deve offrire la strada per essere modificata per sbaglio; per +configurarla si riavvia con `config`. + +### Modalità notturna + +Accanto c'è il pulsante **"Notte"**, questo disponibile in entrambe le modalità. +Scurisce l'intera plancia: fondo quasi nero, immagine di sfondo ricalcolata +scura, e ogni colore abbassato alla stessa frazione, così i rapporti fra i +colori restano quelli del giorno e il quadro resta leggibile. Serve in +navigazione notturna, dove un pannello chiaro a tutto schermo brucia +l'adattamento al buio e per qualche minuto non si vede più fuori. + +Le scritte non vengono abbassate ma **sostituite con un ambra**: una serigrafia +nera abbassata resterebbe nera, cioè invisibile sul fondo scuro. L'ambra è anche +il colore che disturba meno la visione notturna. Vale per etichette, legende dei +selettori, marchi e scale dei gauge. + +Si torna al giorno con lo stesso pulsante, che nel frattempo dice "Giorno". La +scelta **non** viene salvata nell'XML: è una condizione del momento, non una +proprietà della plancia. + +## Tipi di elemento + +| Tipo | Funzione Modbus | Comportamento | +|---|---|---| +| Pulsante | `WriteSingleCoil` (05) | Chiude alla pressione, riapre al rilascio (es. horn) | +| Interruttore | `WriteSingleCoil` (05) + `ReadCoils` (01) | Commuta alla pressione del mouse e resta premuto | +| Selettore | `WriteSingleCoil` (05) + `ReadCoils` (01) | Manopola rotativa a 2 o 3 posizioni, anche a ritorno di molla | +| Spia | `ReadDiscreteInputs` (02) | Sola lettura, LED di colore configurabile | +| Gauge | `ReadHoldingRegisters` (03) | Colonna con scala, soglie e valore | +| Display | `ReadHoldingRegisters` (03) | Numero a sette segmenti rossi su fondo nero | +| Immagine | nessuna | Grafica decorativa: loghi, sagome, cornici | +| Testo | nessuna | Scritta serigrafata sul pannello | + +Il campo `channel` è l'indirizzo Modbus della bobina o del registro, `slave` +l'indirizzo del nodo sul bus. Immagine e Testo non hanno né slave né canale. + +Gli interruttori e i selettori rileggono le bobine ad ogni ciclo: se un relè +cambia stato per altra via, o una scrittura non va a segno, il comando a video +si riallinea. I pulsanti momentanei non vengono riallineati, perché il loro +stato dipende dal mouse. + +### All'ingresso in plancia la plancia si allinea al campo + +Entrando in modalità plancia (all'avvio, tornando dalla configurazione o +cambiando plancia) la prima lettura serve a mettere tutto nella posizione in +cui è il campo, non solo a controllare: + +- **interruttori e selettori** dalle bobine (funzione 01); +- **pulsanti** dalle bobine, ma **solo in questa prima lettura**: se un canale + momentaneo è rimasto eccitato va mostrato chiuso, mentre dopo lo stato del + pulsante lo decide il mouse e rileggerlo lo farebbe lampeggiare; +- **spie** dagli ingressi digitali (funzione 02), come sempre. + +**In questa prima lettura le bobine si chiedono una per una**, non a blocco. Un +blocco che arriva oltre l'ultimo canale del modulo fallisce tutto, e con lui +fallirebbe l'allineamento anche dei comandi su canali che esistono: chiedendo un +canale per volta fallisce solo la richiesta del canale che non c'è. Costa un +giro più lento, una volta sola. Finito l'allineamento si torna alle richieste +raggruppate, che sono quelle che tengono leggero il polling. + +Chiudendo il programma non viene scritto niente sul bus: i relè restano come +sono, ed è la plancia che alla ripartenza si adatta a loro. Quando l'allineamento +è fatto la barra di stato dice quanti canali sono stati letti, quanti comandi +risultano chiusi e quanti canali non hanno risposto; se non risponde nessuna +bobina si riprova al ciclo dopo, invece di dare per aperto quello che non si sa. +Una spia già in allarme all'avvio fa suonare il suo cicalino. + +### Più comandi sulla stessa bobina + +Lo stesso `slave` e `channel` si possono mettere su più elementi: lo stesso relè +comandato da due punti della plancia, o un pulsante e un interruttore sullo +stesso circuito. Premendone uno **gli altri si muovono subito**, senza aspettare +la rilettura: mezzo secondo di disaccordo fra due comandi che sono la stessa cosa +si nota. Vale in tutte le combinazioni, compresi i selettori (per quelli a 3 +posizioni conta la bobina del lato). + +Le spie no: leggono gli ingressi digitali, che sono un altro spazio di +indirizzi, quindi una spia sullo stesso numero di canale di una bobina non è la +stessa cosa e non viene toccata. + +Una risposta **più vecchia del comando appena dato** viene scartata. Le letture +partono a giri regolari e la risposta può arrivare dopo un click: crederle +farebbe tornare indietro il comando per un giro, e si vedrebbe il comando +spegnersi, riaccendersi e rispegnersi. Ogni comando segna l'istante in cui ha +scritto la sua bobina, e le risposte partite prima di quel momento non vengono +applicate a quella bobina. + +**Attenzione**: questo riallineamento è anche il motivo per cui un interruttore +può *sembrare* un pulsante. Se la rilettura della bobina risponde 0 — relè +assente, indirizzo sbagliato, scrittura non andata a segno — l'interruttore +torna su da solo entro un ciclo di polling, e a occhio sembra che non resti +premuto. Il tipo dell'elemento non c'entra: si guarda la barra di stato. + +### Cambiare tipo dopo il disegno + +Pulsante, interruttore e spia si scambiano fra loro in qualsiasi momento, dalla +casella **Tipo** in cima al pannello proprietà, come si fa con la forma o il +canale. Condividono tutti i campi — canale, colori, forma, immagini, etichetta — +quindi il passaggio non perde niente. Cambia solo il funzionamento: il pulsante +chiude il contatto finché lo tieni premuto, l'interruttore commuta e resta, la +spia non si preme e si accende quando l'ingresso è chiuso. + +Serve soprattutto per le lenti colorate che sulla foto di un quadro sembrano +pulsanti ma sono allarmi, come FIRE ALARM e OIL STEERING di ZEBRA. + +**Attenzione al canale** passando da comando a spia o viceversa: il numero +resta lo stesso ma cambia significato. Per pulsanti e interruttori è una bobina +da comandare, per la spia un ingresso digitale da leggere (funzione 02), che di +solito sta su un altro modulo. La barra di stato lo ricorda al momento del +cambio. + +Cambiando tipo l'elemento riparte da spento, perché un pulsante non viene più +riletto dal campo e resterebbe illuminato per sempre. Se l'etichetta era +ancora quella predefinita segue il nuovo tipo, altrimenti resta la tua. + +### Selettore rotativo + +La leva **ruota**: passando da una posizione all'altra si vede girare, sempre +passando per l'alto, in 130 millisecondi con partenza e arrivo morbidi. È solo +quello che si vede: il comando sul bus parte subito, all'inizio del movimento. +In configurazione la leva sta ferma dove dice la definizione. + +Si "gira" premendo dal lato verso cui lo si vuole portare: pressione a sinistra +della manopola per scendere di una posizione, a destra per salire. La legenda +sopra la manopola è testo libero (`OFF ◄ 0 ► ON`, `STOP ◄ 0 ► START`, …). + +Il cablaggio dipende dal numero di posizioni: + +- **2 posizioni**: una bobina, quella di `channel`. Chiusa = posizione destra. +- **3 posizioni**: **due bobine**, `channel` e (salvo indicazione) `channel+1`. + La prima chiusa = posizione sinistra, la seconda chiusa = destra, entrambe + aperte = centro (0). + +Quindi un selettore a 3 posizioni **occupa due canali**: nel numerare i canali +va lasciato il buco. + +Per configurarlo: tipo Selettore, **Posizioni = 3**, e in **Canale** la bobina +del lato sinistro. La bobina di destra si imposta nel riquadro "Selettore", in +**Canale lato destro**: lasciandolo vuoto è il canale successivo (l'etichetta +ricorda quale sarebbe), e si compila solo quando sul modulo le due bobine non +sono contigue. Nell'XML è l'attributo `channel2`, scritto solo se indicato. + +Il suggerimento a comparsa dell'elemento mostra entrambe le bobine. + +#### Ritorno a molla + +Con **Ritorno a molla** spuntato (nell'XML `momentary="true"`) il selettore non +resta dove lo porti: tiene la posizione finché lo tieni premuto e torna al +centro appena lasci il mouse, aprendo entrambe le bobine. È il comando di +avviamento dei quadri veri, `STOP ◄ 0 ► START`: si tiene su START finché il +motore parte, e si molla. + +- Si preme direttamente dal lato voluto, senza passare per lo zero. +- Al rilascio torna al centro **sempre**, anche se il mouse è finito fuori + dall'elemento e anche se la scrittura di andata era fallita: un comando di + avviamento non deve mai restare eccitato. +- Finché è premuto il polling non lo sposta, altrimenti una lettura arrivata in + quell'istante lo farebbe scattare al centro sotto il dito. +- Vale anche a 2 posizioni: premuto = chiusa, lasciato = aperta. + +In `antago.xml` e in `plancia-mfd.xml` è così il selettore **GENERATOR**. + +Le due bobine **non vengono mai chiuse insieme**: a ogni cambio di posizione si +apre prima quella del lato opposto e solo dopo si chiude l'altra. Se la seconda +scrittura fallisce il selettore resta al centro, con tutte e due aperte. Questa +però è una protezione del programma: se i due lati comandano qualcosa che non +deve mai partire insieme (due sensi di marcia, due alimentazioni), serve +comunque l'interblocco elettrico fra i due relè. + +### Gauge a quadrante + +Con `style="dial"` il gauge non è una colonna ma uno strumento a lancetta, come +quelli dei display di plancia: scala su 270 gradi con tacche e numeri, lancetta, +e sotto il perno la lettura in cifre con le unità (`decimals` ne fissa i +decimali). Se l'elemento è più alto che largo il titolo va sotto al quadrante, +altrimenti dentro. + +La fascia della scala è grigia. Con `warnBelow` / `warnAbove` impostati diventa +verde nell'intervallo buono e rossa fuori: senza soglie resta grigia, perché un +quadrante tutto verde direbbe "tutto a posto" senza saperlo. Senza dato valido +la lancetta non c'è e la lettura mostra `---`. + +Stile e decimali del quadrante per ora si impostano solo nell'XML; il pannello +proprietà non li mostra ma il salvataggio li conserva. + +### Display + +Mostra il registro scalato in unità reali, allineato a destra sul numero di +cifre richiesto, con zeri davanti come i display veri. `digits` è il numero di +cifre, `decimals` quante dopo la virgola. Senza dato valido i segmenti restano +tutti spenti. + +### Spia + +Il colore da accesa si imposta con l'attributo `color` (`#RRGGBB`): rosso per +gli allarmi, verde per i consensi, giallo e arancio per i livelli. Se +l'etichetta è vuota il LED — o l'immagine PNG che lo sostituisce — occupa tutto +l'elemento, così si possono appoggiare spie piccole sopra una grafica. Vale per +qualunque elemento con l'etichetta fuori dal disegno: senza etichetta non viene +riservata nessuna fascia. + +#### Allarme sonoro + +Ogni spia può far suonare qualcosa quando si accende. Nel pannello proprietà, +riquadro **Allarme sonoro**: + +- **Suona quando si accende**: la casella che accende o spegne l'allarme. +- **File**: si sceglie fra i suoni presenti nella cartella **`suoni\` accanto + al file XML della plancia** (MP3 e WAV). Come per le immagini, i suoni + viaggiano con la plancia quando si copia la cartella. +- **Aggiorna**: rilegge la cartella. Serve quando si aggiunge un file mentre il + programma è già aperto, senza doverlo riavviare. + +Nell'XML sono gli attributi `alarm="true"` e `sound="cicalino.mp3"` sulla spia. +Il nome del file resta salvato anche con l'allarme spento, così si può +riaccendere senza riscegliere il suono. + +Come suona: + +- **Parte sul fronte**, quando la spia passa da spenta ad accesa, e poi **va in + ciclo**: finito il file ricomincia, e continua finché l'allarme c'è. Un + cicalino che suona una volta sola lo si perde se in quel momento si sta + guardando altrove. Si ferma quando l'allarme rientra, quando lo si zittisce + premendo la spia, o lasciando la plancia. +- **Se l'allarme è già attivo all'avvio** suona appena arriva la prima lettura: + una plancia che parte con una sentina piena deve dirlo. +- **Non blocca niente**: il suono va per conto suo, la plancia resta comandabile. +- Due allarmi diversi si sovrappongono; lo stesso allarme che si ripete riparte + da capo. +- **Quando l'allarme rientra il suono si ferma subito**, senza aspettare la + fine del file: serve per i suoni lunghi, una sirena che continua a suonare + su un allarme già passato è peggio del silenzio. Se lo stesso file è + assegnato a più spie, tace solo quando si è spenta l'ultima ancora accesa. +- **Se il file manca o non si può suonare**, la barra di stato lo dice: un + cicalino muto senza avviso è peggio di nessun cicalino. +- Uscendo dalla plancia (torna a configurare, chiusura) i suoni si fermano. + +#### Zittire un allarme + +**Si preme la spia che sta suonando**: è il gesto che viene naturale, si preme +quello che dà fastidio. Ogni pressione allunga il silenzio: + +| Pressioni | Silenzio | +|---|---| +| 1 | un minuto | +| 2 | dieci minuti | +| 3 | un'ora | +| 4 | allarme di nuovo attivo | + +Le pressioni contano finché il silenzio dura: dopo che è scaduto si ricomincia +da un minuto. Il suono in corso si ferma subito alla prima pressione. + +**Il silenzio non spegne la spia**: il LED resta acceso, con una sbarra sopra, +perché guardando il quadro si deve capire che quell'allarme c'è ancora e sta +suonando a vuoto. Premere una spia spenta, o una senza allarme, non fa niente. + +**Quando il silenzio scade, se la condizione è ancora presente l'allarme torna +a suonare**: è il senso di zittire "per un minuto" invece che per sempre. + +In basso a destra, nella barra di stato, compare il tasto **"N allarmi zittiti +(tempo) — riattiva"**, che dice quanti sono e quanto manca al primo che torna a +suonare. Premendolo si riattivano tutti subito, e quelli ancora presenti +suonano di nuovo. Il tasto si vede solo finché c'è almeno un allarme zittito. + +Se l'allarme rientra da solo, il silenzio si azzera con lui: la volta dopo si +riparte da un minuto. Tornando a configurare, o cambiando plancia, i silenzi si +azzerano tutti. + +In `suoni\` c'è `cicalino.wav`, due bip generati per provare subito; va +sostituito con il suono vero. + +La spia accetta anche la forma (`shape`) dei pulsanti, per somigliare alle +lenti di allarme dei quadri: + +- **`round`** — ghiera metallica e lente tonda. Spenta la lente resta del suo + colore ma scura (`colorOff`, o `color` scurito se manca), accesa prende + `color` pieno con un riflesso. La ghiera non cambia: è una spia, non un + comando premuto. +- **`screen`** — tasto a video che si riempie di `color` quando l'ingresso è + chiuso. +- le altre forme — il LED tondo di sempre. + +In ogni forma cliccare una spia non fa nulla e non manda niente sul bus. + +### Aspetto di pulsanti, interruttori e spie + +**La lente di un pulsante o di un interruttore non cambia mai colore.** Lo stato +si legge solo dal bordo, come su un quadro vero, dove il vetro è sempre dello +stesso colore e quello che cambia è la luce dietro. + +- Forma **tonda**: la ghiera attorno alla lente è grigia a riposo e diventa + **azzurra luminosa** quando il comando è acceso, o mentre un pulsante è tenuto + premuto — più chiara contro la lente e più carica all'orlo, come se la luce + venisse da dentro. +- Forma **squadrata o a pillola**: non c'è ghiera, quindi è il bordo stesso che + si ingrossa e prende lo stesso azzurro. + +Il colore della lente è **`colorOff`**. Su pulsanti e interruttori `color` non +tocca più il vetro: resta usato dalle spie, dove il cambio di colore è tutto +quello che c'è da vedere. Anche l'etichetta scritta *dentro* al comando resta +uguale: prima diventava bianca e in grassetto da acceso, ed era un secondo modo +di dire la stessa cosa che ora dice il bordo. + +Tre attributi permettono di far somigliare i comandi a quelli del quadro vero, +e si impostano anche dal riquadro "Aspetto" del pannello proprietà: + +- **`shape`** — `auto` (pillola per i pulsanti, squadrato per gli + interruttori), `round`, `rect`, `pill`, `screen`. I quadri di bordo hanno + quasi sempre pulsanti tondi: con `round` l'elemento viene disegnato con + ghiera metallica e lente, come un pulsante illuminato da incasso. + `screen` ("a video") è il tasto di un display multifunzione ed è l'eccezione + alla regola della lente: spento è un riquadro scuro con il filo chiaro + (`colorOff` per tingerlo), acceso **si riempie** del colore `color`. La + scritta sopra passa da chiara a nera quando il fondo diventa chiaro. +- **`captionPos`** — `center` (etichetta scritta sul comando), `below`, + `above`. Sui quadri veri l'etichetta è serigrafata **sotto** al pulsante: + con `below` il disegno si restringe per farle posto e il testo resta nero + sulla lamiera invece di stare sopra la lente. Le etichette lunghe vanno a + capo e la fascia si allarga da sola. +- **`color`** e **`colorOff`** — colore della lente accesa e a riposo. Serve + perché un pulsante STOP è rosso anche da spento e si limita a illuminarsi: + senza `colorOff` la lente a riposo è grigio-azzurra neutra. + +### Testo e marchi + +L'elemento Testo non serve solo alle scritte: con una cornice diventa un +marchio serigrafato, disegnato **con il font e non con un'immagine**, quindi +nitido a qualsiasi zoom invece di sgranare come farebbe un PNG ingrandito. + +- **`fontName`** — nome del font, per esempio `Times New Roman` o + `Arial Black`. Vuoto = quello del pannello. Funziona su qualsiasi elemento, + non solo sul Testo. +- **`spacing`** — pixel in più fra una lettera e l'altra. I marchi hanno quasi + sempre le lettere larghe e senza questo non somigliano. +- **`frame`** — `none`, `oval`, `rect`, `round` (rettangolo stondato, cioè a + pastiglia). Disegnata con GDI+ in antialiasing, altrimenti un ovale grande + verrebbe scalettato. +- **`frameWidth`** — spessore del tratto della cornice. +- **`color`** — colore di inchiostro e cornice. + +Un marchio su più righe si compone sovrapponendo più elementi: uno con la sola +cornice (etichetta vuota), uno con il nome in grande, uno con il sottotitolo +piccolo. È così che sono fatti i loghi ZEBRA e ANTAGO negli esempi. + +Per andare a capo dentro un'etichetta si usa ` `, per esempio +`caption="PORT ENGINE"`. + +## Immagini + +La libreria immagini è nel pannello di sinistra: "Aggiungi..." accetta PNG, JPG +e BMP (selezione multipla), "Rimuovi" toglie l'immagine e la sgancia dagli +elementi che la usavano, chiedendo conferma. + +Non è una `TImageList`: quella imporrebbe a tutte le immagini la stessa +dimensione, mentre qui un LED da 32 px e un logo da 600 px devono convivere. + +**Nell'XML si salvano nome e percorso, non i pixel.** I file restano sul disco e +si possono sostituire senza toccare la configurazione. I percorsi sono relativi +alla cartella del file XML quando possibile, così l'intera plancia si trasporta +copiando una cartella; "Salva con nome" in un'altra cartella ricalcola i +percorsi da solo. + +Dove si usano: + +- **Pulsante, interruttore, spia**: due immagini, a riposo e attiva. Se il campo + "immagine a riposo" è vuoto si torna al disegno vettoriale predefinito. Se è + valorizzata solo quella a riposo, l'elemento non cambia aspetto quando si + attiva. +- **Immagine**: una sola, decorativa. +- **Sfondo del pannello**: si sceglie in "Generale → Immagine di sfondo", ed è + stirata su tutto il pannello. + +Le PNG con trasparenza funzionano: gli elementi non riempiono il proprio sfondo, +quindi un logo con alpha si fonde con lo sfondo della plancia. + +L'etichetta continua a essere scritta sopra l'immagine, in bianco con contorno +nero perché resti leggibile su fondo chiaro e scuro; sulle spie va in basso per +non coprire il LED. Se l'immagine contiene già la scritta, basta svuotare il +campo Etichetta. + +Se un file manca o non si apre, nella libreria il nome compare seguito da `[!]` +e l'elemento mostra un riquadro tratteggiato in configurazione. + +## Il file XML + + + + + + + + + + + + + + + + + +`kind` vale `button`, `switch`, `rotary`, `lamp`, `gauge`, `display`, `image` +o `label`. + +- `fontSize`: altezza del testo in pixel logici; assente = font del pannello. +- `imageOff` / `imageOn`: nomi presi da ``; solo per pulsanti, + interruttori e spie. +- `image`: l'immagine dell'elemento decorativo. +- `background` su ``: immagine di sfondo. +- `ink` su ``: colore della serigrafia, `#RRGGBB`, nero se assente. + Vale per etichette sotto/sopra i comandi, legende e titoli di selettori, + display e quadranti, e per i `label` senza `color`. Le plance a fondo scuro + lo mettono chiaro. Si imposta solo nell'XML. +- `style` (`bar` o `dial`) e `decimals`: aspetto del `gauge`, vedi sopra. +- `color` / `colorOff`: colore acceso e a riposo di spie, pulsanti e + interruttori, `#RRGGBB`. Su `label` è il colore di inchiostro e cornice. +- `shape` e `captionPos`: forma del comando e posizione dell'etichetta. +- `fontName` e `spacing`: font e spaziatura fra le lettere. +- `frame` e `frameWidth`: cornice attorno a un `label`. +- `alarm` e `sound`: solo per `lamp`, allarme sonoro all'accensione; il file + sta nella cartella `suoni\` accanto all'XML. +- `positions` (2 o 3), `legend`, `channel2` e `momentary`: solo per `rotary`. + `channel2` è la bobina del lato destro di un selettore a 3 posizioni; + assente = `channel+1`. `momentary="true"` è il ritorno a molla. +- `digits` e `decimals`: solo per `display`. +- `raw*`, `eng*` e `units` valgono per `gauge` e `display`: + `rawMin`/`rawMax` sono il fondo scala del modulo (4095 = ADC a 12 bit), + `engMin`/`engMax` i valori reali corrispondenti. +- `warnBelow` / `warnAbove`: solo per `gauge`, sono le soglie oltre le quali la + colonna diventa rossa (`-1E30` e `1E30` significano "soglia non impostata"). + +I numeri decimali si scrivono con il punto. Il file si può modificare a mano: +un attributo mancante prende il valore di default. Per i caratteri speciali +nelle legende si usano le entità XML, per esempio `◀` e `▶` per le +frecce ◄ ►. + +## File di esempio + +- `esempio-plancia.xml` — solo elementi vettoriali, nessuna immagine. +- `esempio-immagini.xml` — usa la cartella `immagini\`: sfondo, logo con + trasparenza, pulsante e LED con grafica. Le immagini sono segnaposto generate + per la prova, da sostituire con quelle vere. +- `antago.xml` — riproduzione del quadro elettrico ANTAGO, ricavata dalla foto + del quadro reale. Il pannello è 1270×950 come la foto, così ogni elemento sta + dove sta sul quadro vero. +- `zebra.xml` — riproduzione della pulsantiera ZEBRA: 7 colonne × 6 righe di + pulsanti tondi illuminati, i due selettori delle ventole, i comandi motore + con gli ovali PORT/STBD ENGINE e il selettore PARALLEL a tre posizioni. + La foto è in prospettiva, quindi la griglia è stata ridisegnata dritta + (passo 120 in orizzontale, 145 in verticale); etichette, forme e colori delle + lenti vengono dalla foto. + +- `plancia-mfd.xml` — tutti i comandi, le spie e le misure di ZEBRA e ANTAGO + su una sola plancia, nello stile della foto `immagini\Esempio plancia.jpg`: + cornice scura con tasti a video ai lati, schermo nero con quattro quadranti, + i due display dei caricabatterie, il sinottico della barca con le spie e i + tasti illuminati di motori e servizi; sotto, due file di selettori. Pannello + 1900×1080. Gli indirizzi di ZEBRA sono quelli di `zebra.xml`; **le bobine + di ANTAGO sono spostate da slave 1 a slave 4**, perché sullo slave 1 si + sovrapponevano a quelle di ZEBRA, e i due comandi di prova "Luce" e "Horn" + di `antago.xml` (che stavano sul canale 0, lo stesso del selettore + VOLTMETER) sono sui canali 26 e 27 dello slave 4. + +In tutti **slave e canali sono inventati** e vanno rimappati sui moduli +reali prima di collegare il bus. + +## Strumenti + +`strumenti\` contiene gli script PowerShell usati per preparare la grafica dei +due quadri: + +| Script | Cosa fa | +|---|---| +| `ruota.ps1` | Raddrizza una foto scattata in verticale | +| `ritaglia-grafica.ps1` | Ritaglia un pezzo di serigrafia dalla foto e rende trasparente il fondo chiaro, lasciando solo il tratto | +| `genera-sfondo.ps1` | Disegna la lamiera del pannello con cornice e viti, di qualsiasi misura | +| `genera-mfd.ps1` | Disegna cornice e schermo di `plancia-mfd.xml` e la sagoma della barca ANTAGO in chiaro per il fondo nero | + +Il ritaglio dalla foto conviene solo per i disegni che non si possono +ricostruire, come la sagoma della barca del quadro ANTAGO. **Le scritte no**: +i marchi ZEBRA e ANTAGO e gli ovali PORT/STBD ENGINE sono elementi Testo con +font e cornice, non immagini, così restano nitidi a ogni ingrandimento. + +### Diagnostica del bus + +Due programmi a riga di comando servono quando un modulo non si legge. Vanno +lanciati **con PlanciaConsole chiusa**, perché la porta si apre una volta sola. +Si ricompilano con i `build-*.bat` accanto ai sorgenti. + +| Programma | Cosa fa | +|---|---| +| `scanbus.exe [porta] [baud] [ultimoIndirizzo]` | Interroga gli indirizzi uno per uno e dice chi risponde, con quali funzioni e che dati | +| `dumpframe.exe [porta] [baud] [slave] [funzione] [start] [quantità]` | Manda una sola richiesta e stampa i byte grezzi della risposta con la verifica della CRC | +| `monitorio.exe [porta] [baud] [slave] [canali] [cicli]` | Mostra gli ingressi digitali in tempo reale, una riga ad ogni cambiamento | +| `ringtest.exe [file.bmp]` | Disegna i comandi tondi spenti e accesi a tre misure e salva l'immagine: serve a giudicare una modifica ai colori guardandola | + +`scanbus` serve a trovare l'indirizzo di un modulo appena montato. `dumpframe` +serve quando `scanbus` dà risultati incoerenti: mostrando il frame byte per byte +distingue un modulo che non risponde da due moduli che rispondono insieme. + +**Due nodi con lo stesso indirizzo** è il guasto più frequente quando si +aggiunge un modulo: i moduli escono quasi tutti con indirizzo 1, e sul bus le +due risposte si sovrappongono. Il sintomo è una risposta di lunghezza variabile, +spesso con byte a zero in testa, e la CRC che non torna. + +## Il bus in un thread a parte + +Il thread principale non parla mai con la porta seriale. Tutto il Modbus vive +in un thread suo (`uModbusWorker.pas`), che apre la COM, fa le letture e le +scritture, e lascia i risultati in una cassetta condivisa. La finestra li +ritira con il suo timer. Così un timeout — mezzo secondo per richiesta — costa +tempo al thread del bus e non alla plancia, che resta trascinabile, ridisegnabile +e cliccabile anche con tutti i moduli staccati. + +**Un thread solo, non uno per le letture e uno per le scritture.** Su RS485 il +filo è uno: due richieste insieme si sovrappongono e le risposte arrivano +mescolate. Chi comanda deve comunque aspettare la fine della richiesta in +corso, quindi un secondo thread aggiungerebbe solo un lucchetto attorno alla +porta. La reattività dei comandi si ottiene con la **precedenza**: la coda +delle scritture viene svuotata prima di ogni lettura, non solo a ogni giro, +quindi un pulsante premuto parte al massimo dopo la richiesta in corso. + +Come si comporta: + +- **Cliccare un comando torna subito.** La scrittura va in coda; l'elemento si + accende fidandosi. Se la scrittura non va a segno lo dice la barra di stato, + e la rilettura delle bobine rimette l'elemento a posto entro un ciclo. +- **L'ordine è garantito**: le due bobine di un selettore a 3 posizioni, o la + pressione e il rilascio di un pulsante, partono nella sequenza in cui sono + state messe in coda. +- **La porta si riapre da sola.** Se non c'è, o se cade (adattatore USB + staccato), il thread riprova ogni due secondi: non serve più riavviare il + programma. +- **Chiudendo**, l'attesa del thread dura al massimo quanto la richiesta in + corso. + +## Aggiungere slave e canali + +Niente nel programma è legato ai moduli montati adesso: una plancia si può +disegnare prima, e i moduli si aggiungono quando arrivano. + +- **Slave**: qualsiasi indirizzo da 1 a 247, quanti se ne vuole sullo stesso + bus. Ogni slave nuovo aggiunge solo le sue richieste al giro di polling. +- **Canali**: qualsiasi numero da 0 a 65535, senza doverli tenere contigui. + Canali molto distanti sullo stesso slave allargano però l'intervallo letto + (vedi Polling), quindi conviene raggrupparli. +- **Limiti di una singola richiesta**, imposti dal protocollo: 2000 bit per + bobine e ingressi, 125 registri. Oltre, la richiesta viene saltata e la barra + di stato lo dice: si spezza l'intervallo o si sposta l'elemento su un altro + slave. +- **Nuove porte**: la porta è una per plancia (``). Due + bus separati si fanno con due plance, e si passa dall'una all'altra con la + casella in basso a destra. + +**Una richiesta che non riesce si divide da sola.** Se la lettura di un blocco +di bobine fallisce, il programma la spezza a metà e riprova con le due metà, e +così via: un modulo da 32 canali interrogato fino al 38 finisce per farsi +leggere i suoi 32 in poche richieste, invece di non dare più niente. Ogni +divisione compare nella barra di stato. Le divisioni imparate valgono finché +non si cambia plancia o non si riapre la porta. + +**Le richieste che non rispondono non danno fastidio.** Dopo tre errori di +fila una richiesta muta viene messa in pausa e riprovata ogni cinque secondi, +invece di costarne il timeout a ogni giro: così una plancia disegnata in +anticipo resta scorrevole e i moduli che rispondono vengono letti alla velocità +giusta. Appena il modulo viene collegato riparte da solo, entro quei cinque +secondi. La barra di stato distingue i due casi: `Timeout: nessuna risposta` è +una richiesta che si sta ancora provando, `non risponde, riprovo fra 4 s` è una +messa in pausa. La pausa si azzera da sola quando si cambia plancia, quando si +modificano i canali in configurazione e quando la porta viene riaperta. + +La pausa vale **per singola richiesta**, non per modulo: sullo stesso nodo le +bobine possono rispondere benissimo mentre gli ingressi, che quel modulo non ha, +danno errore. Mettere in pausa tutto il nodo per colpa degli ingressi +lascerebbe la plancia cieca proprio su quello che si legge. + +## Polling + +Ad ogni ciclo (`pollMs`) gli elementi vengono raggruppati per slave e tipo, e +per ogni gruppo parte **una sola** richiesta che copre i canali da quello più +basso a quello più alto. Aggiungere elementi contigui non aumenta il traffico +sul bus; canali molto distanti sullo stesso slave sì, perché allargano +l'intervallo letto. + +Ogni richiesta va per conto suo: se un modulo non risponde, gli altri gruppi +vengono letti comunque. Solo le spie e i gauge di **quella** richiesta passano a +"dato non disponibile"; il resto della plancia continua a leggere. Interruttori +e selettori invece non si azzerano, perché la loro posizione è un comando dato, +non una misura. + +L'errore finisce nella barra di stato dicendo **cosa** non si è potuto leggere: +slave, funzione e intervallo di canali, per esempio + + Lettura fallita su 4 richieste, la prima: slave 3, ingressi 0-14 (FC02): timeout + +Così si capisce subito se manca un modulo, se l'indirizzo è sbagliato o se si +sta leggendo oltre i canali che il modulo ha (tipico: un modulo da 8 bobine +interrogato per 37, perché un elemento ha un canale alto). Il polling continua +e si riallinea da solo appena il bus risponde. diff --git a/Console/PlanciaConsole.dpr b/Console/PlanciaConsole.dpr new file mode 100644 index 0000000..c384483 --- /dev/null +++ b/Console/PlanciaConsole.dpr @@ -0,0 +1,21 @@ +program PlanciaConsole; + +uses + Vcl.Forms, + uConsoleMain in 'uConsoleMain.pas' {ConsoleForm}, + uPlanciaElements in 'uPlanciaElements.pas', + uPlanciaConfig in 'uPlanciaConfig.pas', + uImageLib in 'uImageLib.pas', + uModbusRTU in '..\uModbusRTU.pas', + uModbusWorker in 'uModbusWorker.pas', + uAlarmSound in 'uAlarmSound.pas', + uGauge in '..\uGauge.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TConsoleForm, ConsoleForm); + Application.Run; +end. diff --git a/Console/PlanciaConsole.dproj b/Console/PlanciaConsole.dproj new file mode 100644 index 0000000..bea0b24 --- /dev/null +++ b/Console/PlanciaConsole.dproj @@ -0,0 +1,89 @@ + + + {B7C4D1E2-3F5A-4B6C-8D9E-0A1B2C3D4E5F} + 19.6 + VCL + PlanciaConsole.dpr + True + Debug + Win32 + 1 + Application + PlanciaConsole + + + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + + DEBUG;$(DCC_Define) + 1 + false + + + Debug + + + 0 + + + + MainSource + + +
ConsoleForm
+ dfm + + + + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + + Delphi.Personality.12 + VCLApplication + + + + PlanciaConsole.dpr + + + + True + + + 12 + + diff --git a/Console/PlanciaConsole.res b/Console/PlanciaConsole.res new file mode 100644 index 0000000..447d5c1 Binary files /dev/null and b/Console/PlanciaConsole.res differ diff --git a/Console/antago.xml b/Console/antago.xml new file mode 100644 index 0000000..5485d6c --- /dev/null +++ b/Console/antago.xml @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Console/esempio-immagini.xml b/Console/esempio-immagini.xml new file mode 100644 index 0000000..0865843 --- /dev/null +++ b/Console/esempio-immagini.xml @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Console/esempio-plancia.xml b/Console/esempio-plancia.xml new file mode 100644 index 0000000..768d538 --- /dev/null +++ b/Console/esempio-plancia.xml @@ -0,0 +1,19 @@ + + + + + + + + + + + + + + + + + diff --git a/Console/immagini/Esempio plancia.jpg b/Console/immagini/Esempio plancia.jpg new file mode 100644 index 0000000..e1be109 Binary files /dev/null and b/Console/immagini/Esempio plancia.jpg differ diff --git a/Console/immagini/antago-barca-chiara.png b/Console/immagini/antago-barca-chiara.png new file mode 100644 index 0000000..ef4a648 Binary files /dev/null and b/Console/immagini/antago-barca-chiara.png differ diff --git a/Console/immagini/antago-barca.png b/Console/immagini/antago-barca.png new file mode 100644 index 0000000..496f6e9 Binary files /dev/null and b/Console/immagini/antago-barca.png differ diff --git a/Console/immagini/antago-sfondo.png b/Console/immagini/antago-sfondo.png new file mode 100644 index 0000000..08c2a11 Binary files /dev/null and b/Console/immagini/antago-sfondo.png differ diff --git a/Console/immagini/btn-off.png b/Console/immagini/btn-off.png new file mode 100644 index 0000000..a72ddaf Binary files /dev/null and b/Console/immagini/btn-off.png differ diff --git a/Console/immagini/btn-on.png b/Console/immagini/btn-on.png new file mode 100644 index 0000000..f706b90 Binary files /dev/null and b/Console/immagini/btn-on.png differ diff --git a/Console/immagini/led-off.png b/Console/immagini/led-off.png new file mode 100644 index 0000000..bc4c7b3 Binary files /dev/null and b/Console/immagini/led-off.png differ diff --git a/Console/immagini/led-on.png b/Console/immagini/led-on.png new file mode 100644 index 0000000..db32b50 Binary files /dev/null and b/Console/immagini/led-on.png differ diff --git a/Console/immagini/logo-zebra.png b/Console/immagini/logo-zebra.png new file mode 100644 index 0000000..6453e0f Binary files /dev/null and b/Console/immagini/logo-zebra.png differ diff --git a/Console/immagini/mfd-sfondo.png b/Console/immagini/mfd-sfondo.png new file mode 100644 index 0000000..62f60b8 Binary files /dev/null and b/Console/immagini/mfd-sfondo.png differ diff --git a/Console/immagini/sfondo.png b/Console/immagini/sfondo.png new file mode 100644 index 0000000..240d42c Binary files /dev/null and b/Console/immagini/sfondo.png differ diff --git a/Console/immagini/zebra-sfondo.png b/Console/immagini/zebra-sfondo.png new file mode 100644 index 0000000..5a178dd Binary files /dev/null and b/Console/immagini/zebra-sfondo.png differ diff --git a/Console/plancia-mfd.xml b/Console/plancia-mfd.xml new file mode 100644 index 0000000..720aac5 --- /dev/null +++ b/Console/plancia-mfd.xml @@ -0,0 +1,92 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Console/plancia.xml b/Console/plancia.xml new file mode 100644 index 0000000..f431645 --- /dev/null +++ b/Console/plancia.xml @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + + + + + + diff --git a/Console/strumenti/build-dumpframe.bat b/Console/strumenti/build-dumpframe.bat new file mode 100644 index 0000000..331b616 --- /dev/null +++ b/Console/strumenti/build-dumpframe.bat @@ -0,0 +1,5 @@ +@echo off +call "F:\Program Files (x86)\Embarcadero\Studio\37.0\bin\rsvars.bat" >nul +cd /d D:\dev\plancia\Console\strumenti +dcc32.exe -B "-NSSystem;System.Win;Winapi;Vcl;Data;Xml" -E. -N. -U"D:\dev\plancia;F:\Program Files (x86)\Embarcadero\Studio\37.0\lib\Win32\release" dumpframe.dpr +echo ==== EXIT: %ERRORLEVEL% ==== diff --git a/Console/strumenti/build-monitorio.bat b/Console/strumenti/build-monitorio.bat new file mode 100644 index 0000000..3107a6a --- /dev/null +++ b/Console/strumenti/build-monitorio.bat @@ -0,0 +1,5 @@ +@echo off +call "F:\Program Files (x86)\Embarcadero\Studio\37.0\bin\rsvars.bat" >nul +cd /d D:\dev\plancia\Console\strumenti +dcc32.exe -B "-NSSystem;System.Win;Winapi;Vcl;Data;Xml" -E. -N. -U"D:\dev\plancia;F:\Program Files (x86)\Embarcadero\Studio\37.0\lib\Win32\release" monitorio.dpr +echo ==== EXIT: %ERRORLEVEL% ==== diff --git a/Console/strumenti/build-ringtest.bat b/Console/strumenti/build-ringtest.bat new file mode 100644 index 0000000..97ce122 --- /dev/null +++ b/Console/strumenti/build-ringtest.bat @@ -0,0 +1,5 @@ +@echo off +call "F:\Program Files (x86)\Embarcadero\Studio\37.0\bin\rsvars.bat" >nul +cd /d D:\dev\plancia\Console\strumenti +dcc32.exe -B "-NSSystem;System.Win;Winapi;Vcl;Vcl.Imaging;Data;Xml" -E. -N. -U"D:\dev\plancia\Console;D:\dev\plancia;F:\Program Files (x86)\Embarcadero\Studio\37.0\lib\Win32\release" ringtest.dpr +echo ==== EXIT: %ERRORLEVEL% ==== diff --git a/Console/strumenti/build-scanbus.bat b/Console/strumenti/build-scanbus.bat new file mode 100644 index 0000000..6f8e7c1 --- /dev/null +++ b/Console/strumenti/build-scanbus.bat @@ -0,0 +1,5 @@ +@echo off +call "F:\Program Files (x86)\Embarcadero\Studio\37.0\bin\rsvars.bat" >nul +cd /d D:\dev\plancia\Console\strumenti +dcc32.exe -B "-NSSystem;System.Win;Winapi;Vcl;Data;Xml" -E. -N. -U"D:\dev\plancia;F:\Program Files (x86)\Embarcadero\Studio\37.0\lib\Win32\release" scanbus.dpr +echo ==== EXIT: %ERRORLEVEL% ==== diff --git a/Console/strumenti/dumpframe.dpr b/Console/strumenti/dumpframe.dpr new file mode 100644 index 0000000..dea1345 --- /dev/null +++ b/Console/strumenti/dumpframe.dpr @@ -0,0 +1,128 @@ +program dumpframe; + +{ + Manda una singola richiesta Modbus e stampa i byte grezzi della risposta, + senza interpretarli. Serve quando una lettura fallisce e non si sa se il + problema sia nel modulo, nel cablaggio o nel codice che decodifica. + + Uso: dumpframe [porta] [baud] [slave] [funzione] [start] [quantita] + Es.: dumpframe COM7 9600 1 2 0 8 +} + +{$APPTYPE CONSOLE} + +uses + Winapi.Windows, System.SysUtils; + +function CRC16(const ABuf: array of Byte; ALen: Integer): Word; +var + I, J: Integer; +begin + Result := $FFFF; + for I := 0 to ALen - 1 do + begin + Result := Result xor ABuf[I]; + for J := 0 to 7 do + if (Result and 1) <> 0 then + Result := (Result shr 1) xor $A001 + else + Result := Result shr 1; + end; +end; + +function Hex(const ABuf: TBytes; ALen: Integer): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to ALen - 1 do + Result := Result + IntToHex(ABuf[I], 2) + ' '; +end; + +var + Port: string; + Baud, Slave, Func, Start, Qty: Integer; + H: THandle; + DCB: TDCB; + TO_: TCommTimeouts; + Req: array[0..7] of Byte; + C: Word; + Buf: TBytes; + Written, Got: DWORD; + Expected, I: Integer; + +begin + Port := 'COM7'; Baud := 9600; Slave := 1; Func := 2; Start := 0; Qty := 8; + if ParamCount >= 1 then Port := ParamStr(1); + if ParamCount >= 2 then Baud := StrToIntDef(ParamStr(2), 9600); + if ParamCount >= 3 then Slave := StrToIntDef(ParamStr(3), 1); + if ParamCount >= 4 then Func := StrToIntDef(ParamStr(4), 2); + if ParamCount >= 5 then Start := StrToIntDef(ParamStr(5), 0); + if ParamCount >= 6 then Qty := StrToIntDef(ParamStr(6), 8); + + H := CreateFile(PChar('\\.\' + Port), GENERIC_READ or GENERIC_WRITE, 0, nil, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if H = THandle(-1) then + begin + Writeln(Format('Impossibile aprire %s (errore %d)', [Port, GetLastError])); + Readln; Halt(1); + end; + + try + FillChar(DCB, SizeOf(DCB), 0); + DCB.DCBlength := SizeOf(DCB); + GetCommState(H, DCB); + DCB.BaudRate := Baud; + DCB.ByteSize := 8; + DCB.Parity := NOPARITY; + DCB.StopBits := ONESTOPBIT; + DCB.Flags := 0; + SetCommState(H, DCB); + + TO_.ReadIntervalTimeout := 50; + TO_.ReadTotalTimeoutMultiplier := 10; + TO_.ReadTotalTimeoutConstant := 500; + TO_.WriteTotalTimeoutMultiplier := 10; + TO_.WriteTotalTimeoutConstant := 500; + SetCommTimeouts(H, TO_); + PurgeComm(H, PURGE_RXCLEAR or PURGE_TXCLEAR); + + Req[0] := Slave; + Req[1] := Func; + Req[2] := Hi(Word(Start)); Req[3] := Lo(Word(Start)); + Req[4] := Hi(Word(Qty)); Req[5] := Lo(Word(Qty)); + C := CRC16(Req, 6); + Req[6] := Lo(C); Req[7] := Hi(C); + + Write ('RICHIESTA (8 byte): '); + for I := 0 to 7 do Write(IntToHex(Req[I], 2), ' '); + Writeln; + + WriteFile(H, Req[0], 8, Written, nil); + + // Legge molto piu' del necessario: se arriva un eco della richiesta o + // byte di troppo si devono vedere, non nascondere troncando. + Expected := 64; + SetLength(Buf, Expected); + Sleep(150); // lascia il tempo allo slave di rispondere per intero + ReadFile(H, Buf[0], Expected, Got, nil); + + Writeln(Format('RISPOSTA (%d byte): ', [Got]) + Hex(Buf, Got)); + + if Got >= 4 then + begin + C := CRC16(Buf, Got - 2); + Writeln(Format('CRC calcolata sui primi %d byte: %s %s - nel frame: %s %s -> %s', + [Got - 2, IntToHex(Lo(C), 2), IntToHex(Hi(C), 2), + IntToHex(Buf[Got - 2], 2), IntToHex(Buf[Got - 1], 2), + BoolToStr((Lo(C) = Buf[Got - 2]) and (Hi(C) = Buf[Got - 1]), True)])); + end; + + finally + CloseHandle(H); + end; + + Writeln; + Write('Premi INVIO per chiudere.'); + Readln; +end. diff --git a/Console/strumenti/genera-mfd.ps1 b/Console/strumenti/genera-mfd.ps1 new file mode 100644 index 0000000..ceb6929 --- /dev/null +++ b/Console/strumenti/genera-mfd.ps1 @@ -0,0 +1,91 @@ +# Grafica della plancia multifunzione (plancia-mfd.xml), sul modello della +# foto "Esempio plancia": cornice scura con il filo chiaro, schermo nero al +# centro. Produce anche la sagoma della barca ANTAGO in chiaro, perche' quella +# originale e' disegnata in nero e sullo schermo nero sparirebbe. +# +# powershell -File genera-mfd.ps1 + +param( + [string]$Dir = 'D:\dev\Plancia\Console\immagini', + [int]$W = 1900, + [int]$H = 1080, + # Schermo: deve coincidere con la disposizione degli elementi nell'XML. + [int]$ScreenLeft = 214, + [int]$ScreenTop = 34, + [int]$ScreenRight = 1686, + [int]$ScreenBottom = 716 +) + +Add-Type -AssemblyName System.Drawing + +function RoundRect([int]$x, [int]$y, [int]$w, [int]$h, [int]$r) { + $p = New-Object System.Drawing.Drawing2D.GraphicsPath + $d = 2 * $r + $p.AddArc($x, $y, $d, $d, 180, 90) + $p.AddArc(($x + $w - $d), $y, $d, $d, 270, 90) + $p.AddArc(($x + $w - $d), ($y + $h - $d), $d, $d, 0, 90) + $p.AddArc($x, ($y + $h - $d), $d, $d, 90, 90) + $p.CloseFigure() + return $p +} + +# --- sfondo -------------------------------------------------------------- +$bmp = New-Object System.Drawing.Bitmap($W, $H, [System.Drawing.Imaging.PixelFormat]::Format32bppArgb) +$g = [System.Drawing.Graphics]::FromImage($bmp) +$g.SmoothingMode = 'AntiAlias' + +# Cornice: grafite opaca, appena piu' chiara in alto. +$rect = New-Object System.Drawing.Rectangle(0, 0, $W, $H) +$c1 = [System.Drawing.Color]::FromArgb(255, 44, 46, 50) +$c2 = [System.Drawing.Color]::FromArgb(255, 22, 23, 26) +$br = New-Object System.Drawing.Drawing2D.LinearGradientBrush($rect, $c1, $c2, 90.0) +$g.FillRectangle($br, $rect) + +$edge = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 10, 10, 12)), 4 +$path = RoundRect 2 2 ($W - 5) ($H - 5) 26 +$g.DrawPath($edge, $path) + +# Il filo chiaro che corre tutto attorno, come nella foto. +$line = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 200, 204, 209)), 2 +$path = RoundRect 16 16 ($W - 33) ($H - 33) 20 +$g.DrawPath($line, $path) + +# Schermo: incassato (ombra scura attorno), nero, con un filo grigio. +$sw = $ScreenRight - $ScreenLeft +$sh = $ScreenBottom - $ScreenTop +$shadow = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 8, 8, 9)), 8 +$g.DrawRectangle($shadow, ($ScreenLeft - 4), ($ScreenTop - 4), ($sw + 8), ($sh + 8)) +$screen = New-Object System.Drawing.SolidBrush ([System.Drawing.Color]::FromArgb(255, 4, 5, 6)) +$g.FillRectangle($screen, $ScreenLeft, $ScreenTop, $sw, $sh) +$glass = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 92, 97, 104)), 2 +$g.DrawRectangle($glass, $ScreenLeft, $ScreenTop, $sw, $sh) + +# Separazione fra lo schermo e la fila dei selettori. +$sep = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 70, 74, 80)), 1 +$g.DrawLine($sep, 36, ($ScreenBottom + 16), ($W - 36), ($ScreenBottom + 16)) + +$g.Dispose() +$out = Join-Path $Dir 'mfd-sfondo.png' +$bmp.Save($out, [System.Drawing.Imaging.ImageFormat]::Png) +$bmp.Dispose() +Write-Output ("{0} {1}x{2}" -f $out, $W, $H) + +# --- sagoma della barca in chiaro --------------------------------------- +# Stessa trasparenza dell'originale, colore invertito: il tratto nero diventa +# grigio chiaro, le sfumature di bordo restano sfumature. +$src = New-Object System.Drawing.Bitmap (Join-Path $Dir 'antago-barca.png') +$dst = New-Object System.Drawing.Bitmap($src.Width, $src.Height, [System.Drawing.Imaging.PixelFormat]::Format32bppArgb) +for ($y = 0; $y -lt $src.Height; $y++) { + for ($x = 0; $x -lt $src.Width; $x++) { + $p = $src.GetPixel($x, $y) + if ($p.A -eq 0) { continue } + $v = [int](220 - ($p.R + $p.G + $p.B) / 3 * 0.85) + if ($v -lt 0) { $v = 0 } + $dst.SetPixel($x, $y, [System.Drawing.Color]::FromArgb($p.A, $v, $v, [Math]::Min(255, $v + 6))) + } +} +$out = Join-Path $Dir 'antago-barca-chiara.png' +$dst.Save($out, [System.Drawing.Imaging.ImageFormat]::Png) +$src.Dispose() +$dst.Dispose() +Write-Output ("{0}" -f $out) diff --git a/Console/strumenti/genera-sfondo.ps1 b/Console/strumenti/genera-sfondo.ps1 new file mode 100644 index 0000000..22962e9 --- /dev/null +++ b/Console/strumenti/genera-sfondo.ps1 @@ -0,0 +1,46 @@ +# Disegna la lamiera di un pannello: fondo chiaro sfumato, cornice e viti +# agli angoli. Usato per gli sfondi delle plance di esempio. +# +# powershell -File genera-sfondo.ps1 -Out ..\immagini\sfondo.png -W 1270 -H 950 + +param( + [string]$Out = 'D:\dev\Plancia\Console\immagini\antago-sfondo.png', + [int]$W = 1270, + [int]$H = 950 +) + +Add-Type -AssemblyName System.Drawing + +$bmp = New-Object System.Drawing.Bitmap($W, $H, [System.Drawing.Imaging.PixelFormat]::Format32bppArgb) +$g = [System.Drawing.Graphics]::FromImage($bmp) +$g.SmoothingMode = 'AntiAlias' + +# Lamiera verniciata: bianco sporco con una leggerissima ombreggiatura verticale. +$rect = New-Object System.Drawing.Rectangle(0, 0, $W, $H) +$c1 = [System.Drawing.Color]::FromArgb(255, 246, 246, 243) +$c2 = [System.Drawing.Color]::FromArgb(255, 226, 227, 224) +$br = New-Object System.Drawing.Drawing2D.LinearGradientBrush($rect, $c1, $c2, 90.0) +$g.FillRectangle($br, $rect) + +# Cornice del pannello +$pen = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 120, 122, 120)), 3 +$g.DrawRectangle($pen, 6, 6, ($W - 13), ($H - 13)) +$pen2 = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(90, 255, 255, 255)), 1 +$g.DrawRectangle($pen2, 10, 10, ($W - 21), ($H - 21)) + +# Viti agli angoli +$screwFill = New-Object System.Drawing.SolidBrush ([System.Drawing.Color]::FromArgb(255, 176, 178, 176)) +$screwEdge = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 110, 112, 110)), 2 +$slot = New-Object System.Drawing.Pen ([System.Drawing.Color]::FromArgb(255, 90, 92, 90)), 3 +foreach ($p in @(@(26, 26), @(($W - 46), 26), @(26, ($H - 46)), @(($W - 46), ($H - 46)))) { + $x = $p[0] + $y = $p[1] + $g.FillEllipse($screwFill, $x, $y, 20, 20) + $g.DrawEllipse($screwEdge, $x, $y, 20, 20) + $g.DrawLine($slot, ($x + 4), ($y + 14), ($x + 16), ($y + 6)) +} + +$g.Dispose() +$bmp.Save($Out, [System.Drawing.Imaging.ImageFormat]::Png) +$bmp.Dispose() +Write-Output ("{0} {1}x{2}" -f $Out, $W, $H) diff --git a/Console/strumenti/monitorio.dpr b/Console/strumenti/monitorio.dpr new file mode 100644 index 0000000..80aba26 --- /dev/null +++ b/Console/strumenti/monitorio.dpr @@ -0,0 +1,129 @@ +program monitorio; + +{ + Mostra in tempo reale gli ingressi digitali di un modulo IO. + + Serve al banco, quando si collega un morsetto e si vuole vedere subito quale + canale si muove. Stampa una riga solo quando qualcosa cambia, cosi' la + finestra non scorre da sola e la cronologia resta leggibile. + + Uso: monitorio [porta] [baud] [slave] [canali] [cicli] + cicli = quante letture fare prima di uscire; 0 o assente = per sempre + Es.: monitorio COM7 9600 2 8 + + Si chiude con Ctrl+C. +} + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + uModbusRTU in '..\..\uModbusRTU.pas'; + +/// "1 0 0 1 . . . ." con i canali spenti resi come punto: gli accesi saltano all'occhio. +function Render(const ABits: TArray): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to High(ABits) do + if ABits[I] then + Result := Result + '[1]' + else + Result := Result + ' . '; +end; + +function Header(ACount: Integer): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to ACount - 1 do + Result := Result + Format(' %d ', [I]); +end; + +var + Port: string; + Baud, Slave, Count, Cycles, Done: Integer; + Bus: TModbusRTU; + Bits, Prev: TArray; + First: Boolean; + Changed: Boolean; + I, Errors: Integer; + LastErr: string; + +begin + Port := 'COM7'; Baud := 9600; Slave := 2; Count := 8; Cycles := 0; Done := 0; + if ParamCount >= 1 then Port := ParamStr(1); + if ParamCount >= 2 then Baud := StrToIntDef(ParamStr(2), 9600); + if ParamCount >= 3 then Slave := StrToIntDef(ParamStr(3), 2); + if ParamCount >= 4 then Count := StrToIntDef(ParamStr(4), 8); + if ParamCount >= 5 then Cycles := StrToIntDef(ParamStr(5), 0); + + Writeln(Format('Ingressi dello slave %d su %s a %d baud. Ctrl+C per uscire.', + [Slave, Port, Baud])); + Writeln; + Writeln(' canale: ' + Header(Count)); + Writeln; + + Bus := TModbusRTU.Create(Port, Baud, 500); + try + Bus.Connect; + First := True; + Errors := 0; + LastErr := ''; + SetLength(Prev, 0); + + while True do + begin + try + Bits := Bus.ReadDiscreteInputs(Slave, 0, Count); + + if Errors > 0 then + begin + Writeln(Format('%s ... ripristinato dopo %d letture fallite', + [FormatDateTime('hh:nn:ss', Now), Errors])); + Errors := 0; + end; + + Changed := First or (Length(Prev) <> Length(Bits)); + if not Changed then + for I := 0 to High(Bits) do + if Bits[I] <> Prev[I] then + begin + Changed := True; + Break; + end; + + if Changed then + begin + Writeln(FormatDateTime('hh:nn:ss', Now) + ' ' + Render(Bits)); + Prev := Copy(Bits); + First := False; + end; + + except + on E: Exception do + begin + // Un errore ripetuto non deve riempire lo schermo: lo si stampa + // la prima volta e poi si tace finche' non cambia. + Inc(Errors); + if E.Message <> LastErr then + begin + Writeln(FormatDateTime('hh:nn:ss', Now) + ' ERRORE: ' + E.Message); + LastErr := E.Message; + end; + end; + end; + + Sleep(200); + + Inc(Done); + if (Cycles > 0) and (Done >= Cycles) then + Break; + end; + + finally + Bus.Free; + end; +end. diff --git a/Console/strumenti/ringtest.dpr b/Console/strumenti/ringtest.dpr new file mode 100644 index 0000000..a3f1700 --- /dev/null +++ b/Console/strumenti/ringtest.dpr @@ -0,0 +1,122 @@ +program ringtest; + +{ + Banco di prova per l'aspetto degli elementi: disegna la stessa scena di giorno + e di notte, spenta e accesa, e salva l'immagine. Serve a giudicare una + modifica ai colori guardandola invece che immaginandola. + + Uso: ringtest [file.bmp] +} + +{$APPTYPE CONSOLE} + +uses + Winapi.Windows, System.SysUtils, System.Classes, + Vcl.Forms, Vcl.Graphics, Vcl.Controls, Vcl.ExtCtrls, + uPlanciaElements in '..\uPlanciaElements.pas', + uImageLib in '..\uImageLib.pas', + uModbusRTU in '..\..\uModbusRTU.pas'; + +const + PANE_W = 430; + PANE_H = 330; + +var + Host: TForm; + Lib: TImageLibrary; + Bmp: TBitmap; + OutFile: string; + +/// Un elemento nello stato voluto, dentro il riquadro indicato. +procedure Place(APane: TWinControl; AKind: TElementKind; AShape: TKeyShape; + ALeft, ATop, AW, AH: Integer; AOn, ANight: Boolean; const ACaption: string; + AOffColor: TColor); +var + Def: TElementDef; + El: TPlanciaElement; +begin + Def := TElementDef.Create(AKind); + Def.Shape := AShape; + Def.Caption := ACaption; + Def.CaptionPos := cpBelow; + Def.OffColor := AOffColor; + Def.Left := ALeft; + Def.Top := ATop; + Def.Width := AW; + Def.Height := AH; + El := TPlanciaElement.CreateElement(Host, Def, Lib); + El.Parent := APane; + El.Color := APane.Brush.Color; + El.NightMode := ANight; + El.SyncState(AOn); +end; + +/// La stessa scena, cambia solo se e' notte. +procedure Scene(APane: TPanel; ANight: Boolean); +begin + // Tondi: spento e acceso, con lente neutra e lente rossa. + Place(APane, ekSwitch, ksRound, 20, 20, 96, 96, False, ANight, 'SPENTO', clNone); + Place(APane, ekSwitch, ksRound, 130, 20, 96, 96, True, ANight, 'ACCESO', clNone); + Place(APane, ekSwitch, ksRound, 240, 20, 96, 96, False, ANight, 'FIRE', TColor($001818B0)); + Place(APane, ekSwitch, ksRound, 340, 20, 96, 96, True, ANight, 'FIRE ON', TColor($001818B0)); + // Squadrati: qui lo stato sta tutto nel bordo. + Place(APane, ekButton, ksRect, 20, 150, 110, 44, False, ANight, 'RECT', clNone); + Place(APane, ekButton, ksRect, 150, 150, 110, 44, True, ANight, 'RECT ON', clNone); + // Spia: questa il colore lo cambia eccome. + Place(APane, ekLamp, ksAuto, 290, 150, 70, 60, False, ANight, 'SPIA', clNone); + Place(APane, ekLamp, ksAuto, 365, 150, 70, 60, True, ANight, 'SPIA ON', clNone); + // Scritta serigrafata: di notte deve passare all'ambra, non sparire. + Place(APane, ekLabel, ksAuto, 20, 250, 200, 50, False, ANight, 'ZEBRA', clNone); + Place(APane, ekGauge, ksAuto, 250, 225, 100, 95, False, ANight, 'LIVELLO', clNone); +end; + +var + PaneDay, PaneNight: TPanel; + +begin + OutFile := 'ringtest.bmp'; + if ParamCount >= 1 then + OutFile := ParamStr(1); + + Application.Initialize; + Lib := TImageLibrary.Create; + Host := TForm.Create(nil); + try + Host.BorderStyle := bsNone; + Host.ClientWidth := PANE_W * 2; + Host.ClientHeight := PANE_H; + + PaneDay := TPanel.Create(Host); + PaneDay.Parent := Host; + PaneDay.SetBounds(0, 0, PANE_W, PANE_H); + PaneDay.BevelOuter := bvNone; + PaneDay.Color := clBtnFace; + PaneDay.ParentBackground := False; + + PaneNight := TPanel.Create(Host); + PaneNight.Parent := Host; + PaneNight.SetBounds(PANE_W, 0, PANE_W, PANE_H); + PaneNight.BevelOuter := bvNone; + PaneNight.Color := CLR_NIGHT_BG; + PaneNight.ParentBackground := False; + + Scene(PaneDay, False); + Scene(PaneNight, True); + + Host.Show; + Application.ProcessMessages; + + Bmp := TBitmap.Create; + try + Bmp.SetSize(Host.ClientWidth, Host.ClientHeight); + Host.PaintTo(Bmp.Canvas.Handle, 0, 0); + Bmp.SaveToFile(OutFile); + Writeln(Format('scritto %s (%dx%d)', [OutFile, Bmp.Width, Bmp.Height])); + finally + Bmp.Free; + end; + finally + Host.Free; + Lib.Free; + end; +end. diff --git a/Console/strumenti/ringtest.png b/Console/strumenti/ringtest.png new file mode 100644 index 0000000..3ee3b47 Binary files /dev/null and b/Console/strumenti/ringtest.png differ diff --git a/Console/strumenti/ritaglia-grafica.ps1 b/Console/strumenti/ritaglia-grafica.ps1 new file mode 100644 index 0000000..7171593 --- /dev/null +++ b/Console/strumenti/ritaglia-grafica.ps1 @@ -0,0 +1,41 @@ +# Estrae un pezzo di serigrafia dalla foto di un quadro: ritaglia la regione +# indicata e rende trasparenti i pixel piu' chiari della soglia, cosi' resta +# solo il tratto scuro e si appoggia su qualunque sfondo. +# +# powershell -File ritaglia-grafica.ps1 -Src foto.png -Out logo.png -X 452 -Y 824 -W 335 -H 112 -Soglia 128 + +param( + [string]$Src, + [string]$Out, + [int]$X, + [int]$Y, + [int]$W, + [int]$H, + [double]$Soglia = 128.0 +) + +Add-Type -AssemblyName System.Drawing + +$img = [System.Drawing.Bitmap]::FromFile($Src) +$bmp = New-Object System.Drawing.Bitmap($W, $H, [System.Drawing.Imaging.PixelFormat]::Format32bppArgb) +$clear = [System.Drawing.Color]::FromArgb(0, 255, 255, 255) + +for ($j = 0; $j -lt $H; $j++) { + for ($i = 0; $i -lt $W; $i++) { + $c = $img.GetPixel(($X + $i), ($Y + $j)) + $lum = ([double]$c.R * 0.299) + ([double]$c.G * 0.587) + ([double]$c.B * 0.114) + if ($lum -gt $Soglia) { + $bmp.SetPixel($i, $j, $clear) + } + else { + # Normalizza il tratto verso il nero, togliendo il colore della luce + $v = [int]([Math]::Max(0.0, [Math]::Min(255.0, ($lum * 0.7)))) + $bmp.SetPixel($i, $j, [System.Drawing.Color]::FromArgb(255, $v, $v, $v)) + } + } +} + +$bmp.Save($Out, [System.Drawing.Imaging.ImageFormat]::Png) +$bmp.Dispose() +$img.Dispose() +Write-Output ("{0} {1}x{2}" -f $Out, $W, $H) diff --git a/Console/strumenti/ruota.ps1 b/Console/strumenti/ruota.ps1 new file mode 100644 index 0000000..5a5d286 --- /dev/null +++ b/Console/strumenti/ruota.ps1 @@ -0,0 +1,23 @@ +# Ruota un'immagine di 90 gradi. Serve per raddrizzare le foto dei quadri +# scattate in verticale. +# +# powershell -File ruota.ps1 -In foto.png -Out dritta.png -Verso ccw + +param( + [string]$In, + [string]$Out, + [ValidateSet('cw', 'ccw')][string]$Verso = 'ccw' +) + +Add-Type -AssemblyName System.Drawing + +$img = [System.Drawing.Bitmap]::FromFile($In) +if ($Verso -eq 'cw') { + $img.RotateFlip([System.Drawing.RotateFlipType]::Rotate90FlipNone) +} +else { + $img.RotateFlip([System.Drawing.RotateFlipType]::Rotate270FlipNone) +} +$img.Save($Out, [System.Drawing.Imaging.ImageFormat]::Png) +Write-Output ("{0} {1}x{2}" -f $Out, $img.Width, $img.Height) +$img.Dispose() diff --git a/Console/strumenti/scanbus.dpr b/Console/strumenti/scanbus.dpr new file mode 100644 index 0000000..91e0605 --- /dev/null +++ b/Console/strumenti/scanbus.dpr @@ -0,0 +1,141 @@ +program scanbus; + +{ + Scanner del bus Modbus RTU. + + Interroga gli indirizzi slave uno per uno e riporta chi risponde, con quali + funzioni e che dati restituisce. Serve a scoprire l'indirizzo di un modulo + appena inserito e a capire da che canale partono i suoi ingressi. + + Uso: scanbus [porta] [baud] [ultimoIndirizzo] + Es.: scanbus COM7 9600 16 +} + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + uModbusRTU in '..\..\uModbusRTU.pas'; + +const + PROBE_TIMEOUT_MS = 200; // basso: un indirizzo morto non deve costare mezzo secondo + PROBE_COUNT = 8; // 8 canali: la taglia tipica di questi moduli + +/// Rende leggibili gli 8 bit come "1 0 0 1 ...", con i numeri di canale sopra. +function BitsToStr(const ABits: TArray): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to High(ABits) do + if ABits[I] then Result := Result + '1 ' else Result := Result + '0 '; +end; + +function RegsToStr(const ARegs: TArray): string; +var + I: Integer; +begin + Result := ''; + for I := 0 to High(ARegs) do + Result := Result + IntToStr(ARegs[I]) + ' '; +end; + +var + Port: string; + Baud: Cardinal; + LastAddr: Integer; + Bus: TModbusRTU; + Addr: Integer; + Alive: Boolean; + Found: Integer; + Bits: TArray; + Regs: TArray; + +begin + try + Port := 'COM7'; + Baud := 9600; + LastAddr := 16; + if ParamCount >= 1 then Port := ParamStr(1); + if ParamCount >= 2 then Baud := StrToUIntDef(ParamStr(2), 9600); + if ParamCount >= 3 then LastAddr := StrToIntDef(ParamStr(3), 16); + + Writeln(Format('Scansione %s a %d baud, indirizzi da 1 a %d.', [Port, Baud, LastAddr])); + Writeln('Chiudi PlanciaConsole prima di lanciarlo: la porta si apre una volta sola.'); + Writeln; + + Bus := TModbusRTU.Create(Port, Baud, PROBE_TIMEOUT_MS); + try + Bus.Connect; + Found := 0; + + for Addr := 1 to LastAddr do + begin + Write(Format(#13' provo indirizzo %d... ', [Addr])); + Alive := False; + + // FC 02 - ingressi digitali: e' cio' che interessa a un modulo IO + try + Bits := Bus.ReadDiscreteInputs(Addr, 0, PROBE_COUNT); + if not Alive then Writeln(#13 + Format('SLAVE %d trovato', [Addr]) + StringOfChar(' ', 20)); + Alive := True; + Writeln(' FC02 ingressi (canali 0..7): ' + BitsToStr(Bits)); + except + on E: Exception do ; + end; + + // FC 01 - bobine: le uscite rele' + try + Bits := Bus.ReadCoils(Addr, 0, PROBE_COUNT); + if not Alive then Writeln(#13 + Format('SLAVE %d trovato', [Addr]) + StringOfChar(' ', 20)); + Alive := True; + Writeln(' FC01 bobine (canali 0..7): ' + BitsToStr(Bits)); + except + on E: Exception do ; + end; + + if not Alive then + Continue; // indirizzo morto: inutile insistere con i registri + + // Solo per chi ha gia' risposto: vale la pena chiedere anche i registri + try + Regs := Bus.ReadHoldingRegisters(Addr, 0, 4); + Writeln(' FC03 holding (reg 0..3): ' + RegsToStr(Regs)); + except + on E: Exception do ; + end; + + try + Regs := Bus.ReadInputRegisters(Addr, 0, 4); + Writeln(' FC04 input reg (reg 0..3): ' + RegsToStr(Regs)); + except + on E: Exception do ; + end; + + Writeln; + Inc(Found); + end; + + Writeln(#13 + StringOfChar(' ', 40)); + if Found = 0 then + begin + Writeln('Nessuno slave ha risposto.'); + Writeln('Controlla: baud del modulo, scambio A/B del RS485, alimentazione,'); + Writeln('e che PlanciaConsole non tenga gia'' aperta la porta.'); + end + else + Writeln(Format('Trovati %d slave.', [Found])); + + finally + Bus.Free; + end; + + except + on E: Exception do + Writeln('ERRORE: ' + E.Message); + end; + + Writeln; + Write('Premi INVIO per chiudere.'); + Readln; +end. diff --git a/Console/suoni/49656682-fire-alarm-test-inside-an-apartment-438459.mp3 b/Console/suoni/49656682-fire-alarm-test-inside-an-apartment-438459.mp3 new file mode 100644 index 0000000..d4593de Binary files /dev/null and b/Console/suoni/49656682-fire-alarm-test-inside-an-apartment-438459.mp3 differ diff --git a/Console/suoni/8footdino_on_scratch-alarm-301729.mp3 b/Console/suoni/8footdino_on_scratch-alarm-301729.mp3 new file mode 100644 index 0000000..a27d396 Binary files /dev/null and b/Console/suoni/8footdino_on_scratch-alarm-301729.mp3 differ diff --git a/Console/suoni/cicalino.wav b/Console/suoni/cicalino.wav new file mode 100644 index 0000000..debbcd0 Binary files /dev/null and b/Console/suoni/cicalino.wav differ diff --git a/Console/suoni/dennish18-biohazard-alarm-143105.mp3 b/Console/suoni/dennish18-biohazard-alarm-143105.mp3 new file mode 100644 index 0000000..eee30de Binary files /dev/null and b/Console/suoni/dennish18-biohazard-alarm-143105.mp3 differ diff --git a/Console/suoni/emir3427-alarm-478339.mp3 b/Console/suoni/emir3427-alarm-478339.mp3 new file mode 100644 index 0000000..379ae12 Binary files /dev/null and b/Console/suoni/emir3427-alarm-478339.mp3 differ diff --git a/Console/suoni/engyclick-fire-alarm-beep-sound-effect-419969.mp3 b/Console/suoni/engyclick-fire-alarm-beep-sound-effect-419969.mp3 new file mode 100644 index 0000000..eb387d7 Binary files /dev/null and b/Console/suoni/engyclick-fire-alarm-beep-sound-effect-419969.mp3 differ diff --git a/Console/suoni/freesound_community-fire-alarm-33770.mp3 b/Console/suoni/freesound_community-fire-alarm-33770.mp3 new file mode 100644 index 0000000..a6d3d1b Binary files /dev/null and b/Console/suoni/freesound_community-fire-alarm-33770.mp3 differ diff --git a/Console/suoni/freesound_community-siren-alert-96052.mp3 b/Console/suoni/freesound_community-siren-alert-96052.mp3 new file mode 100644 index 0000000..7e96c27 Binary files /dev/null and b/Console/suoni/freesound_community-siren-alert-96052.mp3 differ diff --git a/Console/suoni/gabbynunez-uk-eas-alarm-iphone-523053.mp3 b/Console/suoni/gabbynunez-uk-eas-alarm-iphone-523053.mp3 new file mode 100644 index 0000000..6282103 Binary files /dev/null and b/Console/suoni/gabbynunez-uk-eas-alarm-iphone-523053.mp3 differ diff --git a/Console/suoni/jeremayjimenez-guyana-eas-alarm-374017.mp3 b/Console/suoni/jeremayjimenez-guyana-eas-alarm-374017.mp3 new file mode 100644 index 0000000..c991ff9 Binary files /dev/null and b/Console/suoni/jeremayjimenez-guyana-eas-alarm-374017.mp3 differ diff --git a/Console/suoni/jeremayjimenez-mexico-eas-alarm-279079.mp3 b/Console/suoni/jeremayjimenez-mexico-eas-alarm-279079.mp3 new file mode 100644 index 0000000..817d620 Binary files /dev/null and b/Console/suoni/jeremayjimenez-mexico-eas-alarm-279079.mp3 differ diff --git a/Console/suoni/jeremayjimenez-switzerland-eas-alarm-496017.mp3 b/Console/suoni/jeremayjimenez-switzerland-eas-alarm-496017.mp3 new file mode 100644 index 0000000..0cdfced Binary files /dev/null and b/Console/suoni/jeremayjimenez-switzerland-eas-alarm-496017.mp3 differ diff --git a/Console/suoni/u_inx5oo5fv3-alarm-327234.mp3 b/Console/suoni/u_inx5oo5fv3-alarm-327234.mp3 new file mode 100644 index 0000000..6a02b91 Binary files /dev/null and b/Console/suoni/u_inx5oo5fv3-alarm-327234.mp3 differ diff --git a/Console/suoni/universfield-digital-alarm-clock-151920.mp3 b/Console/suoni/universfield-digital-alarm-clock-151920.mp3 new file mode 100644 index 0000000..40b4843 Binary files /dev/null and b/Console/suoni/universfield-digital-alarm-clock-151920.mp3 differ diff --git a/Console/suoni/universfield-digital-alarm-clock-151927.mp3 b/Console/suoni/universfield-digital-alarm-clock-151927.mp3 new file mode 100644 index 0000000..3609894 Binary files /dev/null and b/Console/suoni/universfield-digital-alarm-clock-151927.mp3 differ diff --git a/Console/suoni/universfield-new-notification-08-352461.mp3 b/Console/suoni/universfield-new-notification-08-352461.mp3 new file mode 100644 index 0000000..40a8295 Binary files /dev/null and b/Console/suoni/universfield-new-notification-08-352461.mp3 differ diff --git a/Console/uAlarmSound.pas b/Console/uAlarmSound.pas new file mode 100644 index 0000000..3758798 --- /dev/null +++ b/Console/uAlarmSound.pas @@ -0,0 +1,195 @@ +unit uAlarmSound; + +{ + Suoni di allarme delle spie. + + Usa MCI (mciSendString), che su Windows suona MP3 e WAV senza librerie + esterne e senza mettere un componente sul form. La riproduzione non blocca: + "play" torna subito e il suono continua per conto suo, quindi una plancia + che suona resta comandabile. + + Ogni file suona su un proprio alias, aperto la prima volta e tenuto aperto: + riaprirlo a ogni allarme costerebbe qualche decimo di secondo, e un cicalino + deve partire nell'istante in cui la spia si accende. Due allarmi diversi si + sovrappongono; lo stesso allarme che si ripete riparte da capo. +} + +interface + +uses + Winapi.Windows, Winapi.MMSystem, System.SysUtils, System.Classes, + System.Generics.Collections; + +type + TAlarmPlayer = class + private + /// Percorso del file -> alias MCI aperto per quel file. + FOpen: TDictionary; + FNextAlias: Integer; + FLastError: string; + function Command(const ACommand: string): Boolean; + /// Comando MCI che torna una risposta ('status ... mode' e simili). + function Query(const ACommand: string): string; + function AliasFor(const AFileName: string): string; + public + constructor Create; + destructor Destroy; override; + /// Suona il file, ripartendo da capo se sta gia' suonando. False se non + /// si e' potuto suonare; il motivo sta in LastError. + /// Con ALoop il suono riparte da solo quando finisce, finche' non lo si + /// ferma: un allarme deve continuare a chiamare, non suonare una volta. + function Play(const AFileName: string; ALoop: Boolean = False): Boolean; + /// Vero se quel file sta suonando in questo momento. Serve a far + /// ricominciare l'allarme sui dispositivi che non sanno ripetere da soli. + function IsPlaying(const AFileName: string): Boolean; + /// Ferma un suono solo, lasciando suonare gli altri: serve quando una + /// spia si spegne mentre altri allarmi sono ancora attivi. + procedure Stop(const AFileName: string); + /// Zittisce tutto: si usa lasciando la plancia o chiudendo. + procedure StopAll; + property LastError: string read FLastError; + end; + +implementation + +const + /// Oltre questo numero di suoni diversi aperti, il piu' vecchio si chiude: + /// una plancia con decine di allarmi non deve tenere aperti decine di + /// dispositivi MCI. + MAX_OPEN = 8; + +{ TAlarmPlayer } + +constructor TAlarmPlayer.Create; +begin + inherited Create; + FOpen := TDictionary.Create; +end; + +destructor TAlarmPlayer.Destroy; +begin + StopAll; + FOpen.Free; + inherited; +end; + +function TAlarmPlayer.Command(const ACommand: string): Boolean; +var + Err: MCIERROR; + Buf: array[0..255] of Char; +begin + Err := mciSendString(PChar(ACommand), nil, 0, 0); + Result := Err = 0; + if Result then + Exit; + if mciGetErrorString(Err, Buf, Length(Buf)) then + FLastError := Buf + else + FLastError := Format('errore MCI %d', [Err]); +end; + +function TAlarmPlayer.AliasFor(const AFileName: string): string; +var + Key: string; + Old: TPair; +begin + Key := LowerCase(AFileName); + if FOpen.TryGetValue(Key, Result) then + Exit; + + if FOpen.Count >= MAX_OPEN then + for Old in FOpen do + begin + Command('close ' + Old.Value); + FOpen.Remove(Old.Key); + Break; + end; + + Inc(FNextAlias); + Result := Format('plancia_all%d', [FNextAlias]); + // Il tipo va detto: senza, MCI sceglie dall'estensione e sui .mp3 di certe + // installazioni sbaglia dispositivo. + if not Command(Format('open "%s" type mpegvideo alias %s', + [AFileName, Result])) then + if not Command(Format('open "%s" alias %s', [AFileName, Result])) then + Exit(''); + FOpen.Add(Key, Result); +end; + +function TAlarmPlayer.Query(const ACommand: string): string; +var + Buf: array[0..127] of Char; +begin + if mciSendString(PChar(ACommand), Buf, Length(Buf), 0) = 0 then + Result := Buf + else + Result := ''; +end; + +function TAlarmPlayer.IsPlaying(const AFileName: string): Boolean; +var + Alias: string; +begin + Result := FOpen.TryGetValue(LowerCase(AFileName), Alias) and + SameText(Query('status ' + Alias + ' mode'), 'playing'); +end; + +function TAlarmPlayer.Play(const AFileName: string; ALoop: Boolean): Boolean; +var + Alias: string; +begin + FLastError := ''; + if AFileName = '' then + Exit(False); + if not FileExists(AFileName) then + begin + FLastError := 'file non trovato'; + Exit(False); + end; + + Alias := AliasFor(AFileName); + if Alias = '' then + Exit(False); + // "from 0" fa ripartire da capo un allarme che sta gia' suonando: meglio + // risentirlo dall'inizio che non sentire niente. Con "repeat" il + // dispositivo ripete da solo; non tutti lo accettano, e a quelli si rimedia + // facendolo ripartire da fuori quando risulta fermo (vedi IsPlaying). + Result := False; + if ALoop then + Result := Command(Format('play %s from 0 repeat', [Alias])); + if not Result then + Result := Command(Format('play %s from 0', [Alias])); + if not Result then + begin + // Il dispositivo puo' essere morto (cuffie staccate): si riapre da capo. + Command('close ' + Alias); + FOpen.Remove(LowerCase(AFileName)); + Alias := AliasFor(AFileName); + if Alias <> '' then + Result := Command(Format('play %s from 0', [Alias])); + end; +end; + +procedure TAlarmPlayer.Stop(const AFileName: string); +var + Alias: string; +begin + // Il dispositivo resta aperto: se l'allarme torna, riparte senza il ritardo + // dell'apertura. + if FOpen.TryGetValue(LowerCase(AFileName), Alias) then + Command('stop ' + Alias); +end; + +procedure TAlarmPlayer.StopAll; +var + Alias: string; +begin + for Alias in FOpen.Values do + begin + Command('stop ' + Alias); + Command('close ' + Alias); + end; + FOpen.Clear; +end; + +end. diff --git a/Console/uConsoleMain.dfm b/Console/uConsoleMain.dfm new file mode 100644 index 0000000..c30e52f --- /dev/null +++ b/Console/uConsoleMain.dfm @@ -0,0 +1,972 @@ +object ConsoleForm: TConsoleForm + Left = 0 + Top = 0 + Caption = 'Plancia' + ClientHeight = 760 + ClientWidth = 1200 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Position = poScreenCenter + OnCloseQuery = FormCloseQuery + OnCreate = FormCreate + OnDestroy = FormDestroy + OnKeyDown = FormKeyDown + OnKeyPress = FormKeyPress + TextHeight = 15 + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 1200 + Height = 44 + Align = alTop + BevelOuter = bvNone + TabOrder = 0 + object lblZoom: TLabel + Left = 702 + Top = 15 + Width = 30 + Height = 15 + Caption = 'Zoom' + end + object lblFile: TLabel + Left = 852 + Top = 15 + Width = 3 + Height = 15 + end + object btnNuovo: TButton + Left = 10 + Top = 8 + Width = 80 + Height = 28 + Caption = 'Nuovo' + TabOrder = 0 + OnClick = btnNuovoClick + end + object btnApri: TButton + Left = 96 + Top = 8 + Width = 80 + Height = 28 + Caption = 'Apri...' + TabOrder = 1 + OnClick = btnApriClick + end + object btnSalva: TButton + Left = 182 + Top = 8 + Width = 80 + Height = 28 + Caption = 'Salva' + TabOrder = 2 + OnClick = btnSalvaClick + end + object btnSalvaCome: TButton + Left = 268 + Top = 8 + Width = 110 + Height = 28 + Caption = 'Salva con nome...' + TabOrder = 3 + OnClick = btnSalvaComeClick + end + object btnAnnulla: TButton + Left = 390 + Top = 8 + Width = 80 + Height = 28 + Hint = 'Annulla l'#39'ultima modifica (Ctrl+Z)' + Caption = 'Annulla' + Enabled = False + ParentShowHint = False + ShowHint = True + TabOrder = 6 + OnClick = btnAnnullaClick + end + object btnRipeti: TButton + Left = 476 + Top = 8 + Width = 80 + Height = 28 + Hint = 'Ripete la modifica annullata (Ctrl+Y)' + Caption = 'Ripeti' + Enabled = False + ParentShowHint = False + ShowHint = True + TabOrder = 7 + OnClick = btnRipetiClick + end + object chkGriglia: TCheckBox + Left = 568 + Top = 14 + Width = 120 + Height = 17 + Caption = 'Griglia 10 px' + Checked = True + State = cbChecked + TabOrder = 4 + OnClick = chkGrigliaClick + end + object cboZoom: TComboBox + Left = 742 + Top = 11 + Width = 84 + Height = 23 + Style = csDropDownList + TabOrder = 5 + OnChange = ZoomChanged + end + end + object pnlStatus: TPanel + Left = 0 + Top = 730 + Width = 1200 + Height = 30 + Align = alBottom + BevelOuter = bvNone + TabOrder = 1 + object shpLed: TShape + Left = 12 + Top = 8 + Width = 14 + Height = 14 + Brush.Color = clGray + Shape = stCircle + end + object lblStatus: TLabel + Left = 36 + Top = 8 + Width = 3 + Height = 15 + end + object btnModo: TButton + Left = 1040 + Top = 3 + Width = 150 + Height = 24 + Anchors = [akTop, akRight] + Caption = 'Vai in plancia' + TabOrder = 0 + OnClick = btnModoClick + end + object btnNotte: TButton + Left = 934 + Top = 3 + Width = 100 + Height = 24 + Anchors = [akTop, akRight] + Caption = 'Notte' + TabOrder = 1 + OnClick = btnNotteClick + end + object btnAllarmi: TButton + Left = 470 + Top = 3 + Width = 228 + Height = 24 + Hint = 'Rimette in funzione gli allarmi sonori zittiti' + Anchors = [akTop, akRight] + Caption = 'Allarmi zittiti' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + TabStop = False + Visible = False + OnClick = btnAllarmiClick + end + object cboPlancia: TComboBox + Left = 704 + Top = 3 + Width = 224 + Height = 23 + Hint = 'Passa a un'#39'altra plancia della stessa cartella' + Style = csDropDownList + Anchors = [akTop, akRight] + ParentShowHint = False + ShowHint = True + TabOrder = 2 + TabStop = False + Visible = False + OnSelect = cboPlanciaSelect + end + end + object pnlPalette: TPanel + Left = 0 + Top = 44 + Width = 200 + Height = 686 + Align = alLeft + BevelOuter = bvNone + TabOrder = 2 + object lblPaletteTitle: TLabel + Left = 10 + Top = 6 + Width = 44 + Height = 15 + Caption = 'Palette' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [fsBold] + ParentFont = False + end + object gbImmagini: TGroupBox + Left = 6 + Top = 306 + Width = 188 + Height = 160 + Caption = 'Libreria immagini' + TabOrder = 0 + object lstImmagini: TListBox + Left = 10 + Top = 20 + Width = 168 + Height = 100 + ItemHeight = 15 + TabOrder = 0 + end + object btnImgAdd: TButton + Left = 10 + Top = 126 + Width = 80 + Height = 26 + Caption = 'Aggiungi...' + TabOrder = 1 + OnClick = btnImgAddClick + end + object btnImgDel: TButton + Left = 96 + Top = 126 + Width = 82 + Height = 26 + Caption = 'Rimuovi' + TabOrder = 2 + OnClick = btnImgDelClick + end + end + object gbGenerale: TGroupBox + Left = 0 + Top = 486 + Width = 200 + Height = 200 + Align = alBottom + Caption = 'Generale' + TabOrder = 1 + object lblPort: TLabel + Left = 10 + Top = 18 + Width = 55 + Height = 15 + Caption = 'Porta COM' + end + object lblBaud: TLabel + Left = 105 + Top = 18 + Width = 27 + Height = 15 + Caption = 'Baud' + end + object lblPoll: TLabel + Left = 10 + Top = 62 + Width = 65 + Height = 15 + Caption = 'Polling (ms)' + end + object lblPanelSize: TLabel + Left = 105 + Top = 62 + Width = 88 + Height = 15 + Caption = 'Pannello L x A' + end + object lblTitolo: TLabel + Left = 10 + Top = 106 + Width = 76 + Height = 15 + Caption = 'Titolo plancia' + end + object lblSfondo: TLabel + Left = 10 + Top = 150 + Width = 105 + Height = 15 + Caption = 'Immagine di sfondo' + end + object cboPort: TComboBox + Left = 10 + Top = 36 + Width = 88 + Height = 23 + TabOrder = 0 + Text = 'COM1' + OnChange = GeneralChanged + end + object cboBaud: TComboBox + Left = 105 + Top = 36 + Width = 85 + Height = 23 + TabOrder = 1 + Text = '9600' + OnChange = GeneralChanged + end + object edtPoll: TEdit + Left = 10 + Top = 80 + Width = 60 + Height = 23 + TabOrder = 2 + Text = '500' + OnChange = GeneralChanged + end + object edtPanelW: TEdit + Left = 105 + Top = 80 + Width = 40 + Height = 23 + TabOrder = 3 + Text = '1000' + OnChange = GeneralChanged + end + object edtPanelH: TEdit + Left = 150 + Top = 80 + Width = 40 + Height = 23 + TabOrder = 4 + Text = '640' + OnChange = GeneralChanged + end + object edtTitolo: TEdit + Left = 10 + Top = 124 + Width = 180 + Height = 23 + TabOrder = 5 + Text = 'Plancia' + OnChange = GeneralChanged + end + object cboSfondo: TComboBox + Left = 10 + Top = 168 + Width = 180 + Height = 23 + Style = csDropDownList + TabOrder = 6 + OnChange = BackgroundChanged + end + end + end + object pnlProps: TPanel + Left = 956 + Top = 44 + Width = 244 + Height = 686 + Align = alRight + BevelOuter = bvNone + TabOrder = 3 + object lblPropTitle: TLabel + Left = 12 + Top = 10 + Width = 158 + Height = 15 + Caption = 'Nessun elemento selezionato' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [fsBold] + ParentFont = False + end + object lblTipo: TLabel + Left = 12 + Top = 32 + Width = 25 + Height = 15 + Caption = 'Tipo' + end + object cboTipo: TComboBox + Left = 12 + Top = 50 + Width = 210 + Height = 23 + Style = csDropDownList + TabOrder = 16 + OnChange = KindChanged + end + object lblCap: TLabel + Left = 12 + Top = 82 + Width = 48 + Height = 15 + Caption = 'Etichetta' + end + object lblFontSize: TLabel + Left = 180 + Top = 82 + Width = 42 + Height = 15 + Caption = 'Testo px' + end + object lblSlave: TLabel + Left = 12 + Top = 130 + Width = 30 + Height = 15 + Caption = 'Slave' + end + object lblCanale: TLabel + Left = 122 + Top = 130 + Width = 39 + Height = 15 + Caption = 'Canale' + end + object lblPos: TLabel + Left = 12 + Top = 178 + Width = 78 + Height = 15 + Caption = 'Posizione X / Y' + end + object lblSize: TLabel + Left = 12 + Top = 226 + Width = 105 + Height = 15 + Caption = 'Larghezza / altezza' + end + object edtCaption: TEdit + Left = 12 + Top = 100 + Width = 162 + Height = 23 + TabOrder = 0 + OnChange = PropChanged + end + object edtFontSize: TEdit + Left = 180 + Top = 100 + Width = 42 + Height = 23 + TabOrder = 10 + OnChange = PropChanged + end + object edtSlave: TEdit + Left = 12 + Top = 148 + Width = 96 + Height = 23 + TabOrder = 1 + OnChange = PropChanged + end + object edtCanale: TEdit + Left = 122 + Top = 148 + Width = 100 + Height = 23 + TabOrder = 2 + OnChange = PropChanged + end + object edtLeft: TEdit + Left = 12 + Top = 196 + Width = 96 + Height = 23 + TabOrder = 3 + OnChange = PropChanged + end + object edtTop: TEdit + Left = 122 + Top = 196 + Width = 100 + Height = 23 + TabOrder = 4 + OnChange = PropChanged + end + object edtWidth: TEdit + Left = 12 + Top = 244 + Width = 96 + Height = 23 + TabOrder = 5 + OnChange = PropChanged + end + object edtHeight: TEdit + Left = 122 + Top = 244 + Width = 100 + Height = 23 + TabOrder = 6 + OnChange = PropChanged + end + object gbImgElem: TGroupBox + Left = 8 + Top = 276 + Width = 228 + Height = 212 + Caption = 'Aspetto' + TabOrder = 7 + object lblShape: TLabel + Left = 12 + Top = 20 + Width = 35 + Height = 15 + Caption = 'Forma' + end + object lblCapPos: TLabel + Left = 117 + Top = 20 + Width = 51 + Height = 15 + Caption = 'Etichetta' + end + object lblOnColor: TLabel + Left = 12 + Top = 66 + Width = 148 + Height = 15 + Caption = 'Colore acceso / a riposo' + end + object lblImgOff: TLabel + Left = 12 + Top = 112 + Width = 178 + Height = 15 + Caption = 'Immagine a riposo (vuoto = disegno)' + end + object lblImgOn: TLabel + Left = 12 + Top = 158 + Width = 90 + Height = 15 + Caption = 'Immagine attiva' + end + object cboShape: TComboBox + Left = 12 + Top = 38 + Width = 95 + Height = 23 + Style = csDropDownList + TabOrder = 0 + OnChange = PropChanged + end + object cboCapPos: TComboBox + Left = 117 + Top = 38 + Width = 95 + Height = 23 + Style = csDropDownList + TabOrder = 1 + OnChange = PropChanged + end + object edtOnColor: TEdit + Left = 12 + Top = 84 + Width = 95 + Height = 23 + TabOrder = 2 + OnChange = PropChanged + end + object edtOffColor: TEdit + Left = 117 + Top = 84 + Width = 95 + Height = 23 + TabOrder = 5 + OnChange = PropChanged + end + object cboImgOff: TComboBox + Left = 12 + Top = 130 + Width = 200 + Height = 23 + Style = csDropDownList + TabOrder = 3 + OnChange = PropChanged + end + object cboImgOn: TComboBox + Left = 12 + Top = 176 + Width = 200 + Height = 23 + Style = csDropDownList + TabOrder = 4 + OnChange = PropChanged + end + end + object gbGauge: TGroupBox + Left = 8 + Top = 276 + Width = 228 + Height = 272 + Caption = 'Scala del gauge' + TabOrder = 8 + object lblRaw: TLabel + Left = 12 + Top = 20 + Width = 133 + Height = 15 + Caption = 'Registro: minimo / massimo' + end + object lblEng: TLabel + Left = 12 + Top = 68 + Width = 128 + Height = 15 + Caption = 'Valore reale: min / max' + end + object lblUnits: TLabel + Left = 12 + Top = 116 + Width = 80 + Height = 15 + Caption = 'Unit'#224' di misura' + end + object lblWarn: TLabel + Left = 12 + Top = 164 + Width = 116 + Height = 15 + Caption = 'Allarme sotto / sopra' + end + object edtRawMin: TEdit + Left = 12 + Top = 38 + Width = 95 + Height = 23 + TabOrder = 0 + OnChange = PropChanged + end + object edtRawMax: TEdit + Left = 117 + Top = 38 + Width = 95 + Height = 23 + TabOrder = 1 + OnChange = PropChanged + end + object edtEngMin: TEdit + Left = 12 + Top = 86 + Width = 95 + Height = 23 + TabOrder = 2 + OnChange = PropChanged + end + object edtEngMax: TEdit + Left = 117 + Top = 86 + Width = 95 + Height = 23 + TabOrder = 3 + OnChange = PropChanged + end + object edtUnits: TEdit + Left = 12 + Top = 134 + Width = 95 + Height = 23 + TabOrder = 4 + OnChange = PropChanged + end + object edtWarnLo: TEdit + Left = 12 + Top = 182 + Width = 95 + Height = 23 + TabOrder = 5 + OnChange = PropChanged + end + object edtWarnHi: TEdit + Left = 117 + Top = 182 + Width = 95 + Height = 23 + TabOrder = 6 + OnChange = PropChanged + end + object lblDigits: TLabel + Left = 12 + Top = 212 + Width = 34 + Height = 15 + Caption = 'Cifre' + end + object lblDecimals: TLabel + Left = 117 + Top = 212 + Width = 51 + Height = 15 + Caption = 'Decimali' + end + object edtDigits: TEdit + Left = 12 + Top = 230 + Width = 95 + Height = 23 + TabOrder = 7 + OnChange = PropChanged + end + object edtDecimals: TEdit + Left = 117 + Top = 230 + Width = 95 + Height = 23 + TabOrder = 8 + OnChange = PropChanged + end + end + object gbTesto: TGroupBox + Left = 8 + Top = 276 + Width = 228 + Height = 170 + Caption = 'Testo' + TabOrder = 12 + object lblFontName: TLabel + Left = 12 + Top = 20 + Width = 148 + Height = 15 + Caption = 'Font (vuoto = quello del pannello)' + end + object lblSpacing: TLabel + Left = 12 + Top = 66 + Width = 128 + Height = 15 + Caption = 'Spaziatura fra le lettere' + end + object lblFrame: TLabel + Left = 12 + Top = 112 + Width = 128 + Height = 15 + Caption = 'Cornice e spessore' + end + object edtFontName: TEdit + Left = 12 + Top = 38 + Width = 200 + Height = 23 + TabOrder = 0 + OnChange = PropChanged + end + object edtSpacing: TEdit + Left = 12 + Top = 84 + Width = 95 + Height = 23 + TabOrder = 1 + OnChange = PropChanged + end + object cboFrame: TComboBox + Left = 12 + Top = 130 + Width = 140 + Height = 23 + Style = csDropDownList + TabOrder = 2 + OnChange = PropChanged + end + object edtFrameWidth: TEdit + Left = 160 + Top = 130 + Width = 52 + Height = 23 + TabOrder = 3 + OnChange = PropChanged + end + end + object gbRotary: TGroupBox + Left = 8 + Top = 276 + Width = 228 + Height = 205 + Caption = 'Selettore' + TabOrder = 11 + object lblPositions: TLabel + Left = 12 + Top = 20 + Width = 55 + Height = 15 + Caption = 'Posizioni' + end + object lblLegend: TLabel + Left = 12 + Top = 68 + Width = 145 + Height = 15 + Caption = 'Legenda sopra la manopola' + end + object cboPositions: TComboBox + Left = 12 + Top = 38 + Width = 95 + Height = 23 + Style = csDropDownList + TabOrder = 0 + OnChange = PropChanged + end + object edtLegend: TEdit + Left = 12 + Top = 86 + Width = 200 + Height = 23 + TabOrder = 1 + OnChange = PropChanged + end + object lblCanale2: TLabel + Left = 12 + Top = 116 + Width = 200 + Height = 15 + Caption = 'Canale lato destro' + end + object edtCanale2: TEdit + Left = 12 + Top = 134 + Width = 60 + Height = 23 + Hint = 'Bobina del lato destro; vuoto = canale + 1' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnChange = PropChanged + end + object chkMolla: TCheckBox + Left = 12 + Top = 166 + Width = 205 + Height = 32 + Hint = + 'Tiene la posizione finch'#233' lo tieni premuto e torna al centro al ' + + 'rilascio, come il comando di avviamento' + Caption = 'Ritorno a molla (torna al centro)' + ParentShowHint = False + ShowHint = True + TabOrder = 3 + WordWrap = True + OnClick = PropChanged + end + end + object gbSuono: TGroupBox + Left = 8 + Top = 492 + Width = 228 + Height = 74 + Caption = 'Allarme sonoro' + TabOrder = 12 + object chkAllarme: TCheckBox + Left = 12 + Top = 18 + Width = 205 + Height = 17 + Hint = 'Suona quando la spia si accende' + Caption = 'Suona quando si accende' + ParentShowHint = False + ShowHint = True + TabOrder = 0 + OnClick = PropChanged + end + object cboSuono: TComboBox + Left = 12 + Top = 40 + Width = 134 + Height = 23 + Hint = 'File nella cartella "suoni" accanto alla plancia' + Style = csDropDownList + ParentShowHint = False + ShowHint = True + TabOrder = 1 + OnChange = PropChanged + end + object btnSuoniRileggi: TButton + Left = 152 + Top = 40 + Width = 66 + Height = 23 + Hint = 'Rilegge la cartella dei suoni' + Caption = 'Aggiorna' + ParentShowHint = False + ShowHint = True + TabOrder = 2 + OnClick = btnSuoniRileggiClick + end + end + object btnElimina: TButton + Left = 12 + Top = 566 + Width = 210 + Height = 30 + Caption = 'Elimina elemento' + TabOrder = 9 + OnClick = btnEliminaClick + end + end + object scrCanvas: TScrollBox + Left = 200 + Top = 44 + Width = 756 + Height = 686 + Align = alClient + BevelInner = bvNone + BevelOuter = bvNone + BorderStyle = bsNone + Color = clAppWorkSpace + ParentColor = False + TabOrder = 4 + object pnlCanvas: TPanel + Left = 0 + Top = 0 + Width = 1000 + Height = 640 + BevelOuter = bvNone + Color = clBtnFace + ParentBackground = False + TabOrder = 0 + OnDragDrop = CanvasDragDrop + OnDragOver = CanvasDragOver + OnMouseDown = CanvasMouseDown + end + end + object tmrPoll: TTimer + Enabled = False + Interval = 500 + OnTimer = tmrPollTimer + Left = 640 + Top = 96 + end + object dlgApri: TOpenDialog + DefaultExt = 'xml' + Filter = + 'Configurazione plancia (*.xml)|*.xml|Tutti i file (*.*)|*.*' + Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Title = 'Apri configurazione' + Left = 704 + Top = 96 + end + object dlgSalva: TSaveDialog + DefaultExt = 'xml' + Filter = + 'Configurazione plancia (*.xml)|*.xml|Tutti i file (*.*)|*.*' + Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist, ofEnableSizing] + Title = 'Salva configurazione' + Left = 768 + Top = 96 + end + object dlgImmagine: TOpenPictureDialog + Options = [ofHideReadOnly, ofAllowMultiSelect, ofPathMustExist, ofFileMustExist, ofEnableSizing] + Title = 'Aggiungi immagini alla libreria' + Left = 832 + Top = 96 + end +end diff --git a/Console/uConsoleMain.pas b/Console/uConsoleMain.pas new file mode 100644 index 0000000..e1161c9 --- /dev/null +++ b/Console/uConsoleMain.pas @@ -0,0 +1,2930 @@ +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; + 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; + FGaugePlan: TList; + FSwitchPlan: TList; + 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; + /// Richieste delle bobine effettivamente in uso: partono raggruppate e si + /// dividono da sole quando un blocco non risponde. + FCoilReqs: TArray; + /// Quando ogni bobina e' stata comandata l'ultima volta. + FCoilWrites: TDictionary; + 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; + FRedo: TObjectList; + /// 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); + 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; 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); + 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.Create; + FLampPlan := TList.Create; + FGaugePlan := TList.Create; + FSwitchPlan := TList.Create; + FPlanciaFiles := TStringList.Create; + FAlarms := TAlarmPlayer.Create; + FCoilWrites := TDictionary.Create; + FUndo := TObjectList.Create(True); + FRedo := TObjectList.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); +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; + 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; + 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); +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; + Outcomes: TArray; + 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. diff --git a/Console/uImageLib.pas b/Console/uImageLib.pas new file mode 100644 index 0000000..c4bb08b --- /dev/null +++ b/Console/uImageLib.pas @@ -0,0 +1,259 @@ +unit uImageLib; + +{ + Libreria delle immagini usabili sulla plancia. + + Non e' una TImageList: quella impone a tutte le immagini la stessa + dimensione e serve per icone di toolbar. Qui invece le immagini hanno misure + qualsiasi (un LED da 32 px e un logo da 600 px stanno nella stessa libreria), + quindi si tiene una lista di TPicture indicizzata per nome. + + Nell'XML si salvano nome e percorso, non i pixel: le immagini restano file + sul disco, sostituibili senza toccare la configurazione. I percorsi sono + relativi alla cartella del file di configurazione quando possibile, cosi' + l'intera plancia si sposta copiando una cartella. +} + +interface + +uses + System.SysUtils, System.Classes, System.IOUtils, + System.Generics.Collections, + Vcl.Graphics, Vcl.Imaging.pngimage, Vcl.Imaging.jpeg; + +type + TImageEntry = class + public + Name: string; + /// Percorso come scritto nell'XML (di norma relativo alla sua cartella). + FileName: string; + Picture: TPicture; + /// Messaggio dell'eventuale errore di caricamento; '' se tutto bene. + Error: string; + destructor Destroy; override; + function Loaded: Boolean; + end; + + TImageLibrary = class + private + FItems: TObjectList; + FBaseDir: string; + procedure LoadEntry(AEntry: TImageEntry); + public + constructor Create; + destructor Destroy; override; + procedure Clear; + /// Cartella di riferimento per i percorsi relativi (quella dell'XML). + procedure SetBaseDir(const ADir: string); + function Find(const AName: string): TImageEntry; + function Picture(const AName: string): TPicture; + /// Aggiunge un file alla libreria; il nome e' reso univoco. + function AddFile(const AFileName: string): TImageEntry; + /// Usata dal caricamento XML: nome e percorso arrivano dal file. + function AddEntry(const AName, AFileName: string): TImageEntry; + procedure Delete(const AName: string); + /// Ricalcola i percorsi rispetto a una nuova cartella di riferimento, + /// senza spostare i file: serve al "Salva con nome" in un'altra cartella. + procedure Rebase(const ANewDir: string); + procedure ReloadAll; + procedure FillNames(AStrings: TStrings; AIncludeEmpty: Boolean); + function AbsolutePath(const AFileName: string): string; + function Count: Integer; + function Item(AIndex: Integer): TImageEntry; + property BaseDir: string read FBaseDir; + end; + +implementation + +{ TImageEntry } + +destructor TImageEntry.Destroy; +begin + Picture.Free; + inherited; +end; + +function TImageEntry.Loaded: Boolean; +begin + Result := (Picture <> nil) and (Picture.Graphic <> nil) and + not Picture.Graphic.Empty; +end; + +{ TImageLibrary } + +constructor TImageLibrary.Create; +begin + inherited Create; + FItems := TObjectList.Create(True); +end; + +destructor TImageLibrary.Destroy; +begin + FItems.Free; + inherited; +end; + +procedure TImageLibrary.Clear; +begin + FItems.Clear; +end; + +function TImageLibrary.Count: Integer; +begin + Result := FItems.Count; +end; + +function TImageLibrary.Item(AIndex: Integer): TImageEntry; +begin + Result := FItems[AIndex]; +end; + +procedure TImageLibrary.SetBaseDir(const ADir: string); +begin + FBaseDir := IncludeTrailingPathDelimiter(ADir); + ReloadAll; +end; + +function TImageLibrary.AbsolutePath(const AFileName: string): string; +begin + if AFileName = '' then + Exit(''); + if TPath.IsPathRooted(AFileName) then + Exit(AFileName); + Result := FBaseDir + AFileName; +end; + +procedure TImageLibrary.LoadEntry(AEntry: TImageEntry); +var + Full: string; +begin + FreeAndNil(AEntry.Picture); + AEntry.Error := ''; + Full := AbsolutePath(AEntry.FileName); + if not FileExists(Full) then + begin + AEntry.Error := 'file non trovato: ' + Full; + Exit; + end; + AEntry.Picture := TPicture.Create; + try + AEntry.Picture.LoadFromFile(Full); + except + on E: Exception do + begin + FreeAndNil(AEntry.Picture); + AEntry.Error := E.Message; + end; + end; +end; + +procedure TImageLibrary.ReloadAll; +var + E: TImageEntry; +begin + for E in FItems do + LoadEntry(E); +end; + +function TImageLibrary.Find(const AName: string): TImageEntry; +var + E: TImageEntry; +begin + if AName <> '' then + for E in FItems do + if SameText(E.Name, AName) then + Exit(E); + Result := nil; +end; + +function TImageLibrary.Picture(const AName: string): TPicture; +var + E: TImageEntry; +begin + E := Find(AName); + if (E <> nil) and E.Loaded then + Result := E.Picture + else + Result := nil; +end; + +function TImageLibrary.AddEntry(const AName, AFileName: string): TImageEntry; +begin + Result := TImageEntry.Create; + Result.Name := AName; + Result.FileName := AFileName; + FItems.Add(Result); + LoadEntry(Result); +end; + +function TImageLibrary.AddFile(const AFileName: string): TImageEntry; +var + Base, Nome, Rel: string; + N: Integer; +begin + Base := ChangeFileExt(ExtractFileName(AFileName), ''); + Nome := Base; + N := 1; + while Find(Nome) <> nil do + begin + Inc(N); + Nome := Format('%s %d', [Base, N]); + end; + + // Percorso relativo se il file sta sotto la cartella della configurazione: + // cosi' la plancia resta trasportabile copiando la cartella. + Rel := AFileName; + if (FBaseDir <> '') and AFileName.StartsWith(FBaseDir, True) then + Rel := Copy(AFileName, Length(FBaseDir) + 1, MaxInt); + + Result := AddEntry(Nome, Rel); +end; + +procedure TImageLibrary.Delete(const AName: string); +var + E: TImageEntry; +begin + E := Find(AName); + if E <> nil then + FItems.Remove(E); +end; + +procedure TImageLibrary.Rebase(const ANewDir: string); +var + E: TImageEntry; + Full, NewBase: string; +begin + NewBase := IncludeTrailingPathDelimiter(ANewDir); + if SameText(NewBase, FBaseDir) then + Exit; + for E in FItems do + begin + // AbsolutePath usa ancora la vecchia base: e' il punto della manovra. + Full := AbsolutePath(E.FileName); + if Full = '' then + Continue; + if Full.StartsWith(NewBase, True) then + E.FileName := Copy(Full, Length(NewBase) + 1, MaxInt) + else + E.FileName := Full; + end; + FBaseDir := NewBase; +end; + +procedure TImageLibrary.FillNames(AStrings: TStrings; AIncludeEmpty: Boolean); +var + E: TImageEntry; +begin + AStrings.BeginUpdate; + try + AStrings.Clear; + if AIncludeEmpty then + AStrings.Add(''); + for E in FItems do + AStrings.Add(E.Name); + finally + AStrings.EndUpdate; + end; +end; + +end. diff --git a/Console/uModbusWorker.pas b/Console/uModbusWorker.pas new file mode 100644 index 0000000..0cef7be --- /dev/null +++ b/Console/uModbusWorker.pas @@ -0,0 +1,606 @@ +unit uModbusWorker; + +{ + Il bus Modbus in un thread suo, cosi' il thread principale non si ferma mai: + una richiesta che va in timeout costa mezzo secondo al thread del bus, non + alla finestra, che resta trascinabile e ridisegnabile. + + Un thread solo, non uno per le letture e uno per le scritture. Su RS485 il + filo e' uno: due richieste insieme si sovrappongono, e le risposte arrivano + mescolate. Chi comanda deve comunque aspettare che la richiesta in corso + finisca, quindi un secondo thread aggiungerebbe un lucchetto attorno alla + porta senza far guadagnare niente. La reattivita' dei comandi si ottiene + invece dando loro la precedenza: la coda delle scritture viene svuotata + prima di ogni lettura, cosi' un pulsante premuto parte al massimo dopo la + richiesta in corso. + + Chi usa questa classe non chiama mai il bus: mette le scritture in coda e + ritira le letture quando gli fa comodo (TakeReadings). Nessuna callback + cross-thread: il form legge lo stato con il suo timer, e il thread non + tocca ne' controlli ne' elementi. +} + +interface + +uses + Winapi.Windows, System.SysUtils, System.Classes, System.SyncObjs, + System.Generics.Collections, + uModbusRTU; + +type + /// Che funzione Modbus usa una richiesta del piano. + TRequestKind = (rqCoils, rqInputs, rqRegisters); + + /// Una richiesta del piano di polling: copre canali contigui di uno slave. + TPollRequest = record + Kind: TRequestKind; + Slave: Integer; + First: Integer; + Count: Integer; + end; + + /// Esito di una richiesta, con i dati se e' andata bene. + TPollReading = record + Request: TPollRequest; + /// Istante in cui la richiesta e' partita sul filo. Serve a capire se una + /// risposta e' piu' vecchia di un comando appena dato. + Sent: UInt64; + Ok: Boolean; + Error: string; + Bits: TArray; + Regs: TArray; + end; + + TWriteCommand = record + Slave: Integer; + Channel: Integer; + Value: Boolean; + /// Etichetta dell'elemento, per i messaggi in barra di stato. + Caption: string; + end; + + TWriteOutcome = record + Caption: string; + Value: Boolean; + Ok: Boolean; + Error: string; + end; + + /// Quanto uno slave sta rispondendo male, per non inseguirlo a ogni giro. + TSlaveState = record + Failures: Integer; + NextTry: UInt64; + end; + + TModbusWorker = class(TThread) + private + FPort: string; + FBaud: Integer; + FTimeoutMs: Integer; + FPollMs: Integer; + FLock: TCriticalSection; + /// Sveglia il thread: nuova scrittura, piano cambiato, o chiusura. + FWake: TEvent; + // Tutto quello che segue si tocca solo con FLock preso. + FPlan: TArray; + /// Piano appena cambiato: gli slave vanno riprovati subito, perche' fra i + /// canali nuovi puo' esserci un modulo appena montato. + FPlanFresh: Boolean; + FWrites: TQueue; + FReadings: TArray; + FReadingsFresh: Boolean; + FOutcomes: TList; + FConnected: Boolean; + FStatus: string; + FStatusOk: Boolean; + /// Stato di ogni RICHIESTA del piano: quante volte di fila e' fallita e + /// quando riprovarla. Per richiesta e non per slave: sullo stesso modulo + /// le bobine possono rispondere benissimo mentre gli ingressi, che non + /// ha, danno errore, e mettere in pausa tutto il modulo per colpa loro + /// lascerebbe la plancia cieca su quello che invece si legge. + FBackoff: TDictionary; + /// A chi tocca, fra le richieste rimandate, il tentativo di questo giro. + FRetryTurn: Integer; + procedure SetState(AConnected: Boolean; const AMsg: string; AOk: Boolean); + function CurrentPlan: TArray; + function TakeWrite(out ACmd: TWriteCommand): Boolean; + procedure AddOutcome(const ACmd: TWriteCommand; AOk: Boolean; + const AError: string); + procedure PublishReadings(const AReadings: TArray); + /// Svuota la coda dei comandi. False se la porta e' caduta. + function FlushWrites(AModbus: TModbusRTU): Boolean; + function ReadOne(AModbus: TModbusRTU; + const ARequest: TPollRequest): TPollReading; + /// True se lo slave va interrogato adesso; ASecondsLeft dice quanto manca + /// al prossimo tentativo quando e' in pausa. + function RequestDue(const ARequest: TPollRequest; + out ASecondsLeft: Integer): Boolean; + /// Vero se la richiesta non ha ancora sbagliato: quelle che sbagliano si + /// rimandano in fondo al giro. + function FirstTry(const ARequest: TPollRequest): Boolean; + procedure NoteRequest(const ARequest: TPollRequest; AOk: Boolean); + protected + procedure Execute; override; + public + constructor Create(const APort: string; ABaud, ATimeoutMs, + APollMs: Integer); + destructor Destroy; override; + /// Sostituisce il piano di polling; il giro dopo usa questo. + procedure SetPlan(const APlan: TArray); + /// Mette un comando in coda e torna subito. + procedure EnqueueWrite(ASlave, AChannel: Integer; AValue: Boolean; + const ACaption: string); + /// Letture dell'ultimo giro completo, una volta sola: False se non ce ne + /// sono di nuove da quando sono state ritirate. + function TakeReadings(out AReadings: TArray): Boolean; + /// Esiti delle scritture eseguite da quando sono stati ritirati. + function TakeOutcomes: TArray; + function IsBusConnected: Boolean; + procedure CurrentStatus(out AMsg: string; out AOk: Boolean); + /// Chiede la chiusura e sveglia il thread; non attende. + procedure Stop; + end; + +implementation + +const + /// Porta assente o occupata: si riprova, senza martellare. + RETRY_MS = 2000; + /// Errori di fila dopo i quali uno slave e' considerato assente. Tre, non + /// uno: un disturbo sulla linea non deve mettere in pausa un modulo che c'e'. + SLAVE_TOLERANCE = 3; + /// Prima pausa di una richiesta che non risponde. Una plancia puo' essere disegnata + /// prima che i moduli siano montati: le sue richieste non devono rubare mezzo + /// secondo di timeout a ogni giro a quelle dei moduli che ci sono. Appena il + /// modulo viene collegato riparte da solo, entro questa pausa. + SLAVE_BACKOFF_MS = 5000; + /// La pausa si allunga a ogni tentativo andato a vuoto, fino a questo + /// massimo: un modulo che non c'e' costa un timeout al minuto invece di uno + /// ogni cinque secondi, e il giro resta veloce per i moduli che ci sono. + MAX_BACKOFF_MS = 60000; + +{ TModbusWorker } + +constructor TModbusWorker.Create(const APort: string; ABaud, ATimeoutMs, + APollMs: Integer); +begin + FPort := APort; + FBaud := ABaud; + FTimeoutMs := ATimeoutMs; + FPollMs := APollMs; + if FPollMs < 20 then + FPollMs := 20; + FLock := TCriticalSection.Create; + FWake := TEvent.Create(nil, False, False, ''); + FWrites := TQueue.Create; + FOutcomes := TList.Create; + FBackoff := TDictionary.Create; + FStatus := 'Apertura porta...'; + FStatusOk := True; + // Il thread parte solo quando tutto e' pronto. + inherited Create(False); +end; + +destructor TModbusWorker.Destroy; +begin + // Prima si sveglia, poi si aspetta: l'attesa dura al massimo quanto la + // richiesta in corso. + Stop; + inherited; + FBackoff.Free; + FOutcomes.Free; + FWrites.Free; + FWake.Free; + FLock.Free; +end; + +procedure TModbusWorker.Stop; +begin + Terminate; + FWake.SetEvent; +end; + +procedure TModbusWorker.SetState(AConnected: Boolean; const AMsg: string; + AOk: Boolean); +begin + FLock.Enter; + try + FConnected := AConnected; + FStatus := AMsg; + FStatusOk := AOk; + finally + FLock.Leave; + end; +end; + +function TModbusWorker.IsBusConnected: Boolean; +begin + FLock.Enter; + try + Result := FConnected; + finally + FLock.Leave; + end; +end; + +procedure TModbusWorker.CurrentStatus(out AMsg: string; out AOk: Boolean); +begin + FLock.Enter; + try + AMsg := FStatus; + AOk := FStatusOk; + finally + FLock.Leave; + end; +end; + +procedure TModbusWorker.SetPlan(const APlan: TArray); +begin + FLock.Enter; + try + FPlan := Copy(APlan); + FPlanFresh := True; + finally + FLock.Leave; + end; + FWake.SetEvent; +end; + +function TModbusWorker.CurrentPlan: TArray; +begin + FLock.Enter; + try + Result := Copy(FPlan); + if FPlanFresh then + begin + FPlanFresh := False; + // Piano nuovo: nessuno slave resta in pausa per colpa del piano vecchio. + FBackoff.Clear; + end; + finally + FLock.Leave; + end; +end; + +procedure TModbusWorker.EnqueueWrite(ASlave, AChannel: Integer; + AValue: Boolean; const ACaption: string); +var + Cmd: TWriteCommand; +begin + Cmd.Slave := ASlave; + Cmd.Channel := AChannel; + Cmd.Value := AValue; + Cmd.Caption := ACaption; + FLock.Enter; + try + FWrites.Enqueue(Cmd); + finally + FLock.Leave; + end; + // Non aspetta il prossimo giro di polling: il comando parte appena la + // richiesta in corso e' finita. + FWake.SetEvent; +end; + +function TModbusWorker.TakeWrite(out ACmd: TWriteCommand): Boolean; +begin + FLock.Enter; + try + Result := FWrites.Count > 0; + if Result then + ACmd := FWrites.Dequeue; + finally + FLock.Leave; + end; +end; + +procedure TModbusWorker.AddOutcome(const ACmd: TWriteCommand; AOk: Boolean; + const AError: string); +var + O: TWriteOutcome; +begin + O.Caption := ACmd.Caption; + O.Value := ACmd.Value; + O.Ok := AOk; + O.Error := AError; + FLock.Enter; + try + // Se nessuno li ritira (finestra occupata) non devono crescere all'infinito. + while FOutcomes.Count > 200 do + FOutcomes.Delete(0); + FOutcomes.Add(O); + finally + FLock.Leave; + end; +end; + +function TModbusWorker.TakeOutcomes: TArray; +begin + FLock.Enter; + try + Result := FOutcomes.ToArray; + FOutcomes.Clear; + finally + FLock.Leave; + end; +end; + +procedure TModbusWorker.PublishReadings(const AReadings: TArray); +begin + FLock.Enter; + try + FReadings := AReadings; + FReadingsFresh := True; + finally + FLock.Leave; + end; +end; + +function TModbusWorker.TakeReadings(out AReadings: TArray): Boolean; +begin + FLock.Enter; + try + Result := FReadingsFresh; + if Result then + begin + AReadings := FReadings; + FReadingsFresh := False; + end; + finally + FLock.Leave; + end; +end; + +function TModbusWorker.FlushWrites(AModbus: TModbusRTU): Boolean; +var + Cmd: TWriteCommand; +begin + Result := True; + while not Terminated and TakeWrite(Cmd) do + begin + try + AModbus.WriteSingleCoil(Cmd.Slave, Cmd.Channel, Cmd.Value); + AddOutcome(Cmd, True, ''); + except + on E: Exception do + begin + AddOutcome(Cmd, False, E.Message); + // La porta non c'e' piu' (chiavetta staccata): si riapre da capo. + if not AModbus.IsConnected then + Exit(False); + end; + end; + end; +end; + +/// Chiave di una richiesta nel registro delle pause. +function RequestKey(const ARequest: TPollRequest): string; +begin + Result := Format('%d:%d:%d:%d', [ARequest.Slave, Ord(ARequest.Kind), + ARequest.First, ARequest.Count]); +end; + +function TModbusWorker.RequestDue(const ARequest: TPollRequest; + out ASecondsLeft: Integer): Boolean; +var + S: TSlaveState; + Now: UInt64; +begin + ASecondsLeft := 0; + if not FBackoff.TryGetValue(RequestKey(ARequest), S) then + Exit(True); + if S.Failures < SLAVE_TOLERANCE then + Exit(True); + Now := GetTickCount64; + Result := Now >= S.NextTry; + if not Result then + ASecondsLeft := Integer((S.NextTry - Now + 999) div 1000); +end; + +function TModbusWorker.FirstTry(const ARequest: TPollRequest): Boolean; +var + S: TSlaveState; +begin + Result := not FBackoff.TryGetValue(RequestKey(ARequest), S) or + (S.Failures = 0); +end; + +procedure TModbusWorker.NoteRequest(const ARequest: TPollRequest; + AOk: Boolean); +var + S: TSlaveState; + Attesa: Integer; +begin + if not FBackoff.TryGetValue(RequestKey(ARequest), S) then + begin + S.Failures := 0; + S.NextTry := 0; + end; + if AOk then + begin + // Ha risposto: torna una richiesta normale, fatta a ogni giro. + S.Failures := 0; + S.NextTry := 0; + end + else + begin + Inc(S.Failures); + if S.Failures >= SLAVE_TOLERANCE then + begin + Attesa := SLAVE_BACKOFF_MS * (S.Failures - SLAVE_TOLERANCE + 1); + if Attesa > MAX_BACKOFF_MS then + Attesa := MAX_BACKOFF_MS; + S.NextTry := GetTickCount64 + UInt64(Attesa); + end; + end; + FBackoff.AddOrSetValue(RequestKey(ARequest), S); +end; + +function TModbusWorker.ReadOne(AModbus: TModbusRTU; + const ARequest: TPollRequest): TPollReading; +begin + Result := Default(TPollReading); + Result.Request := ARequest; + Result.Sent := GetTickCount64; + try + case ARequest.Kind of + rqCoils: + Result.Bits := AModbus.ReadCoils(ARequest.Slave, ARequest.First, + ARequest.Count); + rqInputs: + Result.Bits := AModbus.ReadDiscreteInputs(ARequest.Slave, + ARequest.First, ARequest.Count); + rqRegisters: + Result.Regs := AModbus.ReadHoldingRegisters(ARequest.Slave, + ARequest.First, ARequest.Count); + end; + Result.Ok := True; + except + on E: Exception do + begin + Result.Ok := False; + Result.Error := E.Message; + end; + end; +end; + +procedure TModbusWorker.Execute; +var + Modbus: TModbusRTU; + Plan: TArray; + Rimandate: TArray; + Readings: TArray; + Reading: TPollReading; + I, J, Wait, Left: Integer; + Started: UInt64; +begin + NameThreadForDebugging('ModbusBus'); + Modbus := nil; + try + while not Terminated do + begin + // 1. porta aperta? altrimenti si riprova ogni RETRY_MS, senza rumore + // sul bus e senza bloccare nessuno. + if Modbus = nil then + begin + try + Modbus := TModbusRTU.Create(FPort, FBaud, FTimeoutMs); + Modbus.Connect; + // Porta riaperta: si riparte interrogando tutti, anche quelli che + // prima erano muti. + FBackoff.Clear; + SetState(True, 'Connesso.', True); + except + on E: Exception do + begin + FreeAndNil(Modbus); + SetState(False, 'Connessione fallita: ' + E.Message, False); + FWake.WaitFor(RETRY_MS); + Continue; + end; + end; + end; + + Started := GetTickCount64; + + // 2. i comandi passano avanti alle letture. + if not FlushWrites(Modbus) then + begin + FreeAndNil(Modbus); + SetState(False, 'Porta caduta, riapertura...', False); + Continue; + end; + + // 3. un giro di letture, una richiesta per gruppo. Fra una richiesta e + // l'altra si guarda di nuovo la coda dei comandi: un pulsante premuto + // non deve aspettare la fine del giro. + Plan := CurrentPlan; + SetLength(Readings, 0); + SetLength(Rimandate, 0); + for I := 0 to High(Plan) do + begin + if Terminated then + Break; + if not FlushWrites(Modbus) then + Break; + if Modbus = nil then + Break; + // Una richiesta che non risponde da un po' si interroga di rado: una + // plancia disegnata prima dei moduli resta comunque scorrevole, e + // quello che c'e' viene letto alla velocita' giusta. + if not RequestDue(Plan[I], Left) then + begin + Reading := Default(TPollReading); + Reading.Request := Plan[I]; + Reading.Sent := GetTickCount64; + Reading.Ok := False; + Reading.Error := Format('non risponde, riprovo fra %d s', [Left]); + Readings := Readings + [Reading]; + Continue; + end; + // Le richieste gia' in difficolta' si rimandano in fondo al giro, e + // se ne riprova UNA SOLA per giro: ogni tentativo a vuoto costa un + // timeout, e otto timeout davanti alle spie voleva dire vedere un + // allarme quattro secondi dopo che era arrivato. + if not FirstTry(Plan[I]) then + begin + Rimandate := Rimandate + [Plan[I]]; + Continue; + end; + Reading := ReadOne(Modbus, Plan[I]); + NoteRequest(Plan[I], Reading.Ok); + Readings := Readings + [Reading]; + end; + + // Le rimandate: una per giro, a turno, cosi' un modulo che torna viene + // ritrovato senza rallentare gli altri. + if (Length(Rimandate) > 0) and not Terminated and (Modbus <> nil) then + begin + if FRetryTurn >= Length(Rimandate) then + FRetryTurn := 0; + Reading := ReadOne(Modbus, Rimandate[FRetryTurn]); + NoteRequest(Rimandate[FRetryTurn], Reading.Ok); + Readings := Readings + [Reading]; + Inc(FRetryTurn); + // Le altre rimandate: si dice che non sono state fatte adesso, senza + // spacciarle per fallite. + for J := 0 to High(Rimandate) do + if J <> FRetryTurn - 1 then + begin + Reading := Default(TPollReading); + Reading.Request := Rimandate[J]; + Reading.Sent := GetTickCount64; + Reading.Ok := False; + Reading.Error := 'non risponde, riprovata a turno'; + Readings := Readings + [Reading]; + end; + end; + if Length(Readings) > 0 then + PublishReadings(Readings); + if Terminated then + Break; + if (Modbus <> nil) and not Modbus.IsConnected then + begin + FreeAndNil(Modbus); + SetState(False, 'Porta caduta, riapertura...', False); + Continue; + end; + + // 4. riposo fino al prossimo giro, interrompibile da un comando o + // dalla chiusura. + Wait := FPollMs - Integer(GetTickCount64 - Started); + if Wait < 1 then + Wait := 1; + FWake.WaitFor(Wait); + end; + finally + if Modbus <> nil then + begin + Modbus.Disconnect; + Modbus.Free; + end; + SetState(False, 'Bus chiuso.', True); + end; +end; + +end. diff --git a/Console/uPlanciaConfig.pas b/Console/uPlanciaConfig.pas new file mode 100644 index 0000000..efe576c --- /dev/null +++ b/Console/uPlanciaConfig.pas @@ -0,0 +1,687 @@ +unit uPlanciaConfig; + +{ + Configurazione della plancia e sua persistenza su XML. + + Il DOM usato e' OmniXML (Pascal puro) e non MSXML: evita la dipendenza da + COM, che su un PC di bordo puo' essere un problema in meno. + + I numeri con virgola sono letti e scritti sempre con il punto decimale + (FormatSettings invariante), altrimenti un file salvato su una macchina + italiana non si riaprirebbe su una inglese e viceversa. +} + +interface + +uses + Winapi.Windows, + System.SysUtils, System.Classes, System.Variants, + System.Generics.Collections, + Vcl.Graphics, + Xml.XMLIntf, Xml.XMLDoc, Xml.xmldom, Xml.omnixmldom, + uGauge, uImageLib, uPlanciaElements; + +type + EPlanciaConfig = class(Exception); + + /// Fotografia di quello che si cambia disegnando: elementi e impostazioni + /// del pannello. Serve ad annulla/ripeti. La libreria immagini non c'e': + /// le immagini sono file sul disco, e una rimossa non torna con un annulla + /// (gli elementi che la usavano ritrovano il nome, non il file). + TPlanciaSnapshot = class + private + FElements: TObjectList; + public + Port: string; + Baud: Integer; + TimeoutMs: Integer; + PollMs: Integer; + Title: string; + PanelWidth: Integer; + PanelHeight: Integer; + Background: string; + Ink: TColor; + /// Indice dell'elemento selezionato al momento della foto; -1 nessuno. + Selected: Integer; + constructor Create; + destructor Destroy; override; + end; + + TPlanciaConfig = class + private + FElements: TObjectList; + FImages: TImageLibrary; + public + Port: string; + Baud: Integer; + TimeoutMs: Integer; + PollMs: Integer; + Title: string; + PanelWidth: Integer; + PanelHeight: Integer; + /// Nome dell'immagine di sfondo nella libreria; '' = nessuno sfondo. + Background: string; + /// Colore delle scritte serigrafate; clNone = nero. Le plance a fondo + /// scuro lo mettono chiaro, altrimenti le etichette sparirebbero. + Ink: TColor; + /// Cartella del file XML: i suoi sottoalberi (immagini, suoni) viaggiano + /// con la plancia quando si copia la cartella. + BaseDir: string; + /// Cartella dei suoni di allarme, dentro quella dell'XML. + function SoundsDir: string; + constructor Create; + destructor Destroy; override; + procedure Clear; + procedure LoadFromFile(const AFileName: string); + procedure SaveToFile(const AFileName: string); + /// Copia profonda dello stato attuale; la libera il chiamante. + function TakeSnapshot: TPlanciaSnapshot; + /// Riporta elementi e impostazioni a quelli della foto. Le definizioni + /// vengono ricreate: i controlli che puntavano alle vecchie vanno rifatti. + procedure RestoreSnapshot(ASnapshot: TPlanciaSnapshot); + property Elements: TObjectList read FElements; + property Images: TImageLibrary read FImages; + end; + +/// Percorso del file di configurazione predefinito, accanto all'eseguibile. +function DefaultConfigFile: string; +/// Percorso dell'ultima plancia usata, ricordato accanto all'eseguibile, '' +/// se non c'e' o il file non esiste piu'. Serve a riaprire da sola la plancia +/// su cui si stava lavorando. +function LoadLastFile: string; +procedure SaveLastFile(const AFileName: string); +/// Legge solo il titolo di una plancia, senza caricare immagini ed elementi. +/// False se il file non si apre o non e' una configurazione di plancia: serve +/// a elencare le plance di una cartella scartando gli altri XML. +function ReadPanelTitle(const AFileName: string; out ATitle: string): Boolean; +/// Colori in formato #RRGGBB, come sul web: e' quello che ci si aspetta +/// scrivendo a mano l'XML, non il $00BBGGRR di Windows. +function HtmlToColor(const AValue: string; ADefault: TColor): TColor; +function ColorToHtml(AColor: TColor): string; + +implementation + +var + FS: TFormatSettings; + +function DefaultConfigFile: string; +begin + Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + + 'plancia.xml'; +end; + +/// Il promemoria sta accanto all'eseguibile, non nel registro: la plancia si +/// trasporta copiando una cartella, e con lei quello che stava aperto. +function LastFileStore: string; +begin + Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + + 'plancia-ultima.txt'; +end; + +function LoadLastFile: string; +var + Lines: TStringList; +begin + Result := ''; + if not FileExists(LastFileStore) then + Exit; + Lines := TStringList.Create; + try + try + Lines.LoadFromFile(LastFileStore, TEncoding.UTF8); + if Lines.Count > 0 then + Result := Trim(Lines[0]); + except + // Promemoria illeggibile: si riparte dal file predefinito. + Result := ''; + end; + finally + Lines.Free; + end; + // Un file cancellato o su una chiavetta scollegata non vale piu'. + if (Result <> '') and not FileExists(Result) then + Result := ''; +end; + +procedure SaveLastFile(const AFileName: string); +var + Lines: TStringList; +begin + Lines := TStringList.Create; + try + Lines.Add(ExpandFileName(AFileName)); + try + Lines.SaveToFile(LastFileStore, TEncoding.UTF8); + except + // Cartella di sola lettura: si perde solo la comodita' di riaprire. + end; + finally + Lines.Free; + end; +end; + +function AttrStr(ANode: IXMLNode; const AName, ADefault: string): string; +begin + if (ANode <> nil) and ANode.HasAttribute(AName) then + Result := VarToStr(ANode.Attributes[AName]) + else + Result := ADefault; +end; + +/// Togli la sola lettura, se c'e'. +procedure ClearReadOnly(const AFileName: string); +begin + if FileExists(AFileName) then + SetFileAttributes(PChar(AFileName), FILE_ATTRIBUTE_NORMAL); +end; + +/// Cancella davvero, anche un file in sola lettura. +procedure ForceDelete(const AFileName: string); +begin + if not FileExists(AFileName) then + Exit; + ClearReadOnly(AFileName); + DeleteFile(AFileName); +end; + +function ReadPanelTitle(const AFileName: string; out ATitle: string): Boolean; +var + Doc: IXMLDocument; + Root: IXMLNode; +begin + ATitle := ''; + try + Doc := TXMLDocument.Create(nil); + Doc.LoadFromFile(AFileName); + Doc.Active := True; + Root := Doc.DocumentElement; + if (Root = nil) or not SameText(Root.NodeName, 'plancia') then + Exit(False); + ATitle := AttrStr(Root.ChildNodes.FindNode('panel'), 'title', ''); + Result := True; + except + Result := False; + end; +end; + +function AttrInt(ANode: IXMLNode; const AName: string; + ADefault: Integer): Integer; +begin + Result := StrToIntDef(AttrStr(ANode, AName, ''), ADefault); +end; + +/// Tollera le forme che viene naturale scrivere a mano in un XML. +function AttrBool(ANode: IXMLNode; const AName: string; + ADefault: Boolean): Boolean; +var + S: string; +begin + S := LowerCase(Trim(AttrStr(ANode, AName, ''))); + if S = '' then + Exit(ADefault); + Result := (S = 'true') or (S = '1') or (S = 'yes') or (S = 'si'); +end; + +function AttrFloat(ANode: IXMLNode; const AName: string; + const ADefault: Double): Double; +var + S: string; +begin + S := AttrStr(ANode, AName, ''); + if S = '' then + Exit(ADefault); + // Tollera anche i file scritti a mano con la virgola decimale. + S := StringReplace(S, ',', '.', [rfReplaceAll]); + Result := StrToFloatDef(S, ADefault, FS); +end; + +function FloatAttr(const AValue: Double): string; +begin + Result := FloatToStr(AValue, FS); +end; + +function HtmlToColor(const AValue: string; ADefault: TColor): TColor; +var + S: string; + V: Integer; +begin + S := Trim(AValue); + if S.StartsWith('#') then + Delete(S, 1, 1); + if (Length(S) <> 6) or not TryStrToInt('$' + S, V) then + Exit(ADefault); + // Da RRGGBB a $00BBGGRR. + Result := TColor(((V and $FF) shl 16) or (V and $FF00) or + ((V shr 16) and $FF)); +end; + +function ColorToHtml(AColor: TColor): string; +var + V: Integer; +begin + V := ColorToRGB(AColor); + Result := Format('#%.2x%.2x%.2x', + [V and $FF, (V shr 8) and $FF, (V shr 16) and $FF]); +end; + +{ TPlanciaSnapshot } + +constructor TPlanciaSnapshot.Create; +begin + inherited Create; + FElements := TObjectList.Create(True); + Selected := -1; +end; + +destructor TPlanciaSnapshot.Destroy; +begin + FElements.Free; + inherited; +end; + +function CloneDef(ASource: TElementDef): TElementDef; +begin + Result := TElementDef.Create(ASource.Kind); + Result.AssignFrom(ASource); +end; + +{ TPlanciaConfig } + +function TPlanciaConfig.SoundsDir: string; +begin + Result := IncludeTrailingPathDelimiter(BaseDir) + 'suoni'; +end; + +function TPlanciaConfig.TakeSnapshot: TPlanciaSnapshot; +var + D: TElementDef; +begin + Result := TPlanciaSnapshot.Create; + Result.Port := Port; + Result.Baud := Baud; + Result.TimeoutMs := TimeoutMs; + Result.PollMs := PollMs; + Result.Title := Title; + Result.PanelWidth := PanelWidth; + Result.PanelHeight := PanelHeight; + Result.Background := Background; + Result.Ink := Ink; + for D in FElements do + Result.FElements.Add(CloneDef(D)); +end; + +procedure TPlanciaConfig.RestoreSnapshot(ASnapshot: TPlanciaSnapshot); +var + D: TElementDef; +begin + Port := ASnapshot.Port; + Baud := ASnapshot.Baud; + TimeoutMs := ASnapshot.TimeoutMs; + PollMs := ASnapshot.PollMs; + Title := ASnapshot.Title; + PanelWidth := ASnapshot.PanelWidth; + PanelHeight := ASnapshot.PanelHeight; + Background := ASnapshot.Background; + Ink := ASnapshot.Ink; + FElements.Clear; + for D in ASnapshot.FElements do + FElements.Add(CloneDef(D)); +end; + +constructor TPlanciaConfig.Create; +begin + inherited Create; + FElements := TObjectList.Create(True); + FImages := TImageLibrary.Create; + Clear; +end; + +destructor TPlanciaConfig.Destroy; +begin + FImages.Free; + FElements.Free; + inherited; +end; + +procedure TPlanciaConfig.Clear; +begin + FElements.Clear; + FImages.Clear; + Background := ''; + BaseDir := ExtractFilePath(ParamStr(0)); + Ink := clNone; + Port := 'COM1'; + Baud := 9600; + TimeoutMs := 500; + PollMs := 500; + Title := 'Plancia'; + PanelWidth := 1000; + PanelHeight := 640; +end; + +procedure TPlanciaConfig.LoadFromFile(const AFileName: string); +var + Doc: IXMLDocument; + Root, Node, Els, El: IXMLNode; + I: Integer; + Kind: TElementKind; + Def: TElementDef; +begin + if not FileExists(AFileName) then + raise EPlanciaConfig.CreateFmt('File di configurazione non trovato: %s', + [AFileName]); + + Clear; + + Doc := TXMLDocument.Create(nil); + Doc.LoadFromFile(AFileName); + Doc.Active := True; + + Root := Doc.DocumentElement; + if (Root = nil) or not SameText(Root.NodeName, 'plancia') then + raise EPlanciaConfig.CreateFmt( + '%s non e'' una configurazione di plancia (manca il nodo ).', + [ExtractFileName(AFileName)]); + + Node := Root.ChildNodes.FindNode('connection'); + if Node <> nil then + begin + Port := AttrStr(Node, 'port', Port); + Baud := AttrInt(Node, 'baud', Baud); + TimeoutMs := AttrInt(Node, 'timeoutMs', TimeoutMs); + PollMs := AttrInt(Node, 'pollMs', PollMs); + end; + + Node := Root.ChildNodes.FindNode('panel'); + if Node <> nil then + begin + Title := AttrStr(Node, 'title', Title); + PanelWidth := AttrInt(Node, 'width', PanelWidth); + PanelHeight := AttrInt(Node, 'height', PanelHeight); + Background := AttrStr(Node, 'background', ''); + Ink := HtmlToColor(AttrStr(Node, 'ink', ''), clNone); + end; + + // I percorsi delle immagini sono relativi alla cartella dell'XML. + BaseDir := ExtractFilePath(ExpandFileName(AFileName)); + FImages.SetBaseDir(BaseDir); + Els := Root.ChildNodes.FindNode('images'); + if Els <> nil then + for I := 0 to Els.ChildNodes.Count - 1 do + begin + El := Els.ChildNodes[I]; + if SameText(El.NodeName, 'image') then + FImages.AddEntry(AttrStr(El, 'name', ''), AttrStr(El, 'file', '')); + end; + + Els := Root.ChildNodes.FindNode('elements'); + if Els = nil then + Exit; + + for I := 0 to Els.ChildNodes.Count - 1 do + begin + El := Els.ChildNodes[I]; + if not SameText(El.NodeName, 'element') then + Continue; + if not ElementKindFromId(AttrStr(El, 'kind', ''), Kind) then + raise EPlanciaConfig.CreateFmt( + 'Tipo di elemento sconosciuto "%s" nel file %s.', + [AttrStr(El, 'kind', ''), ExtractFileName(AFileName)]); + + Def := TElementDef.Create(Kind); + FElements.Add(Def); + Def.Caption := AttrStr(El, 'caption', Def.Caption); + Def.Slave := AttrInt(El, 'slave', Def.Slave); + Def.Channel := AttrInt(El, 'channel', Def.Channel); + Def.Left := AttrInt(El, 'left', Def.Left); + Def.Top := AttrInt(El, 'top', Def.Top); + Def.Width := AttrInt(El, 'width', Def.Width); + Def.Height := AttrInt(El, 'height', Def.Height); + Def.FontSize := AttrInt(El, 'fontSize', Def.FontSize); + if Kind = ekDisplay then + begin + Def.Digits := AttrInt(El, 'digits', Def.Digits); + Def.Decimals := AttrInt(El, 'decimals', Def.Decimals); + end; + if Kind = ekRotary then + begin + Def.Positions := AttrInt(El, 'positions', Def.Positions); + Def.Legend := AttrStr(El, 'legend', Def.Legend); + // Assente = la bobina dopo `channel`, che e' il caso normale. + Def.Channel2 := AttrInt(El, 'channel2', Def.Channel2); + Def.Momentary := AttrBool(El, 'momentary', Def.Momentary); + end; + if Kind = ekLamp then + begin + Def.Alarm := AttrBool(El, 'alarm', Def.Alarm); + Def.Sound := AttrStr(El, 'sound', Def.Sound); + end; + if Kind in [ekLamp, ekButton, ekSwitch, ekLabel] then + begin + Def.OnColor := HtmlToColor(AttrStr(El, 'color', ''), Def.OnColor); + Def.OffColor := HtmlToColor(AttrStr(El, 'colorOff', ''), Def.OffColor); + end; + Def.CaptionPos := CaptionPosFromId(AttrStr(El, 'captionPos', ''), + Def.CaptionPos); + Def.Shape := ShapeFromId(AttrStr(El, 'shape', ''), Def.Shape); + Def.FontName := AttrStr(El, 'fontName', Def.FontName); + Def.Spacing := AttrInt(El, 'spacing', Def.Spacing); + if Kind = ekLabel then + begin + Def.Frame := FrameFromId(AttrStr(El, 'frame', ''), Def.Frame); + Def.FrameWidth := AttrInt(El, 'frameWidth', Def.FrameWidth); + end; + if Kind = ekImage then + Def.ImageOff := AttrStr(El, 'image', '') + else if ElementUsesImages(Kind) then + begin + Def.ImageOff := AttrStr(El, 'imageOff', ''); + Def.ImageOn := AttrStr(El, 'imageOn', ''); + end; + if ElementIsAnalog(Kind) then + begin + Def.RawMin := AttrInt(El, 'rawMin', Def.RawMin); + Def.RawMax := AttrInt(El, 'rawMax', Def.RawMax); + Def.EngMin := AttrFloat(El, 'engMin', Def.EngMin); + Def.EngMax := AttrFloat(El, 'engMax', Def.EngMax); + Def.Units := AttrStr(El, 'units', Def.Units); + Def.WarnBelow := AttrFloat(El, 'warnBelow', Def.WarnBelow); + Def.WarnAbove := AttrFloat(El, 'warnAbove', Def.WarnAbove); + end; + if Kind = ekGauge then + begin + Def.GaugeStyle := GaugeStyleFromId(AttrStr(El, 'style', ''), + Def.GaugeStyle); + // Il quadrante ha una lettura in cifre, e i decimali contano come sul + // display. + Def.Decimals := AttrInt(El, 'decimals', Def.Decimals); + end; + end; +end; + +procedure TPlanciaConfig.SaveToFile(const AFileName: string); +var + Doc: IXMLDocument; + Root, Node, Els, El: IXMLNode; + Def: TElementDef; + I: Integer; + Temp, Backup: string; +begin + // Salvando in un'altra cartella i percorsi relativi vanno ricalcolati, + // altrimenti punterebbero al vuoto. + BaseDir := ExtractFilePath(ExpandFileName(AFileName)); + FImages.Rebase(BaseDir); + + Doc := TXMLDocument.Create(nil); + Doc.Active := True; + Doc.Version := '1.0'; + Doc.Encoding := 'UTF-8'; + Doc.Options := Doc.Options + [doNodeAutoIndent]; + + Root := Doc.AddChild('plancia'); + Root.Attributes['version'] := '1'; + + Node := Root.AddChild('connection'); + Node.Attributes['port'] := Port; + Node.Attributes['baud'] := Baud; + Node.Attributes['timeoutMs'] := TimeoutMs; + Node.Attributes['pollMs'] := PollMs; + + Node := Root.AddChild('panel'); + Node.Attributes['title'] := Title; + Node.Attributes['width'] := PanelWidth; + Node.Attributes['height'] := PanelHeight; + if Background <> '' then + Node.Attributes['background'] := Background; + if Ink <> clNone then + Node.Attributes['ink'] := ColorToHtml(Ink); + + if FImages.Count > 0 then + begin + Els := Root.AddChild('images'); + for I := 0 to FImages.Count - 1 do + begin + El := Els.AddChild('image'); + El.Attributes['name'] := FImages.Item(I).Name; + El.Attributes['file'] := FImages.Item(I).FileName; + end; + end; + + Els := Root.AddChild('elements'); + for Def in FElements do + begin + El := Els.AddChild('element'); + El.Attributes['kind'] := ELEMENT_IDS[Def.Kind]; + El.Attributes['caption'] := Def.Caption; + if ElementHasChannel(Def.Kind) then + begin + El.Attributes['slave'] := Def.Slave; + El.Attributes['channel'] := Def.Channel; + end; + El.Attributes['left'] := Def.Left; + El.Attributes['top'] := Def.Top; + El.Attributes['width'] := Def.Width; + El.Attributes['height'] := Def.Height; + if Def.FontSize > 0 then + El.Attributes['fontSize'] := Def.FontSize; + if Def.Kind = ekDisplay then + begin + El.Attributes['digits'] := Def.Digits; + El.Attributes['decimals'] := Def.Decimals; + end; + if Def.Kind = ekRotary then + begin + El.Attributes['positions'] := Def.Positions; + El.Attributes['legend'] := Def.Legend; + if (Def.Positions >= 3) and (Def.Channel2 >= 0) then + El.Attributes['channel2'] := Def.Channel2; + if Def.Momentary then + El.Attributes['momentary'] := 'true'; + end; + if Def.Kind = ekLamp then + begin + // Il nome del suono si salva anche con l'allarme spento: si spunta e si + // rispunta la casella senza dover riscegliere il file. + if Def.Alarm then + El.Attributes['alarm'] := 'true'; + if Def.Sound <> '' then + El.Attributes['sound'] := Def.Sound; + end; + if Def.Kind in [ekLamp, ekButton, ekSwitch, ekLabel] then + begin + if Def.OnColor <> TElementDef.DefaultOnColor(Def.Kind) then + El.Attributes['color'] := ColorToHtml(Def.OnColor); + if Def.OffColor <> clNone then + El.Attributes['colorOff'] := ColorToHtml(Def.OffColor); + end; + // Confronto con il predefinito del tipo, non con "center": una spia con + // l'etichetta al centro, salvata senza attributo, si riaprirebbe sotto. + if Def.CaptionPos <> TElementDef.DefaultCaptionPos(Def.Kind) then + El.Attributes['captionPos'] := CAPTION_POS_IDS[Def.CaptionPos]; + if Def.Shape <> ksAuto then + El.Attributes['shape'] := SHAPE_IDS[Def.Shape]; + if Def.FontName <> '' then + El.Attributes['fontName'] := Def.FontName; + if Def.Spacing <> 0 then + El.Attributes['spacing'] := Def.Spacing; + if Def.Kind = ekLabel then + begin + if Def.Frame <> fkNone then + begin + El.Attributes['frame'] := FRAME_IDS[Def.Frame]; + El.Attributes['frameWidth'] := Def.FrameWidth; + end; + end; + if Def.Kind = ekImage then + begin + if Def.ImageOff <> '' then + El.Attributes['image'] := Def.ImageOff; + end + else if ElementUsesImages(Def.Kind) then + begin + if Def.ImageOff <> '' then + El.Attributes['imageOff'] := Def.ImageOff; + if Def.ImageOn <> '' then + El.Attributes['imageOn'] := Def.ImageOn; + end; + if ElementIsAnalog(Def.Kind) then + begin + El.Attributes['rawMin'] := Def.RawMin; + El.Attributes['rawMax'] := Def.RawMax; + El.Attributes['engMin'] := FloatAttr(Def.EngMin); + El.Attributes['engMax'] := FloatAttr(Def.EngMax); + El.Attributes['units'] := Def.Units; + El.Attributes['warnBelow'] := FloatAttr(Def.WarnBelow); + El.Attributes['warnAbove'] := FloatAttr(Def.WarnAbove); + end; + if (Def.Kind = ekGauge) and (Def.GaugeStyle <> gsBar) then + begin + El.Attributes['style'] := GAUGE_STYLE_IDS[Def.GaugeStyle]; + El.Attributes['decimals'] := Def.Decimals; + end; + end; + + // Non si scrive mai direttamente sopra il file buono: si scrive accanto e + // poi si scambia. Un programma chiuso male, un disco pieno o due copie del + // programma che salvano insieme lascerebbero altrimenti un XML troncato, + // che alla riapertura non si legge piu' e porta via la plancia. La copia + // precedente resta come .bak, che e' la via di scampo se succede comunque. + Temp := AFileName + '.tmp'; + Backup := ''; + ForceDelete(Temp); + Doc.SaveToFile(Temp); + if FileExists(AFileName) then + begin + Backup := AFileName + '.bak'; + ForceDelete(Backup); + // La sola lettura su un file di configurazione e' quasi sempre un residuo + // di una copia (da uno zip, da una chiavetta): chi salva vuole salvare, e + // la versione di prima resta comunque nel .bak. + ClearReadOnly(AFileName); + // Se il rinomina non riesce (file aperto da un altro programma) si + // procede comunque: meglio salvare senza copia di sicurezza che non + // salvare. + if not RenameFile(AFileName, Backup) then + begin + Backup := ''; + ForceDelete(AFileName); + end; + end; + if not RenameFile(Temp, AFileName) then + begin + // Non si e' riusciti a mettere il nuovo file al suo posto: si rimette + // dov'era quello di prima, invece di lasciare la plancia senza file. + if (Backup <> '') and FileExists(Backup) then + RenameFile(Backup, AFileName); + DeleteFile(Temp); + raise EPlanciaConfig.CreateFmt( + 'Non riesco a scrivere %s: la versione precedente e'' stata rimessa ' + + 'al suo posto.', [ExtractFileName(AFileName)]); + end; +end; + +initialization + FS := TFormatSettings.Invariant; + DefaultDOMVendor := sOmniXmlVendor; + +end. diff --git a/Console/uPlanciaElements.pas b/Console/uPlanciaElements.pas new file mode 100644 index 0000000..644e163 --- /dev/null +++ b/Console/uPlanciaElements.pas @@ -0,0 +1,2392 @@ +unit uPlanciaElements; + +{ + Elementi che si possono piazzare sulla plancia. + + Un solo controllo, TPlanciaElement, copre tutti i tipi: cambia solo il + disegno e la reazione al mouse. Cosi' selezione, spostamento, + ridimensionamento, zoom e serializzazione sono scritti una volta sola. + + Il controllo NON possiede la propria TElementDef: la lista delle definizioni + vive in TPlanciaConfig, che le crea e le distrugge. Non possiede nemmeno le + immagini, che stanno nella TImageLibrary condivisa. + + Coordinate: TElementDef contiene sempre coordinate LOGICHE (zoom 100%). + Il controllo le moltiplica per Scale quando si posiziona e quando disegna, + e divide per Scale i movimenti del mouse. Cosi' lo zoom non sporca il file + di configurazione. +} + +interface + +uses + Winapi.Windows, Winapi.GDIPAPI, Winapi.GDIPOBJ, + System.SysUtils, System.Classes, System.Types, System.Math, + System.Generics.Collections, + Vcl.Controls, Vcl.Graphics, Vcl.ExtCtrls, uGauge, uImageLib; + +type + TElementKind = (ekButton, ekSwitch, ekLamp, ekGauge, ekImage, ekDisplay, + ekRotary, ekLabel); + +const + // Identificativi usati nell'XML: non vanno cambiati senza migrare i file. + ELEMENT_IDS: array[TElementKind] of string = + ('button', 'switch', 'lamp', 'gauge', 'image', 'display', 'rotary', + 'label'); + ELEMENT_NAMES: array[TElementKind] of string = + ('Pulsante', 'Interruttore', 'Spia', 'Gauge', 'Immagine', 'Display', + 'Selettore', 'Testo'); + ELEMENT_HINTS: array[TElementKind] of string = + ('Chiude il canale solo mentre e'' premuto', + 'Chiude il canale e resta premuto', + 'Spia di un ingresso digitale (sola lettura)', + 'Colonna analogica con scala e soglie', + 'Grafica decorativa, nessun canale', + 'Display numerico a sette segmenti (sola lettura)', + 'Selettore rotativo a 2 o 3 posizioni', + 'Scritta serigrafata, nessun canale'); + ELEMENT_DEF_W: array[TElementKind] of Integer = + (120, 120, 90, 130, 160, 250, 150, 160); + ELEMENT_DEF_H: array[TElementKind] of Integer = + (48, 48, 64, 200, 100, 140, 170, 30); + + // Colori di stato condivisi da tutti gli elementi. + CLR_ELEM_ON = TColor($0050AF4C); + CLR_ELEM_ON_DARK = TColor($00307F2C); + CLR_LAMP_OFF = TColor($00606060); + CLR_LAMP_ON = TColor($0040E040); + /// Lente di un pulsante tondo non illuminato: grigio-azzurro chiaro. + CLR_KEY_FACE = TColor($00D8D0C8); + // Display: rosso acceso e rosso quasi spento, come i sette segmenti veri. + CLR_DISPLAY_BG = TColor($00101010); + CLR_SEG_ON = TColor($001E28FF); + CLR_SEG_OFF = TColor($00181830); + // Selettore rotativo: ghiera chiara, manopola scura, leva blu. + CLR_KNOB_RING = TColor($00C8C8C8); + CLR_KNOB_EDGE = TColor($00808080); + CLR_KNOB_BODY = TColor($00323232); + CLR_KNOB_LEVER = TColor($00A86E30); + // Ghiera di un comando tondo acceso: due tonalita' di blu, la piu' chiara + // contro la lente e la piu' carica all'orlo esterno. Letta dall'occhio come + // una luce che viene da dentro, invece che come un anello ridipinto. + CLR_KNOB_RING_ON = TColor($00FFF0AF); + CLR_KNOB_RING_ON_EDGE = TColor($00FABE5A); + /// Filo scuro all'orlo: senza, la ghiera accesa sbava sul fondo del pannello. + CLR_KNOB_RING_ON_RIM = TColor($00D2822A); + // Tasto a video spento: vetro quasi nero con un filo grigio chiaro attorno. + CLR_SCREEN_KEY_FACE = TColor($001F1C1A); + CLR_SCREEN_KEY_EDGE = TColor($00968F8A); + // Quadrante a lancetta: ghiera cromata, fondo nero, fascia della scala + // grigia; verde e rosso compaiono solo se le soglie sono impostate. + CLR_DIAL_RING = TColor($00B3ADA8); + CLR_DIAL_FACE = TColor($000D0C0B); + CLR_DIAL_BAND = TColor($00443E3A); + CLR_DIAL_OK = TColor($004BB43C); + CLR_DIAL_ALARM = TColor($00323CD2); + CLR_DIAL_TICK = TColor($00E6E6E6); + CLR_DIAL_NEEDLE = TColor($00F0F0F0); + CLR_DIAL_VALUE = TColor($0064E146); + + // Modalita' notturna. In navigazione al buio la pupilla resta dilatata solo + // se non la si abbaglia: il pannello scende a un fondo quasi nero e ogni + // colore viene abbassato alla stessa frazione, cosi' i rapporti fra i colori + // restano quelli del giorno e la plancia resta leggibile. + NIGHT_DIM = 0.34; + /// Fondo del pannello di notte: nero appena caldo, non nero assoluto, che + /// sullo schermo sembrerebbe un buco. + CLR_NIGHT_BG = TColor($000C0E12); + /// Inchiostro di tutte le scritte di notte. Ambra: e' il colore che disturba + /// meno la visione notturna, e serigrafie nere sul fondo scuro sparirebbero. + CLR_NIGHT_INK = TColor($003796EB); + + MIN_ELEMENT_SIZE = 16; + + /// Durata della rotazione della leva di un selettore. Corta: deve dare + /// l'idea del movimento, non far aspettare chi comanda. Il comando parte + /// comunque subito, l'animazione e' solo quello che si vede. + ROTARY_ANIM_MS = 130; + + /// Silenzio dell'allarme di una spia, premendola una, due o tre volte. + /// Un minuto per far finire il rumore mentre si va a guardare, dieci per + /// intervenire, un'ora per un guasto noto che si ripara in porto. + MUTE_STEPS_SEC: array[1..3] of Integer = (60, 600, 3600); + /// Passo dell'animazione: ~60 fotogrammi al secondo. + ANIM_TICK_MS = 16; + +type + /// Punto di presa del mouse in modalita' configurazione. + TGrabKind = (gkNone, gkBody, gkLeft, gkRight, gkTop, gkBottom, + gkTopLeft, gkTopRight, gkBottomLeft, gkBottomRight); + + /// Dove sta l'etichetta rispetto al comando. Sui quadri veri e' quasi + /// sempre serigrafata sotto al pulsante, non scritta sopra. + TCaptionPos = (cpCenter, cpBelow, cpAbove); + + /// Forma di pulsanti e interruttori. ksScreen e' il tasto disegnato su un + /// display multifunzione: da acceso si riempie del colore, invece di + /// accendere il bordo, perche' su uno schermo non c'e' una luce dietro. + TKeyShape = (ksAuto, ksRound, ksRect, ksPill, ksScreen); + + /// Aspetto del gauge: colonna (livelli, serbatoi) o quadrante a lancetta + /// (strumenti di misura, come sui display di plancia). + TGaugeStyle = (gsBar, gsDial); + + /// Cornice attorno a un testo: serve per i marchi serigrafati, che sono + /// una scritta dentro un ovale o un rettangolo stondato. + TFrameKind = (fkNone, fkOval, fkRect, fkRound); + + TElementDef = class + public + Kind: TElementKind; + Caption: string; + Slave: Integer; + Channel: Integer; + Left: Integer; + Top: Integer; + Width: Integer; + Height: Integer; + /// Altezza del testo in pixel logici; 0 = font del pannello. + FontSize: Integer; + /// Font del testo; vuoto = quello del pannello. + FontName: string; + /// Spaziatura extra fra le lettere, in pixel logici. I marchi hanno le + /// lettere larghe e senza questo non somigliano. + Spacing: Integer; + CaptionPos: TCaptionPos; + Shape: TKeyShape; + /// Solo ekLabel: cornice attorno alla scritta. + Frame: TFrameKind; + FrameWidth: Integer; + /// Nome nella libreria immagini. Per ekImage vale ImageOff (unica). + ImageOff: string; + ImageOn: string; + // ekGauge e ekDisplay. + RawMin: Integer; + RawMax: Integer; + EngMin: Double; + EngMax: Double; + Units: string; + WarnBelow: Double; + WarnAbove: Double; + // Solo ekGauge. + GaugeStyle: TGaugeStyle; + // Solo ekDisplay. + Digits: Integer; + Decimals: Integer; + // Solo ekRotary. + Positions: Integer; + Legend: string; + /// Bobina del lato destro di un selettore a 3 posizioni. -1 = quella dopo + /// `Channel`, che e' il caso normale; si indica solo quando sul modulo le + /// due bobine non sono contigue. + Channel2: Integer; + /// Selettore a ritorno di molla: tiene la posizione finche' lo si tiene + /// premuto e torna al centro al rilascio. Sui quadri veri e' cosi' il + /// comando di avviamento (STOP - 0 - START). + Momentary: Boolean; + // Solo ekLamp: allarme sonoro quando la spia si accende. + /// Vero se l'accensione deve far suonare qualcosa. + Alarm: Boolean; + /// Nome del file nella cartella "suoni" accanto all'XML; vuoto = nessuno. + Sound: string; + /// Colore acceso: LED della spia, lente del pulsante illuminato. + OnColor: TColor; + /// Colore a riposo. clNone = quello predefinito del tipo. Serve perche' + /// sui quadri veri la lente e' gia' colorata da spenta (STOP rosso, + /// START verde) e si limita a illuminarsi. + OffColor: TColor; + constructor Create(AKind: TElementKind); + /// Colore acceso predefinito del tipo: serve al salvataggio per non + /// scrivere l'attributo quando non e' stato cambiato. + class function DefaultOnColor(AKind: TElementKind): TColor; static; + /// Posizione dell'etichetta con cui nasce il tipo: la spia la porta sotto. + /// Il salvataggio la usa per sapere quando l'attributo va scritto. + class function DefaultCaptionPos(AKind: TElementKind): TCaptionPos; static; + procedure AssignFrom(ASource: TElementDef); + /// Converte il valore grezzo del registro in unita' ingegneristiche. + function RawToEng(ARaw: Word): Double; + function Bounds: TRect; + /// Vero se l'elemento e' agganciato a un modulo: slave 0 vuol dire "non + /// configurato", e un elemento cosi' non si legge e non si comanda. + /// Lo slave 0 sul bus e' l'indirizzo di broadcast, non risponde nessuno: + /// non toglie quindi un indirizzo utile. + function Configured: Boolean; + /// Numero di bobine occupate: il selettore a 3 posizioni ne usa due. + function CoilCount: Integer; + /// Canale della bobina di destra di un selettore a 3 posizioni. + function RightChannel: Integer; + end; + + TPlanciaElement = class; + + /// AAccepted a False fa tornare l'elemento allo stato precedente: serve + /// quando la scrittura Modbus fallisce. + TElementCommandEvent = procedure(ASender: TPlanciaElement; AOn: Boolean; + var AAccepted: Boolean) of object; + /// APos vale -1, 0 o +1 per i selettori a 3 posizioni; 0 o +1 per quelli a 2. + TElementRotaryEvent = procedure(ASender: TPlanciaElement; APos: Integer; + var AAccepted: Boolean) of object; + TElementEvent = procedure(ASender: TPlanciaElement) of object; + + TPlanciaElement = class(TGraphicControl) + private + FDef: TElementDef; + FImages: TImageLibrary; + FEditMode: Boolean; + FSelected: Boolean; + FGridSize: Integer; + FScale: Double; + FState: Boolean; + FNight: Boolean; + FInkColor: TColor; + FRotary: Integer; + /// Posizione della leva come si vede adesso: durante l'animazione e' un + /// valore intermedio fra la posizione di partenza e quella di arrivo. + FShownRotary: Double; + FAnimFrom: Double; + FAnimTo: Double; + FAnimStart: UInt64; + FAnimating: Boolean; + FValue: Double; + FValid: Boolean; + FGrab: TGrabKind; + FStartRect: TRect; + FStartMouse: TPoint; + /// Il mouse ha superato la soglia di trascinamento dopo la pressione. + FDragging: Boolean; + /// Selettore a molla tenuto premuto: la posizione la decide il mouse. + FPressed: Boolean; + /// Allarme sonoro zittito fino a questo momento; 0 = non zittito. + FMuteUntil: UInt64; + /// Il silenzio e' appena finito: l'allarme deve tornare a suonare. + FMuteExpired: Boolean; + /// Quante volte e' stata premuta la spia: 1 = un minuto, 2 = dieci, + /// 3 = un'ora, 4 = si ricomincia con l'allarme attivo. + FMuteStep: Integer; + FOnBeginChange: TElementEvent; + FOnCommand: TElementCommandEvent; + FOnMuteRequest: TElementEvent; + FOnRotary: TElementRotaryEvent; + FOnSelectRequest: TElementEvent; + FOnGeometryChanged: TElementEvent; + procedure SetEditMode(const AValue: Boolean); + procedure SetSelected(const AValue: Boolean); + procedure SetNightMode(const AValue: Boolean); + /// Il colore come va steso adesso: tale e quale di giorno, abbassato di notte. + function Shade(AColor: TColor): TColor; + /// Il colore di una scritta: di notte non si abbassa, si sostituisce, + /// altrimenti un'etichetta nera resterebbe nera su fondo nero. + function Ink(AColor: TColor): TColor; + /// Inchiostro della serigrafia: quello del pannello, nero se non impostato. + function PanelInk: TColor; + procedure SetInkColor(const AValue: TColor); + /// Altezza di un testo che va a capo dentro AWidth. + function TextBlockHeight(const AText: string; AWidth: Integer): Integer; + procedure SetScale(const AValue: Double); + function Command(AOn: Boolean): Boolean; + function RotaryCommand(APos: Integer): Boolean; + /// Avvia (o riaggancia) la rotazione della leva verso FRotary. + procedure StartRotaryAnim; + /// Un fotogramma: False quando l'animazione e' finita. + function AnimStep: Boolean; + /// Angolo della leva in gradi, orario da destra come vuole la GDI. + function LeverAngle: Double; + procedure StepRotary(ADelta: Integer); + /// Porta un selettore a molla direttamente sul lato premuto. + procedure HoldRotary(APos: Integer); + function Sc(AValue: Integer): Integer; + function KeyShape: TKeyShape; + procedure SplitBounds(const ABounds: TRect; out AGraphic, ACaption: TRect); + function HandleRect(AKind: TGrabKind): TRect; + function GrabAt(X, Y: Integer): TGrabKind; + function CurrentPicture: TPicture; + function LogicalParentSize: TPoint; + function DisplayText: string; + procedure ApplyGeometry(const ALogical: TRect); + /// Riempimento attuale di un tasto a video, prima della modalita' notturna. + function ScreenKeyFill: TColor; + procedure PaintKey(const ABounds: TRect); + procedure PaintLamp(const ABounds: TRect); + /// Sbarra sulla spia il cui allarme e' stato zittito. + procedure PaintMuteMark(const ABounds: TRect); + procedure PaintGauge(const ABounds: TRect); + procedure PaintDial(const ABounds: TRect); + procedure PaintDisplay(const ABounds: TRect); + procedure PaintRotary(const ABounds: TRect); + procedure PaintLabel(const ABounds: TRect); + procedure PaintPicture(const ABounds: TRect; APicture: TPicture); + procedure PaintMissingPicture(const ABounds: TRect); + procedure PaintCaption(const ABounds: TRect; AOnImage: Boolean); + procedure PaintEditOverlay(const ABounds: TRect); + protected + procedure Paint; override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + public + constructor CreateElement(AOwner: TComponent; ADef: TElementDef; + AImages: TImageLibrary); + destructor Destroy; override; + /// Riporta il controllo alla geometria della definizione, applicando lo zoom. + procedure ApplyDef; + /// Valore letto dal registro analogico (ekGauge, ekDisplay). + procedure SetAnalogValue(const AValue: Double); + /// Dato non disponibile: gauge svuotato, spia spenta, display spento. + procedure SetInvalid; + /// Allinea lo stato a quello letto dal campo (spie e interruttori). + procedure SyncState(AOn: Boolean); + /// Vero se l'allarme sonoro di questa spia e' zittito adesso. + function AlarmMuted: Boolean; + /// Secondi che mancano alla fine del silenzio; 0 se non e' zittita. + function MuteSecondsLeft: Integer; + /// Una pressione in piu': torna i secondi di silenzio decisi, 0 se la + /// pressione ha riacceso l'allarme. + function PressAlarmMute: Integer; + /// Toglie il silenzio senza passare dalle pressioni (cambio plancia, + /// uscita dalla modalita' plancia). + procedure ClearAlarmMute; + /// Vero una volta sola, quando il silenzio e' finito: chi lo chiede sa + /// che l'allarme va rifatto sentire. + function TakeMuteExpired: Boolean; + /// Allinea la posizione del selettore a quella letta dal campo. + procedure SyncRotary(APos: Integer); + property Def: TElementDef read FDef; + property EditMode: Boolean read FEditMode write SetEditMode; + property NightMode: Boolean read FNight write SetNightMode; + /// Colore delle scritte sul pannello (etichette esterne, legende, titoli). + /// clNone = nero. Serve alle plance a fondo scuro. + property InkColor: TColor read FInkColor write SetInkColor; + property Selected: Boolean read FSelected write SetSelected; + property GridSize: Integer read FGridSize write FGridSize; + property Scale: Double read FScale write SetScale; + property State: Boolean read FState; + property Rotary: Integer read FRotary; + property OnCommand: TElementCommandEvent read FOnCommand write FOnCommand; + /// La spia e' stata premuta per zittire (o riaccendere) il suo allarme. + property OnMuteRequest: TElementEvent read FOnMuteRequest + write FOnMuteRequest; + property OnRotary: TElementRotaryEvent read FOnRotary write FOnRotary; + property OnSelectRequest: TElementEvent read FOnSelectRequest + write FOnSelectRequest; + property OnGeometryChanged: TElementEvent read FOnGeometryChanged + write FOnGeometryChanged; + /// Un trascinamento sta per cambiare posizione o misure: scatta una volta + /// sola, prima della prima modifica. + property OnBeginChange: TElementEvent read FOnBeginChange + write FOnBeginChange; + published + property Color; + property Font; + property ParentFont; + property Hint; + property ShowHint; + property OnDragOver; + property OnDragDrop; + end; + +const + CAPTION_POS_IDS: array[TCaptionPos] of string = ('center', 'below', 'above'); + SHAPE_IDS: array[TKeyShape] of string = ('auto', 'round', 'rect', 'pill', + 'screen'); + GAUGE_STYLE_IDS: array[TGaugeStyle] of string = ('bar', 'dial'); + FRAME_IDS: array[TFrameKind] of string = ('none', 'oval', 'rect', 'round'); + FRAME_NAMES: array[TFrameKind] of string = + ('nessuna', 'ovale', 'rettangolo', 'stondata'); + CAPTION_POS_NAMES: array[TCaptionPos] of string = + ('sopra il comando', 'sotto', 'in alto'); + SHAPE_NAMES: array[TKeyShape] of string = + ('automatica', 'tonda', 'squadrata', 'a pillola', 'a video'); + +function ElementKindFromId(const AId: string; out AKind: TElementKind): Boolean; +function CaptionPosFromId(const AId: string; ADefault: TCaptionPos): TCaptionPos; +function ShapeFromId(const AId: string; ADefault: TKeyShape): TKeyShape; +function GaugeStyleFromId(const AId: string; ADefault: TGaugeStyle): TGaugeStyle; +function FrameFromId(const AId: string; ADefault: TFrameKind): TFrameKind; +/// True per i tipi legati a un canale Modbus. +function ElementHasChannel(AKind: TElementKind): Boolean; +/// True per i tipi che possono usare un'immagine al posto del disegno. +function ElementUsesImages(AKind: TElementKind): Boolean; +/// True per i tipi che leggono un registro analogico. +function ElementIsAnalog(AKind: TElementKind): Boolean; + +implementation + +const + HANDLE_SIZE = 7; + GRAB_CURSORS: array[TGrabKind] of TCursor = (crDefault, crSizeAll, + crSizeWE, crSizeWE, crSizeNS, crSizeNS, + crSizeNWSE, crSizeNESW, crSizeNESW, crSizeNWSE); + +type + /// Un timer solo per tutte le animazioni della plancia: un TTimer per + /// elemento su un quadro da cinquanta comandi sarebbe uno spreco, e + /// l'elemento e' un TGraphicControl, non ha una finestra sua. + /// Nasce al primo elemento che si muove e si ferma quando non ce n'e' piu'. + TElementAnimator = class + private + FTimer: TTimer; + FItems: TList; + procedure Tick(Sender: TObject); + public + constructor Create; + destructor Destroy; override; + procedure Add(AElement: TPlanciaElement); + procedure Remove(AElement: TPlanciaElement); + end; + +var + Animator: TElementAnimator; + +const + // Segmenti accesi per cifra: bit 0..6 = a,b,c,d,e,f,g + SEG_DIGITS: array[0..9] of Byte = + ($3F, $06, $5B, $4F, $66, $6D, $7D, $07, $7F, $6F); + SEG_MINUS = $40; + +function ElementKindFromId(const AId: string; out AKind: TElementKind): Boolean; +var + K: TElementKind; +begin + for K := Low(TElementKind) to High(TElementKind) do + if SameText(AId, ELEMENT_IDS[K]) then + begin + AKind := K; + Exit(True); + end; + AKind := ekButton; + Result := False; +end; + +function CaptionPosFromId(const AId: string; ADefault: TCaptionPos): TCaptionPos; +var + P: TCaptionPos; +begin + for P := Low(TCaptionPos) to High(TCaptionPos) do + if SameText(AId, CAPTION_POS_IDS[P]) then + Exit(P); + Result := ADefault; +end; + +function ShapeFromId(const AId: string; ADefault: TKeyShape): TKeyShape; +var + S: TKeyShape; +begin + for S := Low(TKeyShape) to High(TKeyShape) do + if SameText(AId, SHAPE_IDS[S]) then + Exit(S); + Result := ADefault; +end; + +function GaugeStyleFromId(const AId: string; ADefault: TGaugeStyle): TGaugeStyle; +var + S: TGaugeStyle; +begin + for S := Low(TGaugeStyle) to High(TGaugeStyle) do + if SameText(AId, GAUGE_STYLE_IDS[S]) then + Exit(S); + Result := ADefault; +end; + +function FrameFromId(const AId: string; ADefault: TFrameKind): TFrameKind; +var + F: TFrameKind; +begin + for F := Low(TFrameKind) to High(TFrameKind) do + if SameText(AId, FRAME_IDS[F]) then + Exit(F); + Result := ADefault; +end; + +function ElementHasChannel(AKind: TElementKind): Boolean; +begin + Result := not (AKind in [ekImage, ekLabel]); +end; + +function ElementUsesImages(AKind: TElementKind): Boolean; +begin + Result := AKind in [ekButton, ekSwitch, ekLamp, ekImage]; +end; + +function ElementIsAnalog(AKind: TElementKind): Boolean; +begin + Result := AKind in [ekGauge, ekDisplay]; +end; + +/// Colore a meta' strada: AAmount 0 = AFrom, 1 = ATo. +function BlendColor(AFrom, ATo: TColor; const AAmount: Double): TColor; +var + A, B: Longint; +begin + A := ColorToRGB(AFrom); + B := ColorToRGB(ATo); + Result := TColor(RGB( + Round(GetRValue(A) + (GetRValue(B) - GetRValue(A)) * AAmount), + Round(GetGValue(A) + (GetGValue(B) - GetGValue(A)) * AAmount), + Round(GetBValue(A) + (GetBValue(B) - GetBValue(A)) * AAmount))); +end; + +/// Luminosita' percepita 0..255: decide se su un fondo va scritto nero o chiaro. +function ColorLuma(AColor: TColor): Integer; +var + C: Longint; +begin + C := ColorToRGB(AColor); + Result := (GetRValue(C) * 299 + GetGValue(C) * 587 + GetBValue(C) * 114) + div 1000; +end; + +procedure DrawCenteredText(ACanvas: TCanvas; const ARect: TRect; + const AText: string); +var + Calc, Draw: TRect; +begin + if AText = '' then + Exit; + Calc := ARect; + Winapi.Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), Calc, + DT_CENTER or DT_WORDBREAK or DT_CALCRECT); + Draw := ARect; + Draw.Top := ARect.Top + + ((ARect.Bottom - ARect.Top) - (Calc.Bottom - Calc.Top)) div 2; + if Draw.Top < ARect.Top then + Draw.Top := ARect.Top; + Winapi.Windows.DrawText(ACanvas.Handle, PChar(AText), Length(AText), Draw, + DT_CENTER or DT_WORDBREAK or DT_END_ELLIPSIS); +end; + +/// Disegna una stringa numerica come display a sette segmenti. I segmenti +/// spenti restano visibili in scuro, come sui display veri. +procedure DrawSevenSegment(ACanvas: TCanvas; const ABounds: TRect; + const AText: string; AOnColor, AOffColor: TColor); +var + Cells, I, CellW, CellH, X, Y, T, MidY: Integer; + Ch: Char; + Mask: Byte; + HasDot: Boolean; + + procedure Seg(ABit: Integer; const R: TRect); + begin + if (Mask and (1 shl ABit)) <> 0 then + ACanvas.Brush.Color := AOnColor + else + ACanvas.Brush.Color := AOffColor; + ACanvas.FillRect(R); + end; + +begin + // Il punto decimale non occupa una cella intera. + Cells := 0; + for I := 1 to Length(AText) do + if AText[I] <> '.' then + Inc(Cells); + if Cells = 0 then + Exit; + + CellH := ABounds.Height; + CellW := ABounds.Width div Cells; + if (CellW < 6) or (CellH < 10) then + Exit; + T := Max(2, CellH div 9); + ACanvas.Brush.Style := bsSolid; + + X := ABounds.Left + (ABounds.Width - CellW * Cells) div 2; + Y := ABounds.Top; + MidY := Y + CellH div 2; + + I := 1; + while I <= Length(AText) do + begin + Ch := AText[I]; + if Ch = '.' then + begin + Inc(I); + Continue; + end; + HasDot := (I < Length(AText)) and (AText[I + 1] = '.'); + + if CharInSet(Ch, ['0'..'9']) then + Mask := SEG_DIGITS[Ord(Ch) - Ord('0')] + else if Ch = '-' then + Mask := SEG_MINUS + else + Mask := 0; + + // Larghezza utile della cifra, lasciando spazio fra una cifra e l'altra. + Seg(0, Rect(X + T, Y, X + CellW - T - T, Y + T)); + Seg(1, Rect(X + CellW - T - T, Y + T, X + CellW - T, MidY)); + Seg(2, Rect(X + CellW - T - T, MidY, X + CellW - T, Y + CellH - T)); + Seg(3, Rect(X + T, Y + CellH - T, X + CellW - T - T, Y + CellH)); + Seg(4, Rect(X, MidY, X + T, Y + CellH - T)); + Seg(5, Rect(X, Y + T, X + T, MidY)); + Seg(6, Rect(X + T, MidY - T div 2, X + CellW - T - T, MidY - T div 2 + T)); + + if HasDot then + begin + ACanvas.Brush.Color := AOnColor; + ACanvas.FillRect(Rect(X + CellW - T, Y + CellH - T, + X + CellW, Y + CellH)); + end; + + Inc(X, CellW); + Inc(I); + end; +end; + +{ TElementAnimator } + +constructor TElementAnimator.Create; +begin + inherited Create; + FItems := TList.Create; + FTimer := TTimer.Create(nil); + FTimer.Interval := ANIM_TICK_MS; + FTimer.Enabled := False; + FTimer.OnTimer := Tick; +end; + +destructor TElementAnimator.Destroy; +begin + FTimer.Free; + FItems.Free; + inherited; +end; + +procedure TElementAnimator.Add(AElement: TPlanciaElement); +begin + if FItems.IndexOf(AElement) < 0 then + FItems.Add(AElement); + FTimer.Enabled := True; +end; + +procedure TElementAnimator.Remove(AElement: TPlanciaElement); +begin + FItems.Remove(AElement); + // Nessuno si muove: il timer si ferma, non gira a vuoto. + FTimer.Enabled := FItems.Count > 0; +end; + +procedure TElementAnimator.Tick(Sender: TObject); +var + I: Integer; +begin + // A rovescio: un elemento che finisce si toglie dalla lista. + for I := FItems.Count - 1 downto 0 do + if not FItems[I].AnimStep then + Remove(FItems[I]); +end; + +{ TElementDef } + +constructor TElementDef.Create(AKind: TElementKind); +begin + inherited Create; + Kind := AKind; + Caption := ELEMENT_NAMES[AKind]; + if AKind = ekImage then + Caption := ''; + Slave := 1; + Channel := 0; + Left := 0; + Top := 0; + Width := ELEMENT_DEF_W[AKind]; + Height := ELEMENT_DEF_H[AKind]; + FontSize := 0; + RawMin := 0; + RawMax := 4095; + EngMin := 0; + EngMax := 100; + Units := '%'; + WarnBelow := GAUGE_NO_WARN_LO; + WarnAbove := GAUGE_NO_WARN_HI; + GaugeStyle := gsBar; + Digits := 4; + Decimals := 1; + Positions := 2; + Legend := 'OFF < > ON'; + Channel2 := -1; + Momentary := False; + Alarm := False; + Sound := ''; + Shape := ksAuto; + Frame := fkNone; + FrameWidth := 3; + Spacing := 0; + OnColor := DefaultOnColor(AKind); + OffColor := clNone; + CaptionPos := DefaultCaptionPos(AKind); +end; + +class function TElementDef.DefaultCaptionPos(AKind: TElementKind): TCaptionPos; +begin + if AKind = ekLamp then + Result := cpBelow + else + Result := cpCenter; +end; + +class function TElementDef.DefaultOnColor(AKind: TElementKind): TColor; +begin + case AKind of + ekLamp: Result := CLR_LAMP_ON; + // Per una scritta "acceso" significa semplicemente il colore dell'inchiostro. + ekLabel: Result := clWindowText; + else + Result := CLR_ELEM_ON; + end; +end; + +procedure TElementDef.AssignFrom(ASource: TElementDef); +begin + Kind := ASource.Kind; + Caption := ASource.Caption; + Slave := ASource.Slave; + Channel := ASource.Channel; + Left := ASource.Left; + Top := ASource.Top; + Width := ASource.Width; + Height := ASource.Height; + FontSize := ASource.FontSize; + FontName := ASource.FontName; + Spacing := ASource.Spacing; + CaptionPos := ASource.CaptionPos; + Shape := ASource.Shape; + Frame := ASource.Frame; + FrameWidth := ASource.FrameWidth; + ImageOff := ASource.ImageOff; + ImageOn := ASource.ImageOn; + RawMin := ASource.RawMin; + RawMax := ASource.RawMax; + EngMin := ASource.EngMin; + EngMax := ASource.EngMax; + Units := ASource.Units; + WarnBelow := ASource.WarnBelow; + WarnAbove := ASource.WarnAbove; + GaugeStyle := ASource.GaugeStyle; + Digits := ASource.Digits; + Decimals := ASource.Decimals; + Positions := ASource.Positions; + Legend := ASource.Legend; + Channel2 := ASource.Channel2; + Momentary := ASource.Momentary; + Alarm := ASource.Alarm; + Sound := ASource.Sound; + OnColor := ASource.OnColor; + OffColor := ASource.OffColor; +end; + +function TElementDef.RawToEng(ARaw: Word): Double; +begin + if RawMax = RawMin then + Exit(EngMin); + Result := EngMin + (Integer(ARaw) - RawMin) * (EngMax - EngMin) / + (RawMax - RawMin); +end; + +function TElementDef.Bounds: TRect; +begin + Result := Rect(Left, Top, Left + Width, Top + Height); +end; + +function TElementDef.Configured: Boolean; +begin + Result := ElementHasChannel(Kind) and (Slave >= 1) and (Channel >= 0); +end; + +function TElementDef.RightChannel: Integer; +begin + if Channel2 >= 0 then + Result := Channel2 + else + Result := Channel + 1; +end; + +function TElementDef.CoilCount: Integer; +begin + if (Kind = ekRotary) and (Positions >= 3) then + Result := 2 + else + Result := 1; +end; + +{ TPlanciaElement } + +constructor TPlanciaElement.CreateElement(AOwner: TComponent; + ADef: TElementDef; AImages: TImageLibrary); +begin + inherited Create(AOwner); + FDef := ADef; + FImages := AImages; + FGridSize := 10; + FScale := 1; + FValue := 0; + FValid := False; + FRotary := 0; + FShownRotary := 0; + FInkColor := clNone; + Color := clBtnFace; + ShowHint := True; + ApplyDef; +end; + +destructor TPlanciaElement.Destroy; +begin + // Un elemento distrutto a meta' animazione (ricostruzione del pannello, + // annulla) non deve restare nella lista dell'animatore. + if Animator <> nil then + Animator.Remove(Self); + inherited; +end; + +procedure TPlanciaElement.StartRotaryAnim; +begin + if FEditMode then + begin + // In configurazione non si comanda niente: la leva sta dove dice la + // definizione, senza animazioni. + FShownRotary := FRotary; + Exit; + end; + FAnimFrom := FShownRotary; + FAnimTo := FRotary; + if SameValue(FAnimFrom, FAnimTo) then + Exit; + FAnimStart := GetTickCount64; + FAnimating := True; + if Animator = nil then + Animator := TElementAnimator.Create; + Animator.Add(Self); +end; + +function TPlanciaElement.AnimStep: Boolean; +var + T: Double; +begin + if not FAnimating then + Exit(False); + T := (GetTickCount64 - FAnimStart) / ROTARY_ANIM_MS; + if T >= 1 then + begin + T := 1; + FAnimating := False; + end; + // Partenza e arrivo morbidi: una leva vera non scatta a velocita' costante. + FShownRotary := FAnimFrom + (FAnimTo - FAnimFrom) * (T * T * (3 - 2 * T)); + Invalidate; + Result := FAnimating; +end; + +function TPlanciaElement.LeverAngle: Double; +begin + // Gradi orari a partire da destra: 180 = sinistra, 270 = in alto, + // 360 = destra. Cosi' la leva passa sempre per l'alto e l'interpolazione + // fra due posizioni e' una rotazione, non un salto. + if FDef.Positions >= 3 then + Result := 270 + FShownRotary * 90 + else + Result := 180 + FShownRotary * 180; +end; + +function TPlanciaElement.Sc(AValue: Integer): Integer; +begin + Result := Round(AValue * FScale); + if (Result < 1) and (AValue > 0) then + Result := 1; +end; + +procedure TPlanciaElement.ApplyDef; +begin + SetBounds(Round(FDef.Left * FScale), Round(FDef.Top * FScale), + Round(FDef.Width * FScale), Round(FDef.Height * FScale)); + Invalidate; +end; + +procedure TPlanciaElement.SetScale(const AValue: Double); +begin + if (AValue <= 0) or SameValue(FScale, AValue) then + Exit; + FScale := AValue; + ApplyDef; +end; + +procedure TPlanciaElement.SetEditMode(const AValue: Boolean); +begin + if FEditMode = AValue then + Exit; + FEditMode := AValue; + if FEditMode then + begin + FState := False; + FValid := False; + FRotary := 0; + FShownRotary := 0; + FAnimating := False; + if Animator <> nil then + Animator.Remove(Self); + end + else + Cursor := crDefault; + Invalidate; +end; + +procedure TPlanciaElement.SetSelected(const AValue: Boolean); +begin + if FSelected = AValue then + Exit; + FSelected := AValue; + if not FSelected then + Cursor := crDefault; + Invalidate; +end; + +procedure TPlanciaElement.SetAnalogValue(const AValue: Double); +begin + if FValid and (FValue = AValue) then + Exit; + FValue := AValue; + FValid := True; + Invalidate; +end; + +procedure TPlanciaElement.SetInvalid; +begin + if not FValid and not FState then + Exit; + FValid := False; + if FDef.Kind = ekLamp then + FState := False; + Invalidate; +end; + +function TPlanciaElement.AlarmMuted: Boolean; +begin + Result := (FMuteUntil > 0) and (GetTickCount64 < FMuteUntil); + if (FMuteUntil > 0) and not Result then + begin + // Silenzio scaduto: si riparte da capo, la prossima pressione vale un + // minuto e non un'ora, e l'allarme torna a farsi sentire. + FMuteUntil := 0; + FMuteStep := 0; + FMuteExpired := True; + Invalidate; + end; +end; + +function TPlanciaElement.MuteSecondsLeft: Integer; +begin + if not AlarmMuted then + Exit(0); + Result := Integer((FMuteUntil - GetTickCount64 + 999) div 1000); +end; + +function TPlanciaElement.PressAlarmMute: Integer; +begin + // Ogni pressione allunga il silenzio; la quarta lo toglie, cosi' non si + // deve aspettare un'ora per riavere l'allarme. + if AlarmMuted then + Inc(FMuteStep) + else + FMuteStep := 1; + if FMuteStep > High(MUTE_STEPS_SEC) then + begin + ClearAlarmMute; + Exit(0); + end; + Result := MUTE_STEPS_SEC[FMuteStep]; + FMuteUntil := GetTickCount64 + UInt64(Result) * 1000; + Invalidate; +end; + +procedure TPlanciaElement.ClearAlarmMute; +begin + if (FMuteUntil = 0) and (FMuteStep = 0) then + Exit; + // Riattivare a mano vale come un silenzio scaduto: se la condizione c'e' + // ancora, l'allarme torna a suonare. + if FMuteUntil > 0 then + FMuteExpired := True; + FMuteUntil := 0; + FMuteStep := 0; + Invalidate; +end; + +function TPlanciaElement.TakeMuteExpired: Boolean; +begin + AlarmMuted; // fa scattare la scadenza se e' il momento + Result := FMuteExpired; + FMuteExpired := False; +end; + +procedure TPlanciaElement.SyncState(AOn: Boolean); +begin + if FState = AOn then + Exit; + FState := AOn; + Invalidate; +end; + +procedure TPlanciaElement.SetNightMode(const AValue: Boolean); +begin + if FNight = AValue then + Exit; + FNight := AValue; + Invalidate; +end; + +function TPlanciaElement.Shade(AColor: TColor): TColor; +var + C: Longint; +begin + if not FNight then + Exit(AColor); + C := ColorToRGB(AColor); + Result := TColor(RGB( + Round(GetRValue(C) * NIGHT_DIM), + Round(GetGValue(C) * NIGHT_DIM), + Round(GetBValue(C) * NIGHT_DIM))); +end; + +function TPlanciaElement.Ink(AColor: TColor): TColor; +begin + if FNight then + Result := CLR_NIGHT_INK + else + Result := AColor; +end; + +function TPlanciaElement.PanelInk: TColor; +begin + if FInkColor = clNone then + Result := Ink(clWindowText) + else + Result := Ink(FInkColor); +end; + +procedure TPlanciaElement.SetInkColor(const AValue: TColor); +begin + if FInkColor = AValue then + Exit; + FInkColor := AValue; + Invalidate; +end; + +function TPlanciaElement.TextBlockHeight(const AText: string; + AWidth: Integer): Integer; +var + Calc: TRect; +begin + if AText = '' then + Exit(0); + Calc := Rect(0, 0, Max(1, AWidth), 0); + Winapi.Windows.DrawText(Canvas.Handle, PChar(AText), Length(AText), Calc, + DT_CENTER or DT_WORDBREAK or DT_CALCRECT); + Result := Calc.Height; +end; + +procedure TPlanciaElement.SyncRotary(APos: Integer); +begin + // Mentre un selettore a molla e' tenuto premuto la posizione la decide il + // mouse, non il campo: una lettura arrivata in quell'istante lo farebbe + // scattare al centro sotto il dito. + if FPressed then + Exit; + if FRotary = APos then + Exit; + FRotary := APos; + StartRotaryAnim; + Invalidate; +end; + +function TPlanciaElement.Command(AOn: Boolean): Boolean; +begin + Result := True; + if Assigned(FOnCommand) then + FOnCommand(Self, AOn, Result); +end; + +function TPlanciaElement.RotaryCommand(APos: Integer): Boolean; +begin + Result := True; + if Assigned(FOnRotary) then + FOnRotary(Self, APos, Result); +end; + +procedure TPlanciaElement.HoldRotary(APos: Integer); +var + NewPos, OldPos: Integer; +begin + // A due posizioni il lato sinistro e' lo zero, quindi premere a sinistra + // vale come non premere. + NewPos := APos; + if (FDef.Positions < 3) and (NewPos < 0) then + NewPos := 0; + if NewPos = FRotary then + Exit; + OldPos := FRotary; + FRotary := NewPos; + StartRotaryAnim; + Invalidate; + if not RotaryCommand(NewPos) then + begin + FRotary := OldPos; + StartRotaryAnim; + Invalidate; + end; +end; + +procedure TPlanciaElement.StepRotary(ADelta: Integer); +var + Lo, Hi, NewPos, OldPos: Integer; +begin + if FDef.Positions >= 3 then + begin + Lo := -1; + Hi := 1; + end + else + begin + Lo := 0; + Hi := 1; + end; + NewPos := FRotary + ADelta; + if NewPos < Lo then + NewPos := Lo; + if NewPos > Hi then + NewPos := Hi; + if NewPos = FRotary then + Exit; + + OldPos := FRotary; + FRotary := NewPos; + StartRotaryAnim; + Invalidate; + if not RotaryCommand(NewPos) then + begin + FRotary := OldPos; + StartRotaryAnim; + Invalidate; + end; +end; + +{ geometria e mouse } + +function TPlanciaElement.LogicalParentSize: TPoint; +begin + if Parent = nil then + Exit(Point(MaxInt, MaxInt)); + Result := Point(Round(Parent.ClientWidth / FScale), + Round(Parent.ClientHeight / FScale)); +end; + +function TPlanciaElement.HandleRect(AKind: TGrabKind): TRect; +var + R: TRect; + H, CX, CY: Integer; +begin + R := ClientRect; + H := HANDLE_SIZE; + CX := (R.Left + R.Right - H) div 2; + CY := (R.Top + R.Bottom - H) div 2; + case AKind of + gkTopLeft: Result := Rect(R.Left, R.Top, R.Left + H, R.Top + H); + gkTop: Result := Rect(CX, R.Top, CX + H, R.Top + H); + gkTopRight: Result := Rect(R.Right - H, R.Top, R.Right, R.Top + H); + gkLeft: Result := Rect(R.Left, CY, R.Left + H, CY + H); + gkRight: Result := Rect(R.Right - H, CY, R.Right, CY + H); + gkBottomLeft: Result := Rect(R.Left, R.Bottom - H, R.Left + H, R.Bottom); + gkBottom: Result := Rect(CX, R.Bottom - H, CX + H, R.Bottom); + gkBottomRight: Result := Rect(R.Right - H, R.Bottom - H, R.Right, R.Bottom); + else + Result := TRect.Empty; + end; +end; + +function TPlanciaElement.GrabAt(X, Y: Integer): TGrabKind; +var + K: TGrabKind; +begin + Result := gkNone; + if not (FEditMode and FSelected) then + Exit; + for K := gkLeft to gkBottomRight do + if PtInRect(HandleRect(K), Point(X, Y)) then + Exit(K); +end; + +procedure TPlanciaElement.ApplyGeometry(const ALogical: TRect); +begin + if (FDef.Left = ALogical.Left) and (FDef.Top = ALogical.Top) and + (FDef.Width = ALogical.Width) and (FDef.Height = ALogical.Height) then + Exit; + FDef.Left := ALogical.Left; + FDef.Top := ALogical.Top; + FDef.Width := ALogical.Width; + FDef.Height := ALogical.Height; + ApplyDef; + if Assigned(FOnGeometryChanged) then + FOnGeometryChanged(Self); +end; + +procedure TPlanciaElement.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then + Exit; + + if FEditMode then + begin + // La selezione avviene prima della presa: le maniglie esistono solo + // sull'elemento selezionato. + if Assigned(FOnSelectRequest) then + FOnSelectRequest(Self); + FGrab := GrabAt(X, Y); + if FGrab = gkNone then + FGrab := gkBody; + FStartRect := FDef.Bounds; + FStartMouse := ClientToParent(Point(X, Y), Parent); + FDragging := False; + Exit; + end; + + // Pulsante e interruttore agiscono alla pressione, senza aspettare il + // rilascio: sul quadro vero il contatto scatta quando si preme il tasto. + if FDef.Kind = ekButton then + begin + FState := True; + Invalidate; + if not Command(True) then + begin + FState := False; + Invalidate; + end; + end + else if FDef.Kind = ekSwitch then + begin + FState := not FState; + Invalidate; + if not Command(FState) then + begin + // Scrittura non andata a segno: si torna allo stato di prima. + FState := not FState; + Invalidate; + end; + end + else if FDef.Kind = ekLamp then + begin + // Premere una spia che sta suonando la zittisce: e' il gesto che viene + // naturale, si preme quello che sta dando fastidio. Una spia spenta, o + // senza allarme, non fa niente. + if FState and FDef.Alarm and Assigned(FOnMuteRequest) then + FOnMuteRequest(Self); + end + else if FDef.Kind = ekRotary then + begin + // Si "gira" la manopola premendo dal lato in cui la si vuole portare. + if not FDef.Momentary then + begin + if X < ClientWidth div 2 then + StepRotary(-1) + else + StepRotary(1); + end + else + begin + // A ritorno di molla si va direttamente sul lato premuto e ci si resta + // solo finche' il tasto e' giu'. + FPressed := True; + if X < ClientWidth div 2 then + HoldRotary(-1) + else + HoldRotary(1); + end; + end; +end; + +procedure TPlanciaElement.MouseMove(Shift: TShiftState; X, Y: Integer); +var + P: TPoint; + DX, DY: Integer; + R: TRect; + Lim: TPoint; + + function Snap(AValue: Integer): Integer; + begin + if FGridSize > 1 then + Result := Round(AValue / FGridSize) * FGridSize + else + Result := AValue; + end; + +begin + inherited; + + if not FEditMode then + Exit; + + if FGrab = gkNone then + begin + Cursor := GRAB_CURSORS[GrabAt(X, Y)]; + Exit; + end; + + if not (ssLeft in Shift) then + begin + FGrab := gkNone; + FDragging := False; + Exit; + end; + + P := ClientToParent(Point(X, Y), Parent); + + // Un click non e' un trascinamento. Senza soglia il minimo tremolio della + // mano spostava l'elemento, e con la griglia attiva bastava anche un + // movimento nullo: la posizione veniva riagganciata al multiplo di 10 e un + // elemento a 245 saltava a 250 solo per essere stato cliccato. + if not FDragging then + begin + if (Abs(P.X - FStartMouse.X) < GetSystemMetrics(SM_CXDRAG)) and + (Abs(P.Y - FStartMouse.Y) < GetSystemMetrics(SM_CYDRAG)) then + Exit; + FDragging := True; + // Prima di toccare la geometria: chi tiene lo storico delle modifiche + // deve poter fotografare lo stato di partenza. + if Assigned(FOnBeginChange) then + FOnBeginChange(Self); + end; + + DX := Round((P.X - FStartMouse.X) / FScale); + DY := Round((P.Y - FStartMouse.Y) / FScale); + R := FStartRect; + + case FGrab of + gkBody: + begin + // Un asse che non si e' mosso non viene riagganciato alla griglia: + // spostando in orizzontale l'elemento non deve saltare in verticale. + if DX <> 0 then + R.Offset(Snap(R.Left + DX) - R.Left, 0); + if DY <> 0 then + R.Offset(0, Snap(R.Top + DY) - R.Top); + end; + gkLeft: + R.Left := Snap(R.Left + DX); + gkRight: + R.Right := Snap(R.Right + DX); + gkTop: + R.Top := Snap(R.Top + DY); + gkBottom: + R.Bottom := Snap(R.Bottom + DY); + gkTopLeft: + begin + R.Left := Snap(R.Left + DX); + R.Top := Snap(R.Top + DY); + end; + gkTopRight: + begin + R.Right := Snap(R.Right + DX); + R.Top := Snap(R.Top + DY); + end; + gkBottomLeft: + begin + R.Left := Snap(R.Left + DX); + R.Bottom := Snap(R.Bottom + DY); + end; + gkBottomRight: + begin + R.Right := Snap(R.Right + DX); + R.Bottom := Snap(R.Bottom + DY); + end; + end; + + // Dimensione minima: si muove il bordo che l'utente sta trascinando. + if R.Right - R.Left < MIN_ELEMENT_SIZE then + if FGrab in [gkLeft, gkTopLeft, gkBottomLeft] then + R.Left := R.Right - MIN_ELEMENT_SIZE + else + R.Right := R.Left + MIN_ELEMENT_SIZE; + if R.Bottom - R.Top < MIN_ELEMENT_SIZE then + if FGrab in [gkTop, gkTopLeft, gkTopRight] then + R.Top := R.Bottom - MIN_ELEMENT_SIZE + else + R.Bottom := R.Top + MIN_ELEMENT_SIZE; + + // Dentro il pannello. + Lim := LogicalParentSize; + if R.Left < 0 then + if FGrab = gkBody then + R.Offset(-R.Left, 0) + else + R.Left := 0; + if R.Top < 0 then + if FGrab = gkBody then + R.Offset(0, -R.Top) + else + R.Top := 0; + if R.Right > Lim.X then + if FGrab = gkBody then + R.Offset(Lim.X - R.Right, 0) + else + R.Right := Lim.X; + if R.Bottom > Lim.Y then + if FGrab = gkBody then + R.Offset(0, Lim.Y - R.Bottom) + else + R.Bottom := Lim.Y; + + ApplyGeometry(R); +end; + +procedure TPlanciaElement.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +begin + inherited; + if Button <> mbLeft then + Exit; + + if FEditMode then + begin + FGrab := gkNone; + FDragging := False; + Exit; + end; + + // Interruttori e selettori normali hanno gia' agito alla pressione. Il + // rilascio serve a chi e' momentaneo: pulsante e selettore a molla tornano + // sempre a riposo, anche fuori dai bordi e anche se la scrittura di andata + // era fallita, perche' un canale momentaneo non deve mai restare eccitato. + if FDef.Kind = ekButton then + begin + FState := False; + Invalidate; + Command(False); + end + else if (FDef.Kind = ekRotary) and FDef.Momentary then + begin + FPressed := False; + FRotary := 0; + StartRotaryAnim; + Invalidate; + RotaryCommand(0); + end; +end; + +{ disegno } + +function TPlanciaElement.CurrentPicture: TPicture; +var + N: string; +begin + Result := nil; + if (FImages = nil) or not ElementUsesImages(FDef.Kind) then + Exit; + if FDef.Kind = ekImage then + N := FDef.ImageOff + else if FState and (FDef.ImageOn <> '') then + N := FDef.ImageOn + else + N := FDef.ImageOff; + if N = '' then + Exit; + Result := FImages.Picture(N); +end; + +procedure TPlanciaElement.PaintPicture(const ABounds: TRect; + APicture: TPicture); +begin + // Nessun riempimento di sfondo: le PNG con trasparenza devono lasciar + // vedere lo sfondo della plancia. + Canvas.StretchDraw(ABounds, APicture.Graphic); +end; + +procedure TPlanciaElement.PaintMissingPicture(const ABounds: TRect); +begin + Canvas.Brush.Style := bsClear; + Canvas.Pen.Style := psDash; + Canvas.Pen.Color := clGray; + Canvas.Rectangle(ABounds); + Canvas.Pen.Style := psSolid; + Canvas.Font.Color := clGray; + Canvas.Font.Style := []; + if FDef.ImageOff = '' then + DrawCenteredText(Canvas, ABounds, '(nessuna immagine)') + else + DrawCenteredText(Canvas, ABounds, FDef.ImageOff + #13'non disponibile'); +end; + +procedure TPlanciaElement.PaintCaption(const ABounds: TRect; AOnImage: Boolean); +var + R: TRect; + I: Integer; +const + // Scostamenti per il contorno: sopra, sotto, sinistra, destra. + OFS: array[0..3, 0..1] of Integer = ((0, -1), (0, 1), (-1, 0), (1, 0)); +begin + if FDef.Caption = '' then + Exit; + Canvas.Brush.Style := bsClear; + + // Etichetta fuori dal comando: sta sulla serigrafia del pannello, quindi + // resta nera qualunque sia lo stato. + if FDef.CaptionPos <> cpCenter then + begin + Canvas.Font.Color := PanelInk; + Canvas.Font.Style := []; + DrawCenteredText(Canvas, ABounds, FDef.Caption); + Exit; + end; + + if AOnImage then + begin + // Su un'immagine non si sa se il fondo e' chiaro o scuro: testo bianco + // con contorno nero, leggibile in entrambi i casi. + Canvas.Font.Style := [fsBold]; + Canvas.Font.Color := clBlack; + for I := 0 to High(OFS) do + begin + R := ABounds; + R.Offset(OFS[I][0], OFS[I][1]); + DrawCenteredText(Canvas, R, FDef.Caption); + end; + Canvas.Font.Color := Ink(clWhite); + DrawCenteredText(Canvas, ABounds, FDef.Caption); + Exit; + end; + + // Etichetta dentro al comando: come la lente, non cambia con lo stato. Prima + // diventava bianca e grassetto da acceso, ed era un secondo modo di dire la + // stessa cosa che ora dice la ghiera. + if (FDef.Kind in [ekButton, ekSwitch, ekLamp]) and (KeyShape = ksScreen) then + begin + // Il tasto a video invece si riempie da acceso: la scritta deve stare + // bene sul fondo che ha adesso, nera sul colore chiaro e chiara sul nero. + if ColorLuma(ScreenKeyFill) > 140 then + Canvas.Font.Color := Ink(clBlack) + else + Canvas.Font.Color := Ink(TColor($00F2F2F2)); + Canvas.Font.Style := [fsBold]; + end + else + begin + Canvas.Font.Color := Ink(clWindowText); + Canvas.Font.Style := []; + end; + DrawCenteredText(Canvas, ABounds, FDef.Caption); +end; + +function TPlanciaElement.ScreenKeyFill: TColor; +begin + if FState then + Result := FDef.OnColor + else if FDef.OffColor <> clNone then + Result := FDef.OffColor + else + Result := CLR_SCREEN_KEY_FACE; +end; + +function TPlanciaElement.KeyShape: TKeyShape; +begin + Result := FDef.Shape; + if Result <> ksAuto then + Exit; + // Senza indicazione: il pulsante momentaneo e' a pillola, l'interruttore + // squadrato. La forma dice il tipo anche senza leggere l'etichetta. + if FDef.Kind = ekButton then + Result := ksPill + else + Result := ksRect; +end; + +procedure TPlanciaElement.PaintKey(const ABounds: TRect); +var + Radius, LedD, Pad, D, CX, CY, Ring, Glow: Integer; + Face: TColor; + Sh: TKeyShape; +begin + Sh := KeyShape; + // La lente non cambia con lo stato: acceso e spento si leggono dalla ghiera. + // Su un quadro vero il vetro e' sempre dello stesso colore, quello che cambia + // e' la luce dietro. Il colore della lente e' `colorOff`; `color` sui comandi + // a tasto non tocca piu' il vetro. + if FDef.OffColor <> clNone then + Face := FDef.OffColor + else if Sh = ksRound then + Face := CLR_KEY_FACE + else + Face := clBtnFace; + Face := Shade(Face); + + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Width := 1; + + if Sh = ksScreen then + begin + // Tasto di un display multifunzione: spento e' un riquadro scuro con il + // filo chiaro, acceso si riempie del colore `color`. Qui lo stato si legge + // dal riempimento, come sugli schermi veri. + Canvas.Brush.Color := Shade(ScreenKeyFill); + if FState then + Canvas.Pen.Color := Shade(FDef.OnColor) + else + Canvas.Pen.Color := Shade(CLR_SCREEN_KEY_EDGE); + Canvas.Pen.Width := Max(1, Sc(2)); + Radius := Sc(10); + Canvas.RoundRect(ABounds.Left + 1, ABounds.Top + 1, ABounds.Right - 1, + ABounds.Bottom - 1, Radius, Radius); + Canvas.Pen.Width := 1; + Exit; + end; + + if Sh = ksRound then + begin + // Pulsante illuminato da quadro: ghiera metallica e lente tonda. + D := Min(ABounds.Width, ABounds.Height); + if D < 6 then + D := 6; + CX := (ABounds.Left + ABounds.Right) div 2; + CY := (ABounds.Top + ABounds.Bottom) div 2; + Ring := Round(D * 0.84) div 2; + + if FState then + begin + // Acceso: l'orlo esterno porta il blu carico, poi una fascia piu' chiara + // stretta contro la lente. Basta il salto fra le due per dare l'idea del + // riverbero, senza gradienti che a queste dimensioni non si vedrebbero. + Canvas.Brush.Color := Shade(CLR_KNOB_RING_ON_EDGE); + Canvas.Pen.Color := Shade(CLR_KNOB_RING_ON_RIM); + Canvas.Ellipse(CX - D div 2, CY - D div 2, CX + D div 2, CY + D div 2); + + Glow := Ring + Max(1, (D div 2 - Ring) div 2); + Canvas.Brush.Color := Shade(CLR_KNOB_RING_ON); + Canvas.Pen.Color := Shade(CLR_KNOB_RING_ON); + Canvas.Ellipse(CX - Glow, CY - Glow, CX + Glow, CY + Glow); + end + else + begin + Canvas.Brush.Color := Shade(CLR_KNOB_RING); + Canvas.Pen.Color := Shade(CLR_KNOB_EDGE); + Canvas.Ellipse(CX - D div 2, CY - D div 2, CX + D div 2, CY + D div 2); + end; + + // Filo di separazione fra ghiera e lente: neutro, perche' ormai lo stato + // lo dice la ghiera e un contorno colorato tornerebbe a tingere la lente. + Canvas.Brush.Color := Face; + Canvas.Pen.Color := Shade(CLR_KNOB_EDGE); + Canvas.Ellipse(CX - Ring, CY - Ring, CX + Ring, CY + Ring); + Exit; + end; + + // Squadrato e a pillola non hanno ghiera: lo stato sta tutto nel bordo, che + // percio' si ingrossa e prende lo stesso azzurro dei tondi. Con un filo da un + // pixel il comando premuto non si distinguerebbe da fermo. + Canvas.Brush.Color := Face; + if FState then + begin + Canvas.Pen.Color := Shade(CLR_KNOB_RING_ON_EDGE); + Canvas.Pen.Width := Max(2, Sc(2)); + end + else + Canvas.Pen.Color := Shade(clGray); + if Sh = ksPill then + Radius := ABounds.Height + else + Radius := Sc(8); + Canvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, + Radius, Radius); + + if (FDef.Kind = ekSwitch) and (FDef.CaptionPos = cpCenter) then + begin + // Spia di stato nell'angolo: l'interruttore resta premuto, serve + // un riscontro visivo anche a colpo d'occhio da lontano. + LedD := Sc(10); + Pad := Sc(6); + // Il bordo squadrato puo' aver lasciato la penna ingrossata. + Canvas.Pen.Width := 1; + if FState then + Canvas.Brush.Color := Shade(CLR_LAMP_ON) + else + Canvas.Brush.Color := Shade(CLR_LAMP_OFF); + Canvas.Pen.Color := Shade(clGray); + Canvas.Ellipse(ABounds.Right - LedD - Pad, ABounds.Top + Pad, + ABounds.Right - Pad, ABounds.Top + Pad + LedD); + end; +end; + +procedure TPlanciaElement.PaintLamp(const ABounds: TRect); +var + D, CX, CY, Ring, Hi: Integer; + Lens: TColor; +begin + // Stesso aspetto di un tasto, ma la spia non si preme: e' la lente che si + // accende. Serve per gli allarmi che sul quadro vero sembrano pulsanti. + if FDef.Shape = ksScreen then + begin + PaintKey(ABounds); + Exit; + end; + + if FDef.Shape = ksRound then + begin + D := Min(ABounds.Width, ABounds.Height); + if D < 6 then + D := 6; + CX := (ABounds.Left + ABounds.Right) div 2; + CY := (ABounds.Top + ABounds.Bottom) div 2; + Ring := Round(D * 0.84) div 2; + + // Ghiera metallica fissa: in una spia lo stato e' tutto nella lente. + Canvas.Brush.Style := bsSolid; + Canvas.Pen.Width := 1; + Canvas.Brush.Color := Shade(CLR_KNOB_RING); + Canvas.Pen.Color := Shade(CLR_KNOB_EDGE); + Canvas.Ellipse(CX - D div 2, CY - D div 2, CX + D div 2, CY + D div 2); + + // Spenta la lente resta del suo colore ma scura, come un vetro rosso senza + // luce dietro; accesa prende il colore pieno con un riflesso piu' chiaro. + if FState then + Lens := FDef.OnColor + else if FDef.OffColor <> clNone then + Lens := FDef.OffColor + else + Lens := BlendColor(FDef.OnColor, clBlack, 0.62); + Canvas.Brush.Color := Shade(Lens); + Canvas.Pen.Color := Shade(CLR_KNOB_EDGE); + Canvas.Ellipse(CX - Ring, CY - Ring, CX + Ring, CY + Ring); + if FState then + begin + Hi := Round(Ring * 0.55); + Lens := Shade(BlendColor(FDef.OnColor, clWhite, 0.4)); + Canvas.Brush.Color := Lens; + Canvas.Pen.Color := Lens; + Canvas.Ellipse(CX - Hi, CY - Hi - Ring div 6, CX + Hi, CY + Hi - Ring div 6); + end; + Exit; + end; + + // Un filo di pannello attorno al LED, ma proporzionato: su una spia da 22 + // pixel un margine fisso da 6 si mangiava un quarto del diametro. + D := Min(ABounds.Width, ABounds.Height); + Dec(D, 2 * Min(Sc(3), D div 8)); + if D < 6 then + D := 6; + CX := (ABounds.Left + ABounds.Right) div 2; + CY := (ABounds.Top + ABounds.Bottom) div 2; + + // La spia invece il colore lo cambia eccome: e' tutto quello che sa fare, e + // segnala un ingresso, non un comando che si e' appena premuto. + Canvas.Brush.Style := bsSolid; + if FState then + Canvas.Brush.Color := Shade(FDef.OnColor) + else if FDef.OffColor <> clNone then + Canvas.Brush.Color := Shade(FDef.OffColor) + else + Canvas.Brush.Color := Shade(CLR_LAMP_OFF); + Canvas.Pen.Color := Shade(clGray); + Canvas.Pen.Width := 1; + Canvas.Ellipse(CX - D div 2, CY - D div 2, CX + D div 2, CY + D div 2); +end; + +procedure TPlanciaElement.PaintMuteMark(const ABounds: TRect); +var + D, CX, CY, R: Integer; +begin + // Una sbarra sulla spia: guardando il quadro si deve capire che quel LED + // sta suonando a vuoto, altrimenti si crede che l'allarme sia rientrato. + if not AlarmMuted then + Exit; + D := Min(ABounds.Width, ABounds.Height); + if D < 8 then + Exit; + CX := (ABounds.Left + ABounds.Right) div 2; + CY := (ABounds.Top + ABounds.Bottom) div 2; + R := Round(D * 0.42); + Canvas.Pen.Width := Max(2, Round(D * 0.09)); + Canvas.Pen.Color := Shade(clWhite); + Canvas.MoveTo(CX - R, CY + R); + Canvas.LineTo(CX + R, CY - R); + Canvas.Pen.Width := Max(1, Round(D * 0.045)); + Canvas.Pen.Color := Shade(clBlack); + Canvas.MoveTo(CX - R, CY + R); + Canvas.LineTo(CX + R, CY - R); + Canvas.Pen.Width := 1; +end; + +procedure TPlanciaElement.PaintGauge(const ABounds: TRect); +var + Info: TGaugeInfo; +begin + if FDef.GaugeStyle = gsDial then + begin + PaintDial(ABounds); + Exit; + end; + Info.Title := FDef.Caption; + Info.Units := FDef.Units; + Info.MinValue := FDef.EngMin; + Info.MaxValue := FDef.EngMax; + Info.Value := FValue; + Info.WarnBelow := FDef.WarnBelow; + Info.WarnAbove := FDef.WarnAbove; + Info.TickCount := 5; + Info.Valid := FValid; + Info.BackColor := Color; + Info.NightMode := FNight; + Info.Scale := FScale; + PaintTankGauge(Canvas, ABounds, Info); +end; + +procedure TPlanciaElement.PaintDial(const ABounds: TRect); +const + // Scala su 270 gradi, aperta in basso. Gli angoli GDI+ girano in senso + // orario partendo da destra: 135 e' in basso a sinistra. + START_ANG = 135.0; + SWEEP = 270.0; + MAJOR_STEPS = 5; + MINOR_PER_MAJOR = 5; +var + G: TGPGraphics; + Pen: TGPPen; + Brush: TGPSolidBrush; + S, CX, CY, RingW, RFace, Band, RBand, RTick, TickLen, RLabel: Double; + Lo, Hi, A, W, NeedleLen: Double; + I, Steps, TW, TH, BoxW, BoxH: Integer; + Pts: array[0..3] of TGPPointF; + Box: TRect; + Txt: string; + + function GP(AColor: TColor): Cardinal; + var + C: Longint; + begin + C := ColorToRGB(Shade(AColor)); + Result := MakeColor(255, GetRValue(C), GetGValue(C), GetBValue(C)); + end; + + function AngleOf(const AValue: Double): Double; + begin + if Hi <= Lo then + Exit(START_ANG); + Result := START_ANG + SWEEP * EnsureRange((AValue - Lo) / (Hi - Lo), 0, 1); + end; + + procedure BandArc(const AFrom, ATo: Double; AColor: TColor); + var + P: TGPPen; + A0, A1: Double; + begin + A0 := AngleOf(AFrom); + A1 := AngleOf(ATo); + if A1 - A0 < 0.5 then + Exit; + P := TGPPen.Create(GP(AColor), Band); + try + G.DrawArc(P, CX - RBand, CY - RBand, RBand * 2, RBand * 2, A0, A1 - A0); + finally + P.Free; + end; + end; + +begin + // Il quadrante e' tondo: occupa il quadrato piu' grande, centrato in + // orizzontale e appoggiato in alto. Titolo e valore stanno nella bocca + // aperta in basso della scala, come sui display di plancia. + S := Min(ABounds.Width, ABounds.Height); + if S < 40 then + Exit; + CX := (ABounds.Left + ABounds.Right) / 2; + CY := ABounds.Top + S / 2; + RingW := Max(2, S * 0.02); + RFace := S / 2 - RingW / 2 - 1; + Band := Max(3, S * 0.055); + RBand := RFace - RingW / 2 - S * 0.03 - Band / 2; + RTick := RBand - Band / 2 - S * 0.01; + TickLen := S * 0.06; + RLabel := RTick - TickLen - S * 0.065; + Lo := FDef.EngMin; + Hi := FDef.EngMax; + + G := TGPGraphics.Create(Canvas.Handle); + try + G.SetSmoothingMode(SmoothingModeAntiAlias); + + Brush := TGPSolidBrush.Create(GP(CLR_DIAL_FACE)); + try + G.FillEllipse(Brush, CX - RFace, CY - RFace, RFace * 2, RFace * 2); + finally + Brush.Free; + end; + Pen := TGPPen.Create(GP(CLR_DIAL_RING), RingW); + try + G.DrawEllipse(Pen, CX - RFace, CY - RFace, RFace * 2, RFace * 2); + finally + Pen.Free; + end; + + // Fascia della scala. Verde e rosso solo se le soglie ci sono: senza + // soglie un quadrante tutto verde direbbe "tutto a posto" senza saperlo. + BandArc(Lo, Hi, CLR_DIAL_BAND); + if (FDef.WarnBelow > GAUGE_NO_WARN_LO) or (FDef.WarnAbove < GAUGE_NO_WARN_HI) then + begin + BandArc(Max(Lo, FDef.WarnBelow), Min(Hi, FDef.WarnAbove), CLR_DIAL_OK); + if FDef.WarnBelow > GAUGE_NO_WARN_LO then + BandArc(Lo, Min(Hi, FDef.WarnBelow), CLR_DIAL_ALARM); + if FDef.WarnAbove < GAUGE_NO_WARN_HI then + BandArc(Max(Lo, FDef.WarnAbove), Hi, CLR_DIAL_ALARM); + end; + + // Tacche: lunghe e numerate ogni MAJOR_STEPS, corte in mezzo. + Steps := MAJOR_STEPS * MINOR_PER_MAJOR; + for I := 0 to Steps do + begin + A := DegToRad(START_ANG + SWEEP * I / Steps); + if I mod MINOR_PER_MAJOR = 0 then + begin + W := Max(1.5, S * 0.009); + NeedleLen := TickLen; + end + else + begin + W := Max(1, S * 0.004); + NeedleLen := TickLen * 0.5; + end; + Pen := TGPPen.Create(GP(CLR_DIAL_TICK), W); + try + G.DrawLine(Pen, CX + Cos(A) * RTick, CY + Sin(A) * RTick, + CX + Cos(A) * (RTick - NeedleLen), CY + Sin(A) * (RTick - NeedleLen)); + finally + Pen.Free; + end; + end; + + // Lancetta: solo con un dato valido. Senza lettura niente lancetta, + // altrimenti a fondo scala sembrerebbe un valore vero. + if FValid and (Hi > Lo) then + begin + A := DegToRad(AngleOf(FValue)); + W := Max(2, S * 0.022); + NeedleLen := RTick - S * 0.01; + Pts[0] := MakePoint(CX + Cos(A) * NeedleLen, CY + Sin(A) * NeedleLen); + Pts[1] := MakePoint(CX + Cos(A + Pi / 2) * W, CY + Sin(A + Pi / 2) * W); + Pts[2] := MakePoint(CX - Cos(A) * S * 0.07, CY - Sin(A) * S * 0.07); + Pts[3] := MakePoint(CX + Cos(A - Pi / 2) * W, CY + Sin(A - Pi / 2) * W); + Brush := TGPSolidBrush.Create(GP(CLR_DIAL_NEEDLE)); + try + G.FillPolygon(Brush, PGPPointF(@Pts[0]), Length(Pts)); + finally + Brush.Free; + end; + end; + Brush := TGPSolidBrush.Create(GP(CLR_DIAL_RING)); + try + W := Max(3, S * 0.04); + G.FillEllipse(Brush, CX - W, CY - W, W * 2, W * 2); + finally + Brush.Free; + end; + finally + G.Free; + end; + + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := PanelInk; + Canvas.Font.Style := []; + + // Titolo: sotto il quadrante se l'elemento e' piu' alto che largo, dove + // non incontra niente; altrimenti dentro, sotto il perno, dove un titolo + // lungo sfiora i numeri di inizio e fondo scala. + if FDef.Caption <> '' then + begin + TW := Canvas.TextWidth(FDef.Caption); + TH := Canvas.TextHeight(FDef.Caption); + if ABounds.Height - S >= TH then + Canvas.TextOut(Round(CX - TW / 2), ABounds.Top + Round(S) + + (ABounds.Height - Round(S) - TH) div 2, FDef.Caption) + else + Canvas.TextOut(Round(CX - TW / 2), Round(CY + S * 0.08), FDef.Caption); + end; + + // Numeri della scala, con un font proporzionato al quadrante. + Canvas.Font.Height := -Max(8, Round(S * 0.058)); + for I := 0 to MAJOR_STEPS do + begin + A := DegToRad(START_ANG + SWEEP * I / MAJOR_STEPS); + Txt := FormatFloat('0.#', Lo + (Hi - Lo) * I / MAJOR_STEPS); + TW := Canvas.TextWidth(Txt); + TH := Canvas.TextHeight(Txt); + Canvas.TextOut(Round(CX + Cos(A) * RLabel - TW / 2), + Round(CY + Sin(A) * RLabel - TH / 2), Txt); + end; + + // Valore in cifre dentro un riquadro, come la lettura digitale dei display. + BoxW := Round(S * 0.44); + BoxH := Round(S * 0.14); + Box := Rect(Round(CX) - BoxW div 2, Round(CY + S * 0.25), + Round(CX) + BoxW div 2, Round(CY + S * 0.25) + BoxH); + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := Shade(clBlack); + Canvas.Pen.Color := Shade(CLR_DIAL_RING); + Canvas.Pen.Width := 1; + Canvas.Rectangle(Box); + Canvas.Brush.Style := bsClear; + if FValid then + begin + if FDef.Decimals > 0 then + Txt := FormatFloat('0.' + StringOfChar('0', FDef.Decimals), FValue) + else + Txt := FormatFloat('0', FValue); + if FDef.Units <> '' then + Txt := Txt + ' ' + FDef.Units; + end + else + Txt := '---'; + Canvas.Font.Height := -Max(8, Round(BoxH * 0.7)); + Canvas.Font.Style := [fsBold]; + if FNight then + Canvas.Font.Color := CLR_NIGHT_INK + else + Canvas.Font.Color := CLR_DIAL_VALUE; + Winapi.Windows.DrawText(Canvas.Handle, PChar(Txt), Length(Txt), Box, + DT_CENTER or DT_VCENTER or DT_SINGLELINE); +end; + +function TPlanciaElement.DisplayText: string; +var + Digits: Integer; +begin + Digits := Max(1, FDef.Digits); + if not FValid then + Exit(StringOfChar(' ', Digits)); + Result := FormatFloat('0.' + StringOfChar('0', Max(0, FDef.Decimals)), + FValue); + Result := StringReplace(Result, ',', '.', [rfReplaceAll]); + // Allinea a destra sul numero di cifre richiesto, come un display vero. + while Length(StringReplace(Result, '.', '', [rfReplaceAll])) < Digits do + Result := '0' + Result; +end; + +procedure TPlanciaElement.PaintDisplay(const ABounds: TRect); +var + LabelH: Integer; + Box, Digits: TRect; +begin + // Nessun riempimento: la fascia dell'etichetta deve lasciar vedere lo + // sfondo del pannello. Il riquadro nero del display e' gia' opaco di suo. + LabelH := 0; + if FDef.Caption <> '' then + LabelH := Canvas.TextHeight('Wg') + Sc(4); + + Box := ABounds; + Box.Top := ABounds.Top + LabelH; + if Box.Height < 8 then + Exit; + + if LabelH > 0 then + begin + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := PanelInk; + Canvas.Font.Style := []; + DrawCenteredText(Canvas, Rect(ABounds.Left, ABounds.Top, ABounds.Right, + ABounds.Top + LabelH), FDef.Caption); + end; + + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := Shade(CLR_DISPLAY_BG); + Canvas.Pen.Color := clBlack; + Canvas.Pen.Width := 1; + Canvas.Rectangle(Box); + + Digits := Box; + InflateRect(Digits, -Sc(10), -Sc(10)); + if (Digits.Width > 10) and (Digits.Height > 10) then + DrawSevenSegment(Canvas, Digits, DisplayText, Shade(CLR_SEG_ON), Shade(CLR_SEG_OFF)); +end; + +procedure TPlanciaElement.PaintRotary(const ABounds: TRect); +var + LegendH, CapH, D, CX, CY, R, LeverW: Integer; + Knob: TRect; + Ang: Double; + EndX, EndY: Integer; +begin + // Solo ghiera e manopola sono opache: legenda ed etichetta stanno + // direttamente sullo sfondo del pannello. + // Legende ed etichette lunghe ("SERV.BATT. < 0 > START BATT.") vanno a capo + // invece di essere tagliate, ma senza mangiarsi la manopola. + LegendH := 0; + if FDef.Legend <> '' then + LegendH := Min(TextBlockHeight(FDef.Legend, ABounds.Width), + ABounds.Height div 3) + Sc(3); + CapH := 0; + if FDef.Caption <> '' then + CapH := Min(TextBlockHeight(FDef.Caption, ABounds.Width), + ABounds.Height div 3) + Sc(3); + + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := PanelInk; + Canvas.Font.Style := []; + if LegendH > 0 then + DrawCenteredText(Canvas, Rect(ABounds.Left, ABounds.Top, ABounds.Right, + ABounds.Top + LegendH), FDef.Legend); + if CapH > 0 then + DrawCenteredText(Canvas, Rect(ABounds.Left, ABounds.Bottom - CapH, + ABounds.Right, ABounds.Bottom), FDef.Caption); + + Knob := Rect(ABounds.Left, ABounds.Top + LegendH, ABounds.Right, + ABounds.Bottom - CapH); + D := Min(Knob.Width, Knob.Height); + if D < 12 then + Exit; + CX := (Knob.Left + Knob.Right) div 2; + CY := (Knob.Top + Knob.Bottom) div 2; + R := D div 2; + + // Ghiera + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := Shade(CLR_KNOB_RING); + Canvas.Pen.Color := Shade(CLR_KNOB_EDGE); + Canvas.Ellipse(CX - R, CY - R, CX + R, CY + R); + // Manopola + R := Round(R * 0.78); + Canvas.Brush.Color := Shade(CLR_KNOB_BODY); + Canvas.Pen.Color := clBlack; + Canvas.Ellipse(CX - R, CY - R, CX + R, CY + R); + + // Leva: a sinistra, in alto o a destra secondo la posizione. + // La leva segue la posizione mostrata, che durante l.animazione sta fra + // quella di partenza e quella di arrivo. + Ang := DegToRad(LeverAngle); + EndX := CX + Round(Cos(Ang) * R * 0.92); + EndY := CY + Round(Sin(Ang) * R * 0.92); + LeverW := Max(3, Round(R * 0.28)); + Canvas.Pen.Color := Shade(CLR_KNOB_LEVER); + Canvas.Pen.Width := LeverW; + Canvas.MoveTo(CX, CY); + Canvas.LineTo(EndX, EndY); + Canvas.Pen.Width := 1; + Canvas.Brush.Color := Shade(CLR_KNOB_LEVER); + Canvas.Pen.Color := Shade(CLR_KNOB_LEVER); + Canvas.Ellipse(EndX - LeverW div 2, EndY - LeverW div 2, + EndX + LeverW div 2, EndY + LeverW div 2); +end; + +/// Cornice disegnata con GDI+ invece che con la GDI: serve l'antialiasing, +/// altrimenti un ovale grande viene scalettato e il marchio sembra sporco. +procedure DrawFrameSmooth(ACanvas: TCanvas; const ABounds: TRect; + AKind: TFrameKind; AWidth: Single; AColor: TColor); +var + G: TGPGraphics; + Pen: TGPPen; + Path: TGPGraphicsPath; + RGB: Longint; + X, Y, W, H, R, D: Single; +begin + if (AKind = fkNone) or (ABounds.Width <= 2) or (ABounds.Height <= 2) then + Exit; + if AWidth < 1 then + AWidth := 1; + + // Il tratto e' centrato sul contorno: si rientra di meta' spessore per non + // farlo uscire dai bordi dell'elemento. + X := ABounds.Left + AWidth / 2; + Y := ABounds.Top + AWidth / 2; + W := ABounds.Width - AWidth; + H := ABounds.Height - AWidth; + if (W <= 0) or (H <= 0) then + Exit; + + RGB := ColorToRGB(AColor); + G := TGPGraphics.Create(ACanvas.Handle); + try + G.SetSmoothingMode(SmoothingModeAntiAlias); + Pen := TGPPen.Create(MakeColor(255, GetRValue(RGB), GetGValue(RGB), + GetBValue(RGB)), AWidth); + try + case AKind of + fkOval: + G.DrawEllipse(Pen, X, Y, W, H); + fkRect: + G.DrawRectangle(Pen, X, Y, W, H); + fkRound: + begin + R := Min(W, H) / 2; + D := R * 2; + Path := TGPGraphicsPath.Create; + try + Path.AddArc(X, Y, D, D, 180, 90); + Path.AddArc(X + W - D, Y, D, D, 270, 90); + Path.AddArc(X + W - D, Y + H - D, D, D, 0, 90); + Path.AddArc(X, Y + H - D, D, D, 90, 90); + Path.CloseFigure; + G.DrawPath(Pen, Path); + finally + Path.Free; + end; + end; + end; + finally + Pen.Free; + end; + finally + G.Free; + end; +end; + +procedure TPlanciaElement.PaintLabel(const ABounds: TRect); +var + InkNow: TColor; +begin + // Marchio serigrafato: di notte inchiostro e cornice passano all'ambra, + // altrimenti una scritta nera sparirebbe contro il pannello scuro. Senza un + // colore proprio la scritta prende l'inchiostro del pannello. + if FDef.OnColor = TElementDef.DefaultOnColor(ekLabel) then + InkNow := PanelInk + else + InkNow := Ink(FDef.OnColor); + DrawFrameSmooth(Canvas, ABounds, FDef.Frame, Sc(FDef.FrameWidth), InkNow); + if FDef.Caption = '' then + Exit; + Canvas.Brush.Style := bsClear; + Canvas.Font.Color := InkNow; + Canvas.Font.Style := []; + DrawCenteredText(Canvas, ABounds, FDef.Caption); +end; + +procedure TPlanciaElement.PaintEditOverlay(const ABounds: TRect); +var + K: TGrabKind; +begin + Canvas.Brush.Style := bsClear; + Canvas.Pen.Style := psDot; + Canvas.Pen.Width := 1; + if FSelected then + Canvas.Pen.Color := clNavy + else + Canvas.Pen.Color := clSilver; + Canvas.Rectangle(ABounds); + Canvas.Pen.Style := psSolid; + + if not FSelected then + Exit; + + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := clNavy; + Canvas.Pen.Color := clWhite; + for K := gkLeft to gkBottomRight do + Canvas.Rectangle(HandleRect(K)); +end; + +procedure TPlanciaElement.SplitBounds(const ABounds: TRect; + out AGraphic, ACaption: TRect); +var + CapH: Integer; + Calc: TRect; +begin + AGraphic := ABounds; + ACaption := ABounds; + if FDef.CaptionPos = cpCenter then + begin + InflateRect(ACaption, -Sc(6), -Sc(3)); + Exit; + end; + + // Senza etichetta non si riserva niente: il disegno, o l'immagine, prende + // tutto l'elemento. Serve alle spie appoggiate su una grafica, che sono + // piccole e con una fascia vuota sotto resterebbero la meta'. + if FDef.Caption = '' then + begin + ACaption.Bottom := ACaption.Top; + Exit; + end; + + // Misura il testo davvero: "NAVIGATION LTS" su un pulsante stretto va a + // capo, e con una fascia da una riga sola resterebbe tagliato. + Calc := Rect(0, 0, ABounds.Width, 0); + Winapi.Windows.DrawText(Canvas.Handle, PChar(FDef.Caption), + Length(FDef.Caption), Calc, DT_CENTER or DT_WORDBREAK or DT_CALCRECT); + CapH := Calc.Height + Sc(3); + if CapH > ABounds.Height div 2 then + CapH := ABounds.Height div 2; + if FDef.CaptionPos = cpBelow then + begin + ACaption.Top := ABounds.Bottom - CapH; + AGraphic.Bottom := ABounds.Bottom - CapH; + end + else + begin + ACaption.Bottom := ABounds.Top + CapH; + AGraphic.Top := ABounds.Top + CapH; + end; +end; + +procedure TPlanciaElement.Paint; +var + R, GfxR, CapR: TRect; + Pic: TPicture; +begin + R := ClientRect; + Canvas.Font := Font; + if FDef.FontName <> '' then + Canvas.Font.Name := FDef.FontName; + if FDef.FontSize > 0 then + Canvas.Font.Height := -Sc(FDef.FontSize) + else if not SameValue(FScale, 1) then + Canvas.Font.Height := Round(Font.Height * FScale); + // La spaziatura e' una proprieta' del DC, non del font: va rimessa a zero + // in fondo, perche' il canvas e' quello del pannello ed e' condiviso con + // tutti gli altri elementi. + if FDef.Spacing <> 0 then + SetTextCharacterExtra(Canvas.Handle, Sc(FDef.Spacing)); + try + + SplitBounds(R, GfxR, CapR); + Pic := CurrentPicture; + + if FDef.Kind = ekImage then + begin + if Pic <> nil then + PaintPicture(R, Pic) + else if FEditMode then + PaintMissingPicture(R); + end + else if (Pic <> nil) and ElementUsesImages(FDef.Kind) then + begin + PaintPicture(GfxR, Pic); + PaintCaption(CapR, FDef.CaptionPos = cpCenter); + end + else + case FDef.Kind of + ekButton, ekSwitch: + begin + PaintKey(GfxR); + PaintCaption(CapR, False); + end; + ekLamp: + begin + PaintLamp(GfxR); + PaintMuteMark(GfxR); + PaintCaption(CapR, False); + end; + ekGauge: PaintGauge(R); + ekDisplay: PaintDisplay(R); + ekRotary: PaintRotary(R); + ekLabel: PaintLabel(R); + end; + + if FEditMode then + PaintEditOverlay(R); + + finally + if FDef.Spacing <> 0 then + SetTextCharacterExtra(Canvas.Handle, 0); + end; +end; + +initialization + +finalization + // Il timer delle animazioni non deve sopravvivere alla chiusura. + FreeAndNil(Animator); + +end. diff --git a/Console/zebra.xml b/Console/zebra.xml new file mode 100644 index 0000000..6d25e33 --- /dev/null +++ b/Console/zebra.xml @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/PlanciaProjectGroup1.groupproj b/PlanciaProjectGroup1.groupproj new file mode 100644 index 0000000..61700fd --- /dev/null +++ b/PlanciaProjectGroup1.groupproj @@ -0,0 +1,48 @@ + + + {78922105-9D91-4F64-B3AD-D910779B6FAD} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/ProjectPlancia.dpr b/ProjectPlancia.dpr new file mode 100644 index 0000000..9ddc25a --- /dev/null +++ b/ProjectPlancia.dpr @@ -0,0 +1,16 @@ +program ProjectPlancia; + +uses + Vcl.Forms, + uMain in 'uMain.pas' {MainForm}, + uModbusRTU in 'uModbusRTU.pas', + uGauge in 'uGauge.pas'; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/ProjectPlancia.dproj b/ProjectPlancia.dproj new file mode 100644 index 0000000..d5dc7c9 --- /dev/null +++ b/ProjectPlancia.dproj @@ -0,0 +1,121 @@ + + + {A1B2C3D4-E5F6-4A5B-9C8D-1234567890AB} + 20.3 + VCL + ProjectPlancia.dpr + True + Debug + Win32 + 1 + Application + ProjectPlancia + + + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + ProjectPlancia + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + 1 + false + + + Debug + + + PerMonitorV2 + + + 0 + + + PerMonitorV2 + + + + MainSource + + +
MainForm
+ dfm + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + + Delphi.Personality.12 + VCLApplication + + + + ProjectPlancia.dpr + + + + True + False + + + 12 + + diff --git a/ProjectPlancia.res b/ProjectPlancia.res new file mode 100644 index 0000000..b194869 Binary files /dev/null and b/ProjectPlancia.res differ diff --git a/ProjectPlancia_Icon.ico b/ProjectPlancia_Icon.ico new file mode 100644 index 0000000..45950d1 Binary files /dev/null and b/ProjectPlancia_Icon.ico differ diff --git a/uGauge.pas b/uGauge.pas new file mode 100644 index 0000000..48f7055 --- /dev/null +++ b/uGauge.pas @@ -0,0 +1,304 @@ +unit uGauge; + +interface + +uses + Winapi.Windows, System.SysUtils, System.Classes, System.Types, + Vcl.Controls, Vcl.Graphics; + +const + // Valori sentinella: soglia di allarme non impostata. + GAUGE_NO_WARN_LO = -1E30; + GAUGE_NO_WARN_HI = 1E30; + +type + /// Dati necessari a disegnare una colonna: raccolti in un record cosi' lo + /// stesso disegno e' riusabile da qualunque controllo, non solo da + /// TTankGauge (lo usa anche l'elemento gauge della plancia). + TGaugeInfo = record + Title: string; + Units: string; + MinValue: Double; + MaxValue: Double; + Value: Double; + WarnBelow: Double; + WarnAbove: Double; + TickCount: Integer; + Valid: Boolean; + BackColor: TColor; + /// Colonna e scritte abbassate, per non abbagliare in navigazione notturna. + NightMode: Boolean; + /// Fattore di zoom: scala le misure fisse del disegno (titolo, colonna, + /// tacche). 0 o assente equivale a 1. + Scale: Double; + end; + +/// Disegna la colonna dentro ABounds, in coordinate del canvas ricevuto. +procedure PaintTankGauge(ACanvas: TCanvas; const ABounds: TRect; + const AInfo: TGaugeInfo); + +type + /// + /// Indicatore verticale a colonna, tipo termometro o livello serbatoio. + /// Disegnato a mano su TGraphicControl: nessuna dipendenza da package + /// esterni, quindi non serve installare nulla nell'IDE. + /// + TTankGauge = class(TGraphicControl) + private + FMinValue: Double; + FMaxValue: Double; + FValue: Double; + FUnits: string; + FTitle: string; + FWarnBelow: Double; + FWarnAbove: Double; + FTickCount: Integer; + FValid: Boolean; + procedure SetValue(const AValue: Double); + procedure SetValid(const AValue: Boolean); + procedure SetTitle(const AValue: string); + procedure SetUnits(const AValue: string); + function GaugeInfo: TGaugeInfo; + protected + procedure Paint; override; + public + constructor Create(AOwner: TComponent); override; + /// Imposta il fondo scala in unita' ingegneristiche e il numero di tacche. + procedure SetRange(const AMin, AMax: Double; ATickCount: Integer = 5); + /// Sotto ABelow o sopra AAbove la colonna diventa rossa. + procedure SetWarnings(const ABelow, AAbove: Double); + /// Assegnare Value marca automaticamente il dato come valido. + property Value: Double read FValue write SetValue; + /// A False la colonna resta vuota e il valore mostra '--'. + property Valid: Boolean read FValid write SetValid; + property Title: string read FTitle write SetTitle; + property Units: string read FUnits write SetUnits; + property MinValue: Double read FMinValue; + property MaxValue: Double read FMaxValue; + published + property Color; + property Font; + property ParentFont; + property Visible; + end; + +implementation + +const + TITLE_H = 18; + VALUE_H = 20; + BODY_W = 28; + TICK_LEN = 4; + CLR_OK = TColor($0050AF4C); + CLR_ALARM = TColor($002F2FD3); + // Modalita' notturna: stessa frazione e stesso ambra usati dalla plancia, + // altrimenti un gauge stonerebbe in mezzo ai comandi. + GAUGE_NIGHT_DIM = 0.34; + GAUGE_NIGHT_INK = TColor($003796EB); + +constructor TTankGauge.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + Width := 130; + Height := 200; + Color := clBtnFace; + FMinValue := 0; + FMaxValue := 100; + FValue := 0; + FTickCount := 5; + FValid := False; + FWarnBelow := GAUGE_NO_WARN_LO; + FWarnAbove := GAUGE_NO_WARN_HI; +end; + +procedure TTankGauge.SetRange(const AMin, AMax: Double; ATickCount: Integer); +begin + FMinValue := AMin; + FMaxValue := AMax; + if ATickCount < 2 then + FTickCount := 2 + else + FTickCount := ATickCount; + Invalidate; +end; + +procedure TTankGauge.SetWarnings(const ABelow, AAbove: Double); +begin + FWarnBelow := ABelow; + FWarnAbove := AAbove; + Invalidate; +end; + +procedure TTankGauge.SetValue(const AValue: Double); +begin + if (FValue = AValue) and FValid then + Exit; + FValue := AValue; + FValid := True; + Invalidate; +end; + +procedure TTankGauge.SetValid(const AValue: Boolean); +begin + if FValid = AValue then + Exit; + FValid := AValue; + Invalidate; +end; + +procedure TTankGauge.SetTitle(const AValue: string); +begin + if FTitle = AValue then + Exit; + FTitle := AValue; + Invalidate; +end; + +procedure TTankGauge.SetUnits(const AValue: string); +begin + if FUnits = AValue then + Exit; + FUnits := AValue; + Invalidate; +end; + +function GaugeValueText(const AInfo: TGaugeInfo): string; +begin + if not AInfo.Valid then + Exit('--'); + Result := FormatFloat('0.#', AInfo.Value); + if AInfo.Units <> '' then + Result := Result + ' ' + AInfo.Units; +end; + +procedure PaintTankGauge(ACanvas: TCanvas; const ABounds: TRect; + const AInfo: TGaugeInfo); +var + Body: TRect; + FillTop, I, Y, TxtY, TxtH, Ticks: Integer; + TitleH, ValueH, BodyW, TickLen: Integer; + Frac, TickVal, Z: Double; + S: string; + + /// Il colore come va steso: tale e quale di giorno, abbassato di notte. + function Dusk(AColor: TColor): TColor; + var + C: Longint; + begin + if not AInfo.NightMode then + Exit(AColor); + C := ColorToRGB(AColor); + Result := TColor(RGB( + Round(GetRValue(C) * GAUGE_NIGHT_DIM), + Round(GetGValue(C) * GAUGE_NIGHT_DIM), + Round(GetBValue(C) * GAUGE_NIGHT_DIM))); + end; + +begin + Ticks := AInfo.TickCount; + if Ticks < 2 then + Ticks := 2; + Z := AInfo.Scale; + if Z <= 0 then + Z := 1; + TitleH := Round(TITLE_H * Z); + ValueH := Round(VALUE_H * Z); + BodyW := Round(BODY_W * Z); + TickLen := Round(TICK_LEN * Z); + + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := AInfo.BackColor; + ACanvas.FillRect(ABounds); + + Body := Rect(ABounds.Left + 1, ABounds.Top + TitleH, + ABounds.Left + 1 + BodyW, ABounds.Bottom - ValueH); + if Body.Bottom <= Body.Top then + Exit; + + // colonna vuota + ACanvas.Brush.Color := Dusk(clWhite); + ACanvas.Pen.Color := Dusk(clGray); + ACanvas.Pen.Width := 1; + ACanvas.Rectangle(Body); + + // riempimento proporzionale, dal basso verso l'alto + if AInfo.Valid and (AInfo.MaxValue > AInfo.MinValue) then + begin + Frac := (AInfo.Value - AInfo.MinValue) / (AInfo.MaxValue - AInfo.MinValue); + if Frac < 0 then + Frac := 0; + if Frac > 1 then + Frac := 1; + FillTop := (Body.Bottom - 1) - Round((Body.Bottom - Body.Top - 2) * Frac); + if FillTop < Body.Bottom - 1 then + begin + if (AInfo.Value < AInfo.WarnBelow) or (AInfo.Value > AInfo.WarnAbove) then + ACanvas.Brush.Color := Dusk(CLR_ALARM) + else + ACanvas.Brush.Color := Dusk(CLR_OK); + ACanvas.FillRect(Rect(Body.Left + 1, FillTop, Body.Right - 1, + Body.Bottom - 1)); + end; + end; + + ACanvas.Brush.Style := bsClear; + // Di notte le scritte non si abbassano, si sostituiscono: un titolo nero + // abbassato resterebbe nero, cioe' invisibile sul fondo scuro. + if AInfo.NightMode then + ACanvas.Font.Color := GAUGE_NIGHT_INK + else + ACanvas.Font.Color := clWindowText; + + // titolo + ACanvas.Font.Style := []; + ACanvas.TextOut(ABounds.Left, ABounds.Top, AInfo.Title); + + // tacche della scala, dal massimo in alto al minimo in basso + ACanvas.Pen.Color := Dusk(clGray); + for I := 0 to Ticks - 1 do + begin + Y := Body.Top + Round((Body.Bottom - Body.Top) * I / (Ticks - 1)); + if Y >= Body.Bottom then + Y := Body.Bottom - 1; + ACanvas.MoveTo(Body.Right, Y); + ACanvas.LineTo(Body.Right + TickLen, Y); + + TickVal := AInfo.MaxValue - (AInfo.MaxValue - AInfo.MinValue) * I / (Ticks - 1); + S := FormatFloat('0.#', TickVal); + TxtH := ACanvas.TextHeight(S); + TxtY := Y - TxtH div 2; + if TxtY < Body.Top then + TxtY := Body.Top; + if TxtY + TxtH > Body.Bottom then + TxtY := Body.Bottom - TxtH; + ACanvas.TextOut(Body.Right + TickLen + 3, TxtY, S); + end; + + // valore corrente + ACanvas.Font.Style := [fsBold]; + ACanvas.TextOut(ABounds.Left, ABounds.Bottom - ValueH + 2, + GaugeValueText(AInfo)); +end; + +function TTankGauge.GaugeInfo: TGaugeInfo; +begin + Result.Title := FTitle; + Result.Units := FUnits; + Result.MinValue := FMinValue; + Result.MaxValue := FMaxValue; + Result.Value := FValue; + Result.WarnBelow := FWarnBelow; + Result.WarnAbove := FWarnAbove; + Result.TickCount := FTickCount; + Result.Valid := FValid; + Result.BackColor := Color; + Result.Scale := 1; +end; + +procedure TTankGauge.Paint; +begin + Canvas.Font := Font; + PaintTankGauge(Canvas, ClientRect, GaugeInfo); +end; + +end. diff --git a/uMain.dfm b/uMain.dfm new file mode 100644 index 0000000..52ba5be --- /dev/null +++ b/uMain.dfm @@ -0,0 +1,224 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Caption = 'Plancia ZEBRA - Controllo RS485' + ClientHeight = 620 + ClientWidth = 820 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 15 + object pnlTop: TPanel + Left = 0 + Top = 0 + Width = 820 + Height = 110 + Align = alTop + TabOrder = 0 + ExplicitWidth = 814 + object lblPort: TLabel + Left = 16 + Top = 16 + Width = 62 + Height = 15 + Caption = 'Porta COM:' + end + object lblBaud: TLabel + Left = 160 + Top = 16 + Width = 30 + Height = 15 + Caption = 'Baud:' + end + object lblStatus: TLabel + Left = 448 + Top = 15 + Width = 104 + Height = 15 + Caption = 'Stato: Disconnesso' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [fsBold] + ParentFont = False + end + object lblSlaveRele: TLabel + Left = 16 + Top = 60 + Width = 52 + Height = 15 + Caption = 'Slave rel'#232':' + end + object lblSlaveIO: TLabel + Left = 160 + Top = 60 + Width = 50 + Height = 15 + Caption = 'Slave I/O:' + end + object lblSlaveAnalog: TLabel + Left = 300 + Top = 60 + Width = 72 + Height = 15 + Caption = 'Slave analog.:' + end + object cboPort: TComboBox + Left = 16 + Top = 34 + Width = 121 + Height = 23 + Style = csDropDownList + TabOrder = 0 + end + object cboBaud: TComboBox + Left = 160 + Top = 34 + Width = 121 + Height = 23 + Style = csDropDownList + TabOrder = 1 + end + object btnConnect: TButton + Left = 448 + Top = 41 + Width = 100 + Height = 30 + Caption = 'Connetti' + TabOrder = 2 + OnClick = btnConnectClick + end + object edtSlaveRele: TEdit + Left = 92 + Top = 57 + Width = 40 + Height = 23 + TabOrder = 3 + Text = '1' + end + object edtSlaveIO: TEdit + Left = 226 + Top = 57 + Width = 40 + Height = 23 + TabOrder = 4 + Text = '2' + end + object edtSlaveAnalog: TEdit + Left = 386 + Top = 57 + Width = 40 + Height = 23 + TabOrder = 5 + Text = '5' + end + object CBReadInput: TCheckBox + Left = 451 + Top = 77 + Width = 97 + Height = 17 + Caption = 'Leggi Ingressi' + Checked = True + State = cbChecked + TabOrder = 6 + end + object CBReadAnalog: TCheckBox + Left = 560 + Top = 77 + Width = 113 + Height = 17 + Caption = 'Leggi Analogici' + TabOrder = 7 + end + end + object pgcMain: TPageControl + Left = 0 + Top = 110 + Width = 820 + Height = 380 + ActivePage = tsInterruttori + Align = alClient + TabOrder = 1 + ExplicitWidth = 814 + ExplicitHeight = 363 + object tsInterruttori: TTabSheet + Caption = 'Interruttori' + object pnlInterruttori: TPanel + Left = 0 + Top = 0 + Width = 812 + Height = 350 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + ExplicitWidth = 806 + ExplicitHeight = 333 + end + end + object tsPulsanti: TTabSheet + Caption = 'Pulsanti' + ImageIndex = 3 + object pnlPulsanti: TPanel + Left = 0 + Top = 0 + Width = 812 + Height = 350 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + end + end + object tsInputs: TTabSheet + Caption = 'Ingressi Binari' + ImageIndex = 1 + object pnlInputs: TPanel + Left = 0 + Top = 0 + Width = 812 + Height = 350 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + end + end + object tsAnalog: TTabSheet + Caption = 'Analogici' + ImageIndex = 2 + object pnlAnalog: TPanel + Left = 0 + Top = 0 + Width = 812 + Height = 350 + Align = alClient + BevelOuter = bvNone + TabOrder = 0 + end + end + end + object mmoLog: TMemo + Left = 0 + Top = 490 + Width = 820 + Height = 130 + Align = alBottom + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 2 + ExplicitTop = 473 + ExplicitWidth = 814 + end + object tmrPoll: TTimer + Enabled = False + Interval = 500 + OnTimer = tmrPollTimer + Left = 760 + Top = 16 + end +end diff --git a/uMain.pas b/uMain.pas new file mode 100644 index 0000000..5f94567 --- /dev/null +++ b/uMain.pas @@ -0,0 +1,631 @@ +unit uMain; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Buttons, + System.Generics.Collections, System.Win.Registry, System.StrUtils, + uModbusRTU, uGauge; + +type + TMainForm = class(TForm) + pnlTop: TPanel; + lblPort: TLabel; + cboPort: TComboBox; + lblBaud: TLabel; + cboBaud: TComboBox; + btnConnect: TButton; + lblStatus: TLabel; + lblSlaveRele: TLabel; + edtSlaveRele: TEdit; + lblSlaveIO: TLabel; + edtSlaveIO: TEdit; + lblSlaveAnalog: TLabel; + edtSlaveAnalog: TEdit; + pgcMain: TPageControl; + tsInterruttori: TTabSheet; + tsPulsanti: TTabSheet; + tsInputs: TTabSheet; + tsAnalog: TTabSheet; + pnlInterruttori: TPanel; + pnlPulsanti: TPanel; + pnlInputs: TPanel; + pnlAnalog: TPanel; + mmoLog: TMemo; + tmrPoll: TTimer; + CBReadInput: TCheckBox; + CBReadAnalog: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnConnectClick(Sender: TObject); + procedure tmrPollTimer(Sender: TObject); + private + FModbus: TModbusRTU; + FSwitchButtons: array[0..15] of TSpeedButton; + FPulseButtons: array[0..15] of TSpeedButton; + FInputShapes: array[0..7] of TShape; + FInputLabels: array[0..7] of TLabel; + FAnalogLabels: array[0..3] of TLabel; + FAnalogGauges: array[0..3] of TTankGauge; + /// Ultimo stato mostrato per ogni ingresso, per registrare a log solo le + /// transizioni: un contatto che si chiude e' un evento, non un livello. + FInputState: array[0..7] of Boolean; + FInputValid: array[0..7] of Boolean; + /// Ultimo errore gia' registrato, per non riempire il log con lo stesso + /// messaggio due volte al secondo finche' il bus resta muto. + FInputErr: string; + FAnalogErr: string; + procedure Log(const AMsg: string); + procedure SetInputVisual(AIndex: Integer; AValid, AClosed: Boolean); + procedure InvalidateInputs; + procedure BuildSwitchControls; + procedure BuildPulseControls; + procedure BuildInputControls; + procedure BuildAnalogControls; + procedure SwitchButtonClick(Sender: TObject); + procedure PulseButtonMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure PulseButtonMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); + procedure SetPulseState(ABtn: TSpeedButton; AOn: Boolean); + procedure UpdateButtonVisual(ABtn: TSpeedButton; AOn: Boolean); + procedure SetConnectedState(AConnected: Boolean); + public + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +type + /// Scalatura di un canale analogico: dal valore grezzo del registro Modbus + /// al valore ingegneristico mostrato dal gauge. + TAnalogCfg = record + Title: string; + RawMin: Integer; + RawMax: Integer; + EngMin: Double; + EngMax: Double; + Units: string; + WarnBelow: Double; + WarnAbove: Double; + end; + +const + GRID_COLS = 4; + CTRL_W = 90; + CTRL_H = 30; + MARGIN = 12; + HDR_H = 24; + GAUGE_W = 130; + GAUGE_H = 200; + // Passo fra una spia d'ingresso e l'altra: deve stare larga la didascalia + // su due righe, altrimenti le scritte si accavallano. + INPUT_SPACING = 84; + + // Configurazione dei 4 canali analogici. RawMin/RawMax vanno allineati al + // fondo scala del modulo (4095 = ADC a 12 bit); EngMin/EngMax sono i valori + // reali corrispondenti. WarnBelow/WarnAbove colorano di rosso la colonna. + ANALOG_CFG: array[0..3] of TAnalogCfg = ( + (Title: 'Temperatura'; RawMin: 0; RawMax: 4095; + EngMin: 0; EngMax: 120; Units: '°C'; + WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: 100), + (Title: 'Livello serbatoio'; RawMin: 0; RawMax: 4095; + EngMin: 0; EngMax: 100; Units: '%'; + WarnBelow: 15; WarnAbove: GAUGE_NO_WARN_HI), + (Title: 'Canale 2'; RawMin: 0; RawMax: 4095; + EngMin: 0; EngMax: 100; Units: '%'; + WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: GAUGE_NO_WARN_HI), + (Title: 'Canale 3'; RawMin: 0; RawMax: 4095; + EngMin: 0; EngMax: 100; Units: '%'; + WarnBelow: GAUGE_NO_WARN_LO; WarnAbove: GAUGE_NO_WARN_HI) + ); + + // Etichette dei pulsanti momentanei: stringa vuota = 'Canale N'. + // Es.: impostare PULSE_NAMES[0] := 'Horn' per il canale 0. + PULSE_NAMES: array[0..15] of string = ( + '', '', '', '', '', '', '', '', + '', '', '', '', '', '', '', '' + ); + +/// Le porte realmente presenti, lette dal registro di Windows. Elencarle a +/// mano significa non vedere l'adattatore USB quando si presenta con un numero +/// diverso da quelli previsti. +procedure EnumSerialPorts(AList: TStrings); +var + Reg: TRegistry; + Names: TStringList; + Name: string; +begin + AList.Clear; + Reg := TRegistry.Create(KEY_READ); + Names := TStringList.Create; + try + Reg.RootKey := HKEY_LOCAL_MACHINE; + if Reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then + begin + Reg.GetValueNames(Names); + for Name in Names do + AList.Add(Reg.ReadString(Name)); + Reg.CloseKey; + end; + finally + Names.Free; + Reg.Free; + end; +end; + +procedure TMainForm.FormCreate(Sender: TObject); +var + I: Integer; +begin + EnumSerialPorts(cboPort.Items); + if cboPort.Items.Count = 0 then + // Nessuna porta trovata: meglio una lista di ripiego che una casella vuota. + for I := 1 to 10 do + cboPort.Items.Add('COM' + IntToStr(I)); + I := cboPort.Items.IndexOf('COM7'); + if I < 0 then + I := 0; + cboPort.ItemIndex := I; + + cboBaud.Items.CommaText := '9600,19200,38400,57600,115200'; + cboBaud.ItemIndex := 0; + + edtSlaveRele.Text := '1'; + edtSlaveIO.Text := '2'; + edtSlaveAnalog.Text := '5'; + + BuildSwitchControls; + BuildPulseControls; + BuildInputControls; + BuildAnalogControls; + + SetConnectedState(False); +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + tmrPoll.Enabled := False; + if Assigned(FModbus) then + begin + FModbus.Disconnect; + FModbus.Free; + end; +end; + +procedure TMainForm.Log(const AMsg: string); +begin + mmoLog.Lines.Add(FormatDateTime('hh:nn:ss', Now) + ' ' + AMsg); +end; + +function ChannelCaption(AIndex: Integer): string; +begin + if PULSE_NAMES[AIndex] <> '' then + Result := PULSE_NAMES[AIndex] + else + Result := 'Canale ' + IntToStr(AIndex); +end; + +procedure TMainForm.BuildSwitchControls; +var + I, Row, Col: Integer; + Hdr: TLabel; + Btn: TSpeedButton; +begin + Hdr := TLabel.Create(Self); + Hdr.Parent := pnlInterruttori; + Hdr.Caption := 'Il canale resta chiuso finché il pulsante è premuto giù.'; + Hdr.Left := MARGIN; + Hdr.Top := MARGIN; + + for I := 0 to 15 do + begin + Row := I div GRID_COLS; + Col := I mod GRID_COLS; + Btn := TSpeedButton.Create(Self); + Btn.Parent := pnlInterruttori; + Btn.Caption := 'Canale ' + IntToStr(I); + Btn.Left := MARGIN + Col * (CTRL_W + MARGIN); + Btn.Top := HDR_H + MARGIN + Row * (CTRL_H + 6); + Btn.Width := CTRL_W; + Btn.Height := CTRL_H; + Btn.Tag := I; + // GroupIndex univoco + AllowAllUp: il pulsante resta premuto e si sgancia + // al click successivo, senza influenzare gli altri canali. + Btn.GroupIndex := I + 1; + Btn.AllowAllUp := True; + Btn.Down := False; + Btn.OnClick := SwitchButtonClick; + FSwitchButtons[I] := Btn; + UpdateButtonVisual(Btn, False); + end; +end; + +procedure TMainForm.BuildPulseControls; +var + I, Row, Col: Integer; + Hdr: TLabel; + Btn: TSpeedButton; +begin + Hdr := TLabel.Create(Self); + Hdr.Parent := pnlPulsanti; + Hdr.Caption := 'Il canale resta chiuso solo mentre il pulsante è premuto ' + + '(contatto momentaneo, es. horn).'; + Hdr.Left := MARGIN; + Hdr.Top := MARGIN; + + for I := 0 to 15 do + begin + Row := I div GRID_COLS; + Col := I mod GRID_COLS; + Btn := TSpeedButton.Create(Self); + Btn.Parent := pnlPulsanti; + Btn.Caption := ChannelCaption(I); + Btn.Left := MARGIN + Col * (CTRL_W + MARGIN); + Btn.Top := HDR_H + MARGIN + Row * (CTRL_H + 6); + Btn.Width := CTRL_W; + Btn.Height := CTRL_H; + Btn.Tag := I; + // Nessun GroupIndex: il pulsante non resta giù. Il comando è legato a + // MouseDown/MouseUp, non a OnClick, per chiudere e riaprire il contatto. + Btn.OnMouseDown := PulseButtonMouseDown; + Btn.OnMouseUp := PulseButtonMouseUp; + FPulseButtons[I] := Btn; + UpdateButtonVisual(Btn, False); + end; +end; + +procedure TMainForm.UpdateButtonVisual(ABtn: TSpeedButton; AOn: Boolean); +begin + ABtn.ParentFont := False; + if AOn then + begin + ABtn.Font.Style := [fsBold]; + ABtn.Font.Color := clGreen; + end + else + begin + ABtn.Font.Style := []; + ABtn.Font.Color := clWindowText; + end; +end; + +procedure TMainForm.BuildInputControls; +var + I: Integer; + Shp: TShape; + Lbl: TLabel; + Hdr: TLabel; +begin + Hdr := TLabel.Create(Self); + Hdr.Parent := pnlInputs; + Hdr.Caption := 'Contatto chiuso = spia verde. Grigio = aperto. ' + + 'Bordo rosso = dato non disponibile, non fidarsi di quello che mostra.'; + Hdr.Left := MARGIN; + Hdr.Top := MARGIN; + + for I := 0 to 7 do + begin + Shp := TShape.Create(Self); + Shp.Parent := pnlInputs; + Shp.Shape := stCircle; + Shp.Width := 24; + Shp.Height := 24; + Shp.Left := MARGIN + I * INPUT_SPACING; + Shp.Top := HDR_H + MARGIN; + FInputShapes[I] := Shp; + + // La serigrafia del modulo parte da DI1, i canali Modbus da 0: tenere + // tutti e due sotto gli occhi evita di sbagliare morsetto in barca. + Lbl := TLabel.Create(Self); + Lbl.Parent := pnlInputs; + Lbl.Left := Shp.Left; + Lbl.Top := Shp.Top + 30; + FInputLabels[I] := Lbl; + + FInputValid[I] := False; + FInputState[I] := False; + SetInputVisual(I, False, False); + end; +end; + +/// Distingue tre casi, non due: chiuso, aperto, e "non lo so". Un bus caduto +/// non deve somigliare a un contatto aperto. +procedure TMainForm.SetInputVisual(AIndex: Integer; AValid, AClosed: Boolean); +var + Shp: TShape; +begin + Shp := FInputShapes[AIndex]; + if not AValid then + begin + Shp.Brush.Color := clSilver; + Shp.Pen.Color := clRed; + Shp.Pen.Width := 2; + FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'n/d', [AIndex + 1, AIndex]); + end + else if AClosed then + begin + Shp.Brush.Color := clLime; + Shp.Pen.Color := clGreen; + Shp.Pen.Width := 1; + FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'CHIUSO', [AIndex + 1, AIndex]); + end + else + begin + Shp.Brush.Color := clGray; + Shp.Pen.Color := clBlack; + Shp.Pen.Width := 1; + FInputLabels[AIndex].Caption := Format('DI%d (ch%d)'#13'aperto', [AIndex + 1, AIndex]); + end; +end; + +procedure TMainForm.InvalidateInputs; +var + I: Integer; +begin + for I := 0 to 7 do + begin + FInputValid[I] := False; + SetInputVisual(I, False, False); + end; +end; + +function RawToEng(AIndex: Integer; ARaw: Word): Double; +var + Cfg: TAnalogCfg; +begin + Cfg := ANALOG_CFG[AIndex]; + if Cfg.RawMax = Cfg.RawMin then + Exit(Cfg.EngMin); + Result := Cfg.EngMin + + (Integer(ARaw) - Cfg.RawMin) * (Cfg.EngMax - Cfg.EngMin) / + (Cfg.RawMax - Cfg.RawMin); +end; + +procedure TMainForm.BuildAnalogControls; +var + I: Integer; + Lbl: TLabel; + Gauge: TTankGauge; +begin + // Il gauge è un TGraphicControl: senza doppio buffering la colonna + // sfarfalla ad ogni ciclo di polling. + pnlAnalog.DoubleBuffered := True; + + for I := 0 to 3 do + begin + Gauge := TTankGauge.Create(Self); + Gauge.Parent := pnlAnalog; + Gauge.Left := MARGIN + I * (GAUGE_W + MARGIN); + Gauge.Top := MARGIN; + Gauge.Width := GAUGE_W; + Gauge.Height := GAUGE_H; + Gauge.Title := ANALOG_CFG[I].Title; + Gauge.Units := ANALOG_CFG[I].Units; + Gauge.SetRange(ANALOG_CFG[I].EngMin, ANALOG_CFG[I].EngMax); + Gauge.SetWarnings(ANALOG_CFG[I].WarnBelow, ANALOG_CFG[I].WarnAbove); + FAnalogGauges[I] := Gauge; + + // Sotto al gauge resta il valore grezzo letto dal registro. + Lbl := TLabel.Create(Self); + Lbl.Parent := pnlAnalog; + Lbl.Caption := 'Registro: --'; + Lbl.Left := Gauge.Left; + Lbl.Top := Gauge.Top + GAUGE_H + 4; + FAnalogLabels[I] := Lbl; + end; +end; + +procedure TMainForm.SetConnectedState(AConnected: Boolean); +var + I: Integer; +begin + if not AConnected then + begin + // Senza polling i valori a video sarebbero fermi all'ultima lettura. + for I := 0 to 3 do + begin + FAnalogGauges[I].Valid := False; + FAnalogLabels[I].Caption := 'Registro: --'; + end; + InvalidateInputs; + end; + + if AConnected then + begin + btnConnect.Caption := 'Disconnetti'; + lblStatus.Caption := 'Stato: Connesso'; + lblStatus.Font.Color := clGreen; + end + else + begin + btnConnect.Caption := 'Connetti'; + lblStatus.Caption := 'Stato: Disconnesso'; + lblStatus.Font.Color := clRed; + end; + cboPort.Enabled := not AConnected; + cboBaud.Enabled := not AConnected; + tmrPoll.Enabled := AConnected; +end; + +procedure TMainForm.btnConnectClick(Sender: TObject); +begin + if Assigned(FModbus) and FModbus.IsConnected then + begin + FModbus.Disconnect; + FreeAndNil(FModbus); + SetConnectedState(False); + Log('Disconnesso.'); + Exit; + end; + + try + FModbus := TModbusRTU.Create(cboPort.Text, StrToInt(cboBaud.Text), 500); + FModbus.Connect; + SetConnectedState(True); + Log('Connesso a ' + cboPort.Text + ' @ ' + cboBaud.Text + ' baud.'); + except + on E: Exception do + begin + Log('ERRORE connessione: ' + E.Message); + FreeAndNil(FModbus); + SetConnectedState(False); + end; + end; +end; + +procedure TMainForm.SwitchButtonClick(Sender: TObject); +var + Btn: TSpeedButton; + Idx: Integer; + SlaveAddr: Integer; +begin + Btn := TSpeedButton(Sender); + UpdateButtonVisual(Btn, Btn.Down); + + if not (Assigned(FModbus) and FModbus.IsConnected) then + begin + Log('Impossibile comandare il relè: non connesso.'); + //Btn.Down := not Btn.Down; + //UpdateButtonVisual(Btn, Btn.Down); + Exit; + end; + + Idx := Btn.Tag; + SlaveAddr := StrToIntDef(edtSlaveRele.Text, 1); + try + FModbus.WriteSingleCoil(SlaveAddr, Idx, Btn.Down); + Log(Format('Interruttore canale %d -> %s', [Idx, BoolToStr(Btn.Down, True)])); + except + on E: Exception do + begin + Log('ERRORE scrittura relè: ' + E.Message); + Btn.Down := not Btn.Down; + UpdateButtonVisual(Btn, Btn.Down); + end; + end; +end; + +procedure TMainForm.PulseButtonMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + if Button = mbLeft then + SetPulseState(TSpeedButton(Sender), True); +end; + +procedure TMainForm.PulseButtonMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +begin + // Il mouse è catturato dal pulsante: il MouseUp arriva anche se il cursore + // è stato trascinato fuori, quindi il contatto viene sempre riaperto. + if Button = mbLeft then + SetPulseState(TSpeedButton(Sender), False); +end; + +procedure TMainForm.SetPulseState(ABtn: TSpeedButton; AOn: Boolean); +var + Idx: Integer; + SlaveAddr: Integer; +begin + UpdateButtonVisual(ABtn, AOn); + + if not (Assigned(FModbus) and FModbus.IsConnected) then + begin + if AOn then + Log('Impossibile comandare il relè: non connesso.'); + Exit; + end; + + Idx := ABtn.Tag; + SlaveAddr := StrToIntDef(edtSlaveRele.Text, 1); + try + FModbus.WriteSingleCoil(SlaveAddr, Idx, AOn); + Log(Format('Pulsante %s -> %s', [ChannelCaption(Idx), BoolToStr(AOn, True)])); + except + on E: Exception do + // Nessun rollback: se fallisce la chiusura si tenta comunque l'apertura + // al rilascio, così il canale non resta eccitato per un errore. + Log('ERRORE scrittura relè: ' + E.Message); + end; +end; + +procedure TMainForm.tmrPollTimer(Sender: TObject); +var + Inputs: TArray; + Analog: TArray; + I: Integer; + SlaveIO, SlaveAnalog: Integer; +begin + if not (Assigned(FModbus) and FModbus.IsConnected) then Exit; + + SlaveIO := StrToIntDef(edtSlaveIO.Text, 2); + SlaveAnalog := StrToIntDef(edtSlaveAnalog.Text, 5); + + if CBReadInput.Checked then + begin + try + Inputs := FModbus.ReadDiscreteInputs(SlaveIO, 0, 8); + for I := 0 to 7 do + begin + // Il log registra le transizioni, non i livelli: su una barca interessa + // sapere *quando* un contatto si e' chiuso, non che e' chiuso da un'ora. + if (not FInputValid[I]) or (Inputs[I] <> FInputState[I]) then + Log(Format('DI%d (ch%d) -> %s', [I + 1, I, + IfThen(Inputs[I], 'CHIUSO', 'aperto')])); + FInputState[I] := Inputs[I]; + FInputValid[I] := True; + SetInputVisual(I, True, Inputs[I]); + end; + FInputErr := ''; + except + on E: Exception do + begin + // Le spie vanno spente a "non so": lasciarle com'erano farebbe passare + // un bus caduto per un quadro tutto a posto. + if E.Message <> FInputErr then + begin + Log(Format('ERRORE lettura ingressi slave %d: %s', [SlaveIO, E.Message])); + FInputErr := E.Message; + end; + InvalidateInputs; + end; + end; + end + else + InvalidateInputs; + + if CBReadAnalog.Checked then + begin + try + Analog := FModbus.ReadHoldingRegisters(SlaveAnalog, 0, 4); + for I := 0 to 3 do + begin + FAnalogLabels[I].Caption := 'Registro: ' + IntToStr(Analog[I]); + FAnalogGauges[I].Value := RawToEng(I, Analog[I]); + end; + FAnalogErr := ''; + except + on E: Exception do + begin + if E.Message <> FAnalogErr then + begin + Log(Format('ERRORE lettura analogici slave %d: %s', [SlaveAnalog, E.Message])); + FAnalogErr := E.Message; + end; + for I := 0 to 3 do + begin + FAnalogGauges[I].Valid := False; + FAnalogLabels[I].Caption := 'Registro: --'; + end; + end; + end; + end; +end; + +end. diff --git a/uModbusRTU.pas b/uModbusRTU.pas new file mode 100644 index 0000000..18dd31c --- /dev/null +++ b/uModbusRTU.pas @@ -0,0 +1,378 @@ +unit uModbusRTU; + +{ + Libreria Modbus RTU su RS485 per Delphi + Compatibile con: moduli relè Waveshare Modbus RTU 32-Ch, + moduli I/O digitali 8-Ch, moduli acquisizione analogica 8-Ch + Usa API Win32 pura (nessuna dipendenza esterna) +} + +interface + +uses + Winapi.Windows, system.SysUtils, system.Classes; + +type + TModbusException = class(Exception); + + TModbusRTU = class + private + FHandle: THandle; + FPortName: string; + FBaudRate: Cardinal; + FTimeoutMs: Cardinal; + /// Quando e' finito l'ultimo scambio: fra un frame e l'altro il Modbus RTU + /// vuole almeno 3,5 caratteri di silenzio. + FLastFrame: UInt64; + procedure WaitInterFrame; + function CalcCRC16(const ABuf: array of Byte; ALen: Integer): Word; + function SendReceive(const ARequest: array of Byte; AExpectedLen: Integer): TBytes; + public + constructor Create(const APortName: string; ABaudRate: Cardinal = 9600; ATimeoutMs: Cardinal = 500); + destructor Destroy; override; + + procedure Connect; + procedure Disconnect; + function IsConnected: Boolean; + + // Function 01 - Read Coils (uscite relè) + function ReadCoils(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; + // Function 02 - Read Discrete Inputs (ingressi digitali) + function ReadDiscreteInputs(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; + // Function 03 - Read Holding Registers (es. ingressi analogici) + function ReadHoldingRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; + // Function 04 - Read Input Registers + function ReadInputRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; + // Function 05 - Write Single Coil (accende/spegne un relè) + procedure WriteSingleCoil(ASlaveAddr: Byte; AAddr: Word; AValue: Boolean); + // Function 06 - Write Single Register + procedure WriteSingleRegister(ASlaveAddr: Byte; AAddr, AValue: Word); + // Function 15 - Write Multiple Coils + procedure WriteMultipleCoils(ASlaveAddr: Byte; AStartAddr: Word; const AValues: array of Boolean); + + property PortName: string read FPortName; + property BaudRate: Cardinal read FBaudRate; + property TimeoutMs: Cardinal read FTimeoutMs write FTimeoutMs; + end; + +implementation + +const + INVALID_HANDLE = THandle(-1); + +{ TModbusRTU } + +constructor TModbusRTU.Create(const APortName: string; ABaudRate: Cardinal; ATimeoutMs: Cardinal); +begin + inherited Create; + FPortName := APortName; + FBaudRate := ABaudRate; + FTimeoutMs := ATimeoutMs; + FHandle := INVALID_HANDLE; +end; + +destructor TModbusRTU.Destroy; +begin + Disconnect; + inherited; +end; + +function TModbusRTU.IsConnected: Boolean; +begin + Result := FHandle <> INVALID_HANDLE; +end; + +procedure TModbusRTU.Connect; +var + DCB: TDCB; + Timeouts: TCommTimeouts; + FullName: string; +begin + if IsConnected then Exit; + + // Prefisso \\.\ necessario per COM10+ + FullName := '\\.\' + FPortName; + + FHandle := CreateFile(PChar(FullName), GENERIC_READ or GENERIC_WRITE, + 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if FHandle = INVALID_HANDLE then + raise TModbusException.CreateFmt('Impossibile aprire %s (errore %d)', [FPortName, GetLastError]); + + FillChar(DCB, SizeOf(DCB), 0); + DCB.DCBlength := SizeOf(DCB); + if not GetCommState(FHandle, DCB) then + raise TModbusException.Create('GetCommState fallita'); + + DCB.BaudRate := FBaudRate; + DCB.ByteSize := 8; + DCB.Parity := NOPARITY; + DCB.StopBits := ONESTOPBIT; + DCB.Flags := 0; // no flow control + + if not SetCommState(FHandle, DCB) then + raise TModbusException.Create('SetCommState fallita: parametri seriali non validi'); + + Timeouts.ReadIntervalTimeout := 50; + Timeouts.ReadTotalTimeoutMultiplier := 10; + Timeouts.ReadTotalTimeoutConstant := FTimeoutMs; + Timeouts.WriteTotalTimeoutMultiplier := 10; + Timeouts.WriteTotalTimeoutConstant := FTimeoutMs; + SetCommTimeouts(FHandle, Timeouts); + + PurgeComm(FHandle, PURGE_RXCLEAR or PURGE_TXCLEAR); +end; + +procedure TModbusRTU.Disconnect; +begin + if IsConnected then + begin + CloseHandle(FHandle); + FHandle := INVALID_HANDLE; + end; +end; + +function TModbusRTU.CalcCRC16(const ABuf: array of Byte; ALen: Integer): Word; +var + I, J: Integer; + CRC: Word; +begin + CRC := $FFFF; + for I := 0 to ALen - 1 do + begin + CRC := CRC xor ABuf[I]; + for J := 0 to 7 do + begin + if (CRC and $0001) <> 0 then + CRC := (CRC shr 1) xor $A001 + else + CRC := CRC shr 1; + end; + end; + Result := CRC; +end; + +procedure TModbusRTU.WaitInterFrame; +var + Silenzio, Passato: UInt64; +begin + // 3,5 caratteri da 11 bit al baud in uso, mai meno di 2 ms: a 9600 sono + // circa 4 ms. Senza questa pausa le richieste partono attaccate alla + // risposta precedente, e il modulo ogni tanto non le sente: la lettura + // salta, la spia si spegne e l'allarme riparte. Costa pochi millisecondi + // per richiesta. + if FBaudRate = 0 then + Exit; + Silenzio := (35 * 11 * 1000) div (FBaudRate * 10); + if Silenzio < 2 then + Silenzio := 2; + if FLastFrame = 0 then + Exit; + Passato := GetTickCount64 - FLastFrame; + if Passato < Silenzio then + Sleep(Silenzio - Passato); +end; + +function TModbusRTU.SendReceive(const ARequest: array of Byte; AExpectedLen: Integer): TBytes; +var + BytesWritten, BytesRead: DWORD; + RecvCRC: Word; + RecvBuf: TBytes; +begin + if not IsConnected then + raise TModbusException.Create('Porta non connessa: chiamare Connect prima'); + + WaitInterFrame; + PurgeComm(FHandle, PURGE_RXCLEAR or PURGE_TXCLEAR); + + if not WriteFile(FHandle, ARequest[0], Length(ARequest), BytesWritten, nil) then + raise TModbusException.CreateFmt('Errore scrittura seriale (%d)', [GetLastError]); + if Integer(BytesWritten) <> Length(ARequest) then + raise TModbusException.Create('Scrittura seriale incompleta'); + + SetLength(RecvBuf, AExpectedLen); + if not ReadFile(FHandle, RecvBuf[0], AExpectedLen, BytesRead, nil) then + raise TModbusException.CreateFmt('Errore lettura seriale (%d)', [GetLastError]); + + FLastFrame := GetTickCount64; + + if BytesRead = 0 then + raise TModbusException.Create('Timeout: nessuna risposta dallo slave (verificare indirizzo/cablaggio)'); + + SetLength(RecvBuf, BytesRead); + + // Il frame piu' corto possibile e' l'eccezione: indirizzo, funzione, codice, CRC. + if BytesRead < 5 then + raise TModbusException.CreateFmt('Risposta troncata: %d byte', [BytesRead]); + + // La CRC ricevuta va confrontata, non solo calcolata in trasmissione. Se due + // nodi hanno lo stesso indirizzo rispondono insieme e i frame si sovrappongono: + // senza questo controllo il risultato corrotto passerebbe per un dato buono. + RecvCRC := CalcCRC16(RecvBuf, BytesRead - 2); + if (Lo(RecvCRC) <> RecvBuf[BytesRead - 2]) or (Hi(RecvCRC) <> RecvBuf[BytesRead - 1]) then + raise TModbusException.Create('CRC errata: risposta corrotta. Possibile collisione ' + + 'fra due slave con lo stesso indirizzo, o disturbi sulla linea'); + + // Deve rispondere lo slave interrogato, non un altro. + if RecvBuf[0] <> ARequest[0] then + raise TModbusException.CreateFmt('Ha risposto lo slave %d invece del %d', + [RecvBuf[0], ARequest[0]]); + + // Eccezione Modbus: function code con bit 0x80 settato. + if (RecvBuf[1] and $80) <> 0 then + raise TModbusException.CreateFmt('Eccezione Modbus dallo slave %d, codice %d', + [RecvBuf[0], RecvBuf[2]]); + + Result := RecvBuf; +end; + +function TModbusRTU.ReadCoils(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; +var + Req: array[0..7] of Byte; + CRC: Word; + Resp: TBytes; + I: Integer; + ByteCount: Integer; +begin + Req[0] := ASlaveAddr; + Req[1] := $01; + Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr); + Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + ByteCount := (AQuantity + 7) div 8; + Resp := SendReceive(Req, 5 + ByteCount); + + SetLength(Result, AQuantity); + for I := 0 to AQuantity - 1 do + Result[I] := (Resp[3 + (I div 8)] and (1 shl (I mod 8))) <> 0; +end; + +function TModbusRTU.ReadDiscreteInputs(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; +var + Req: array[0..7] of Byte; + CRC: Word; + Resp: TBytes; + I: Integer; + ByteCount: Integer; +begin + Req[0] := ASlaveAddr; + Req[1] := $02; + Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr); + Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + ByteCount := (AQuantity + 7) div 8; + Resp := SendReceive(Req, 5 + ByteCount); + + SetLength(Result, AQuantity); + for I := 0 to AQuantity - 1 do + Result[I] := (Resp[3 + (I div 8)] and (1 shl (I mod 8))) <> 0; +end; + +function TModbusRTU.ReadHoldingRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; +var + Req: array[0..7] of Byte; + CRC: Word; + Resp: TBytes; + I: Integer; +begin + Req[0] := ASlaveAddr; + Req[1] := $03; + Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr); + Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + Resp := SendReceive(Req, 5 + AQuantity * 2); + + SetLength(Result, AQuantity); + for I := 0 to AQuantity - 1 do + Result[I] := (Resp[3 + I * 2] shl 8) or Resp[4 + I * 2]; +end; + +function TModbusRTU.ReadInputRegisters(ASlaveAddr: Byte; AStartAddr, AQuantity: Word): TArray; +var + Req: array[0..7] of Byte; + CRC: Word; + Resp: TBytes; + I: Integer; +begin + Req[0] := ASlaveAddr; + Req[1] := $04; + Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr); + Req[4] := Hi(AQuantity); Req[5] := Lo(AQuantity); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + Resp := SendReceive(Req, 5 + AQuantity * 2); + + SetLength(Result, AQuantity); + for I := 0 to AQuantity - 1 do + Result[I] := (Resp[3 + I * 2] shl 8) or Resp[4 + I * 2]; +end; + +procedure TModbusRTU.WriteSingleCoil(ASlaveAddr: Byte; AAddr: Word; AValue: Boolean); +var + Req: array[0..7] of Byte; + CRC: Word; + ValWord: Word; +begin + if AValue then ValWord := $FF00 else ValWord := $0000; + + Req[0] := ASlaveAddr; + Req[1] := $05; + Req[2] := Hi(AAddr); Req[3] := Lo(AAddr); + Req[4] := Hi(ValWord); Req[5] := Lo(ValWord); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + SendReceive(Req, 8); // risposta = eco della richiesta +end; + +procedure TModbusRTU.WriteSingleRegister(ASlaveAddr: Byte; AAddr, AValue: Word); +var + Req: array[0..7] of Byte; + CRC: Word; +begin + Req[0] := ASlaveAddr; + Req[1] := $06; + Req[2] := Hi(AAddr); Req[3] := Lo(AAddr); + Req[4] := Hi(AValue); Req[5] := Lo(AValue); + CRC := CalcCRC16(Req, 6); + Req[6] := Lo(CRC); Req[7] := Hi(CRC); + + SendReceive(Req, 8); +end; + +procedure TModbusRTU.WriteMultipleCoils(ASlaveAddr: Byte; AStartAddr: Word; const AValues: array of Boolean); +var + Req: TBytes; + ByteCount, Quantity, I: Integer; + CRC: Word; +begin + Quantity := Length(AValues); + ByteCount := (Quantity + 7) div 8; + SetLength(Req, 7 + ByteCount + 2); + + Req[0] := ASlaveAddr; + Req[1] := $0F; + Req[2] := Hi(AStartAddr); Req[3] := Lo(AStartAddr); + Req[4] := Hi(Word(Quantity)); Req[5] := Lo(Word(Quantity)); + Req[6] := ByteCount; + + FillChar(Req[7], ByteCount, 0); + for I := 0 to Quantity - 1 do + if AValues[I] then + Req[7 + (I div 8)] := Req[7 + (I div 8)] or (1 shl (I mod 8)); + + CRC := CalcCRC16(Req, 7 + ByteCount); + Req[7 + ByteCount] := Lo(CRC); + Req[8 + ByteCount] := Hi(CRC); + + SendReceive(Req, 8); // risposta fissa a 8 byte +end; + +end.