f.bittiandClaude Opus 5
4a01a2ec88
Due programmi che condividono uModbusRTU e uGauge: - Console/PlanciaConsole: plancia nautica descritta da file XML, con modalita' plancia e modalita' configurazione. Comandi, spie, selettori, strumenti e allarmi sonori; il bus gira in un thread suo perche' la finestra non si fermi mai. - ProjectPlancia: il programma di prova piu' vecchio, usato per collaudare i canali. Le plance sono in Console/*.xml, la documentazione in Console/LEGGIMI.md. Esclusi dal versionamento i compilati (.exe, .dcu), i file dell'IDE e un audio da 17 MB. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
2393 lines
71 KiB
ObjectPascal
2393 lines
71 KiB
ObjectPascal
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<TPlanciaElement>;
|
|
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<TPlanciaElement>.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.
|