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
@@ -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<TImageEntry>;
|
||||
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<TImageEntry>.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.
|
||||
Reference in new issue
Block a user