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 <noreply@anthropic.com>
This commit is contained in:
f.bittiandClaude Opus 5 committed
commit
4a01a2ec88
69 files changed
+11658
No files matched your search
+304
@@ -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
|
||||
/// <summary>
|
||||
/// 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.
|
||||
/// </summary>
|
||||
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.
|
||||
Reference in new issue
Block a user