mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
Uladzimir KarpenkaandClaude Opus 4.8
7f7f429515
Introduce DeviceStore.pas (TDeviceStore) as the single source of truth for saved devices (hpsdr_devices.ini CRUD + autostart) and the current discovery list. The controller owns one instance (created/freed in its ctor/dtor); desktop and (later) web frontends edit/render through it so the lists never diverge. Refactor TDeviceDialog to use a TDeviceStore reference instead of its own arrays + ini code. MainForm wires FDeviceDialog.Store to the controller's store, routes discovery results (DoAddDevice) and the preload-rate lookup through it (TDiscoveredDevice now carries the MAC), and drops the now-unused FDevices/TDeviceItem. Behavior-preserving for the desktop dialog. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
541 lines
15 KiB
ObjectPascal
541 lines
15 KiB
ObjectPascal
unit DeviceForm;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, ExtCtrls, ComCtrls,
|
|
BoardUtils, PlatformUtils, DeviceStore;
|
|
|
|
type
|
|
// Результат диалога
|
|
TDeviceDialogResult = record
|
|
Accepted: Boolean;
|
|
IPAddress: string;
|
|
SavedIdx: Integer; // -1 если выбрали из discovery, иначе индекс в SavedDevices
|
|
end;
|
|
|
|
{ TDeviceDialog }
|
|
TDeviceDialog = class(TForm)
|
|
private
|
|
// Общее хранилище устройств (saved+discovered) — единый источник правды,
|
|
// владелец контроллер; диалог только рендерит и редактирует через него.
|
|
FStore: TDeviceStore;
|
|
FResult: TDeviceDialogResult;
|
|
|
|
// UI
|
|
PanelTop: TPanel;
|
|
PanelBottom: TPanel;
|
|
PanelLeft: TPanel;
|
|
PanelRight: TPanel;
|
|
|
|
LblSaved: TLabel;
|
|
LstSaved: TFlatListBox;
|
|
BtnAdd: TFlatButton;
|
|
BtnRemove: TFlatButton;
|
|
BtnSetAuto: TFlatButton;
|
|
EdName: TFlatEdit;
|
|
EdIP: TFlatEdit;
|
|
LblName: TLabel;
|
|
LblIP: TLabel;
|
|
|
|
LblFound: TLabel;
|
|
LstFound: TFlatListBox;
|
|
BtnDiscover: TFlatButton;
|
|
BtnAddFound: TFlatButton;
|
|
|
|
BtnConnect: TFlatButton;
|
|
BtnCancel: TFlatButton;
|
|
|
|
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
|
|
|
|
procedure BuildUI;
|
|
procedure ApplyTheme;
|
|
procedure SetStore(AStore: TDeviceStore);
|
|
procedure RefreshSavedList;
|
|
|
|
procedure BtnDiscoverClick(Sender: TObject);
|
|
procedure BtnAddClick(Sender: TObject);
|
|
procedure BtnRemoveClick(Sender: TObject);
|
|
procedure BtnSetAutoClick(Sender: TObject);
|
|
procedure BtnAddFoundClick(Sender: TObject);
|
|
procedure BtnConnectClick(Sender: TObject);
|
|
procedure BtnCancelClick(Sender: TObject);
|
|
procedure LstSavedDblClick(Sender: TObject);
|
|
procedure LstFoundDblClick(Sender: TObject);
|
|
procedure LstSavedClick(Sender: TObject);
|
|
|
|
function MakeBtn(AParent: TWinControl; const Cap: string;
|
|
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
|
|
function MakeLbl(AParent: TWinControl; const Cap: string;
|
|
X, Y: Integer): TLabel;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
procedure SetTheme(const T: TAppTheme);
|
|
|
|
// Добавить найденное устройство (вызывается из MainForm при discovery)
|
|
procedure AddDiscovered(const IP, DisplayName: string; BoardType: Integer;
|
|
const MAC: array of Byte);
|
|
procedure ClearDiscovered;
|
|
procedure NoDevicesFound; // UI-сообщение «нет устройств» в список найденных
|
|
|
|
// Автозапуск: возвращает IP если есть устройство с AutoStart=True
|
|
function GetAutoStartIP: string;
|
|
function GetAutoStartBoardType: Integer;
|
|
function GetSavedBoardType(Idx: Integer): Integer;
|
|
|
|
// Получить/сбросить результат
|
|
procedure ClearResult;
|
|
// Общее хранилище устройств — назначается владельцем (MainForm/контроллер)
|
|
// до показа диалога; диалог рендерит и редактирует через него.
|
|
property Store: TDeviceStore read FStore write SetStore;
|
|
property DialogResult: TDeviceDialogResult read FResult;
|
|
property OnDiscover: TNotifyEvent read FOnDiscover write FOnDiscover;
|
|
end;
|
|
|
|
implementation
|
|
|
|
const
|
|
CLR_BG = TColor($00121212);
|
|
CLR_PANEL = TColor($001A1A1A);
|
|
CLR_TEXT = TColor($00E0E0E0);
|
|
CLR_TEXTDIM = TColor($00888888);
|
|
CLR_BORDER = TColor($00303030);
|
|
CLR_ACCENT = TColor($0040FF80);
|
|
CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства
|
|
DLG_W = 760;
|
|
DLG_H = 500;
|
|
GAP = 12;
|
|
PAD = 14;
|
|
BTN_H = 28;
|
|
EDIT_H = 26;
|
|
PANEL_H = 412;
|
|
LEFT_W = 348;
|
|
RIGHT_W = 372;
|
|
|
|
{ TDeviceDialog }
|
|
|
|
constructor TDeviceDialog.Create(AOwner: TComponent);
|
|
begin
|
|
inherited CreateNew(AOwner);
|
|
Caption := 'Device Selection';
|
|
Width := DLG_W;
|
|
Height := DLG_H;
|
|
Position := poScreenCenter;
|
|
BorderStyle := bsDialog;
|
|
Color := CLR_BG;
|
|
Font.Name := 'Courier New';
|
|
Font.Size := 8;
|
|
Font.Color := CLR_TEXT;
|
|
|
|
FStore := nil; // назначается владельцем через property Store до показа
|
|
FResult.Accepted := False;
|
|
|
|
BuildUI;
|
|
SetTheme(DarkTheme);
|
|
end;
|
|
|
|
procedure TDeviceDialog.SetStore(AStore: TDeviceStore);
|
|
begin
|
|
FStore := AStore;
|
|
if FStore <> nil then RefreshSavedList;
|
|
end;
|
|
|
|
function TDeviceDialog.MakeBtn(AParent: TWinControl; const Cap: string;
|
|
X, Y, W, H: Integer; AClick: TNotifyEvent): TFlatButton;
|
|
begin
|
|
Result := MakeFlatBtn(AParent, Cap, X, Y, W, H, AClick);
|
|
end;
|
|
|
|
function TDeviceDialog.MakeLbl(AParent: TWinControl; const Cap: string;
|
|
X, Y: Integer): TLabel;
|
|
begin
|
|
Result := TLabel.Create(Self);
|
|
Result.Parent := AParent;
|
|
Result.Caption := Cap;
|
|
Result.Left := X; Result.Top := Y;
|
|
Result.Font.Name := 'Courier New';
|
|
Result.Font.Size := 8;
|
|
Result.Font.Color := CLR_TEXTDIM;
|
|
end;
|
|
|
|
procedure TDeviceDialog.BuildUI;
|
|
const
|
|
LabelH = 18;
|
|
var
|
|
LblHint: TLabel;
|
|
FieldTop, ButtonsTop, BottomTop: Integer;
|
|
begin
|
|
// --- Левая панель: сохранённые устройства ---
|
|
PanelLeft := TPanel.Create(Self);
|
|
PanelLeft.Parent := Self;
|
|
PanelLeft.SetBounds(GAP, GAP, LEFT_W, PANEL_H);
|
|
PanelLeft.BevelOuter := bvNone;
|
|
PanelLeft.Color := CLR_PANEL;
|
|
|
|
MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
|
|
|
|
LstSaved := TFlatListBox.Create(Self);
|
|
LstSaved.Parent := PanelLeft;
|
|
LstSaved.SetBounds(PAD, PAD + LabelH, LEFT_W - PAD * 2, 174);
|
|
LstSaved.Color := CLR_BG;
|
|
LstSaved.Font.Color:= CLR_TEXT;
|
|
LstSaved.Font.Name := 'Courier New';
|
|
LstSaved.Font.Size := 8;
|
|
LstSaved.OnClick := @LstSavedClick;
|
|
LstSaved.OnDblClick := @LstSavedDblClick;
|
|
|
|
FieldTop := 212;
|
|
MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
|
|
EdName := TFlatEdit.Create(Self);
|
|
EdName.Parent := PanelLeft;
|
|
EdName.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
|
|
EdName.Color := CLR_BG;
|
|
EdName.Font.Color:= CLR_TEXT;
|
|
EdName.Font.Name := 'Courier New';
|
|
EdName.Font.Size := 8;
|
|
|
|
Inc(FieldTop, EDIT_H + 10);
|
|
MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
|
|
EdIP := TFlatEdit.Create(Self);
|
|
EdIP.Parent := PanelLeft;
|
|
EdIP.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
|
|
EdIP.Color := CLR_BG;
|
|
EdIP.Font.Color:= CLR_TEXT;
|
|
EdIP.Font.Name := 'Courier New';
|
|
EdIP.Font.Size := 8;
|
|
EdIP.TextHint := '192.168.1.x';
|
|
|
|
ButtonsTop := FieldTop + EDIT_H + 12;
|
|
BtnAdd := MakeBtn(PanelLeft, 'ADD', PAD, ButtonsTop, 94, BTN_H, @BtnAddClick);
|
|
BtnRemove := MakeBtn(PanelLeft, 'REMOVE', PAD + 102, ButtonsTop, 94, BTN_H, @BtnRemoveClick);
|
|
|
|
Inc(ButtonsTop, BTN_H + 8);
|
|
BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', PAD, ButtonsTop, 154, BTN_H, @BtnSetAutoClick);
|
|
LblHint := MakeLbl(PanelLeft, '* = autostart', PAD + 168, ButtonsTop + 6);
|
|
LblHint.Font.Color := CLR_AUTO;
|
|
|
|
BottomTop := PANEL_H - PAD - BTN_H - 6;
|
|
BtnConnect := MakeBtn(PanelLeft, 'CONNECT', PAD, BottomTop, LEFT_W - PAD * 2, BTN_H + 6, @BtnConnectClick);
|
|
BtnConnect.ClrText := CLR_ACCENT;
|
|
BtnConnect.ClrTextAct := CLR_ACCENT;
|
|
|
|
// --- Правая панель: discovery ---
|
|
PanelRight := TPanel.Create(Self);
|
|
PanelRight.Parent := Self;
|
|
PanelRight.SetBounds(GAP + LEFT_W + GAP, GAP, RIGHT_W, PANEL_H);
|
|
PanelRight.BevelOuter := bvNone;
|
|
PanelRight.Color := CLR_PANEL;
|
|
|
|
MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
|
|
|
|
LstFound := TFlatListBox.Create(Self);
|
|
LstFound.Parent := PanelRight;
|
|
LstFound.SetBounds(PAD, PAD + LabelH, RIGHT_W - PAD * 2, 250);
|
|
LstFound.Color := CLR_BG;
|
|
LstFound.Font.Color:= CLR_TEXT;
|
|
LstFound.Font.Name := 'Courier New';
|
|
LstFound.Font.Size := 8;
|
|
LstFound.OnDblClick := @LstFoundDblClick;
|
|
|
|
ButtonsTop := PAD + LabelH + 250 + 14;
|
|
BtnDiscover := MakeBtn(PanelRight, 'DISCOVER', PAD, ButtonsTop, 116, BTN_H, @BtnDiscoverClick);
|
|
BtnAddFound := MakeBtn(PanelRight, 'SAVE DEVICE', PAD + 128, ButtonsTop, 140, BTN_H, @BtnAddFoundClick);
|
|
|
|
BtnCancel := MakeBtn(PanelRight, 'CANCEL', RIGHT_W - PAD - 116, BottomTop, 116, BTN_H + 6, @BtnCancelClick);
|
|
end;
|
|
|
|
procedure TDeviceDialog.ApplyTheme;
|
|
begin
|
|
SetTheme(DarkTheme);
|
|
end;
|
|
|
|
procedure TDeviceDialog.SetTheme(const T: TAppTheme);
|
|
|
|
procedure StyleButton(B: TFlatButton; Active: Boolean);
|
|
begin
|
|
if B = nil then Exit;
|
|
B.Active := Active;
|
|
B.ClrNorm := T.BtnNorm;
|
|
B.ClrActive := T.BtnActive;
|
|
B.ClrHot := T.BtnHot;
|
|
if Active then B.ClrBorder := T.BtnBorderActive
|
|
else B.ClrBorder := T.BtnBorderNorm;
|
|
B.ClrText := T.BtnText;
|
|
B.ClrTextAct := T.BtnTextActive;
|
|
B.Font.Name := 'Courier New';
|
|
B.Font.Size := 8;
|
|
B.Font.Color := T.Text;
|
|
B.Invalidate;
|
|
end;
|
|
|
|
procedure StyleDiscoverButton(B: TFlatButton);
|
|
begin
|
|
if B = nil then Exit;
|
|
B.Active := False;
|
|
B.ClrNorm := T.TbDiscoverNorm;
|
|
B.ClrHot := T.TbDiscoverHot;
|
|
B.ClrActive := T.TbDiscoverHot;
|
|
B.ClrBorder := T.TbDiscoverBorder;
|
|
B.ClrText := T.TbDiscoverText;
|
|
B.ClrTextAct := T.TbDiscoverText;
|
|
B.Font.Name := 'Courier New';
|
|
B.Font.Size := 8;
|
|
B.Font.Color := T.TbDiscoverText;
|
|
B.Invalidate;
|
|
end;
|
|
|
|
procedure StyleConnectButton(B: TFlatButton);
|
|
begin
|
|
if B = nil then Exit;
|
|
B.Active := False;
|
|
B.ClrNorm := T.TbStartNorm;
|
|
B.ClrActive := T.BtnActive;
|
|
B.ClrHot := T.BtnHot;
|
|
B.ClrBorder := T.TbStartBorder;
|
|
B.ClrText := T.TbStartText;
|
|
B.ClrTextAct := T.TbStartText;
|
|
B.Font.Name := 'Courier New';
|
|
B.Font.Size := 8;
|
|
B.Font.Color := T.TbStartText;
|
|
B.Invalidate;
|
|
end;
|
|
|
|
procedure WalkLabels(C: TWinControl);
|
|
var i: Integer; Ctrl: TControl;
|
|
begin
|
|
for i := 0 to C.ControlCount - 1 do
|
|
begin
|
|
Ctrl := C.Controls[i];
|
|
if Ctrl is TLabel then
|
|
TLabel(Ctrl).Font.Color := T.TextDim
|
|
else if Ctrl is TWinControl then
|
|
WalkLabels(TWinControl(Ctrl));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
Color := T.BG;
|
|
Font.Color := T.Text;
|
|
if PanelLeft <> nil then PanelLeft.Color := T.Panel;
|
|
if PanelRight <> nil then PanelRight.Color := T.Panel;
|
|
if LstSaved <> nil then LstSaved.SetAppTheme(T);
|
|
if LstFound <> nil then LstFound.SetAppTheme(T);
|
|
StyleButton(BtnAdd, False);
|
|
StyleButton(BtnRemove, False);
|
|
StyleButton(BtnSetAuto, False);
|
|
StyleDiscoverButton(BtnDiscover);
|
|
StyleButton(BtnAddFound, False);
|
|
StyleButton(BtnCancel, False);
|
|
StyleConnectButton(BtnConnect);
|
|
if EdName <> nil then EdName.SetAppTheme(T);
|
|
if EdIP <> nil then EdIP.SetAppTheme(T);
|
|
WalkLabels(Self);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TDeviceDialog.RefreshSavedList;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
LstSaved.Items.Clear;
|
|
if FStore = nil then Exit;
|
|
for I := 0 to FStore.SavedCount - 1 do
|
|
LstSaved.Items.Add(FStore.SavedDisplay(I));
|
|
end;
|
|
|
|
procedure TDeviceDialog.LstSavedClick(Sender: TObject);
|
|
var
|
|
Idx: Integer;
|
|
Dev: TSavedDevice;
|
|
begin
|
|
Idx := LstSaved.ItemIndex;
|
|
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then Exit;
|
|
Dev := FStore.Saved(Idx);
|
|
EdName.Text := Dev.Name;
|
|
EdIP.Text := Dev.IPAddress;
|
|
end;
|
|
|
|
procedure TDeviceDialog.LstSavedDblClick(Sender: TObject);
|
|
begin
|
|
BtnConnectClick(nil);
|
|
end;
|
|
|
|
procedure TDeviceDialog.LstFoundDblClick(Sender: TObject);
|
|
begin
|
|
BtnConnectClick(nil);
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnDiscoverClick(Sender: TObject);
|
|
begin
|
|
LstFound.Items.Clear;
|
|
LstFound.Items.Add('Searching...');
|
|
if Assigned(FOnDiscover) then
|
|
FOnDiscover(Self);
|
|
end;
|
|
|
|
procedure TDeviceDialog.ClearDiscovered;
|
|
begin
|
|
if FStore <> nil then FStore.ClearDiscovered;
|
|
LstFound.Items.Clear;
|
|
end;
|
|
|
|
procedure TDeviceDialog.AddDiscovered(const IP, DisplayName: string; BoardType: Integer;
|
|
const MAC: array of Byte);
|
|
var
|
|
S: string;
|
|
begin
|
|
if FStore = nil then Exit;
|
|
if (LstFound.Items.Count = 1) and (LstFound.Items[0] = 'Searching...') then
|
|
LstFound.Items.Clear;
|
|
|
|
FStore.AddDiscovered(IP, DisplayName, BoardType, MAC);
|
|
|
|
S := DisplayName;
|
|
if BoardType > 0 then
|
|
S := S + ' ' + BoardTypeName(BoardType);
|
|
LstFound.Items.Add(S);
|
|
end;
|
|
|
|
procedure TDeviceDialog.NoDevicesFound;
|
|
begin
|
|
ClearDiscovered;
|
|
LstFound.Items.Add('-- no device found --');
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnAddClick(Sender: TObject);
|
|
var
|
|
Idx: Integer;
|
|
begin
|
|
if FStore = nil then Exit;
|
|
if Trim(EdIP.Text) = '' then
|
|
begin
|
|
ShowMessage('Enter IP address');
|
|
Exit;
|
|
end;
|
|
Idx := FStore.AddSaved(EdName.Text, EdIP.Text, 0);
|
|
RefreshSavedList;
|
|
LstSaved.ItemIndex := Idx;
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnRemoveClick(Sender: TObject);
|
|
var
|
|
Idx: Integer;
|
|
begin
|
|
Idx := LstSaved.ItemIndex;
|
|
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then Exit;
|
|
FStore.RemoveSaved(Idx);
|
|
RefreshSavedList;
|
|
EdName.Text := '';
|
|
EdIP.Text := '';
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnSetAutoClick(Sender: TObject);
|
|
var
|
|
Idx: Integer;
|
|
begin
|
|
Idx := LstSaved.ItemIndex;
|
|
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.SavedCount) then
|
|
begin
|
|
ShowMessage('Select a device first');
|
|
Exit;
|
|
end;
|
|
FStore.SetAutoStart(Idx);
|
|
RefreshSavedList;
|
|
LstSaved.ItemIndex := Idx;
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnAddFoundClick(Sender: TObject);
|
|
var
|
|
Idx, NewIdx: Integer;
|
|
D: TDiscoveredDevice;
|
|
begin
|
|
Idx := LstFound.ItemIndex;
|
|
if (FStore = nil) or (Idx < 0) or (Idx >= FStore.DiscoveredCount) then
|
|
begin
|
|
ShowMessage('Select a discovered device first');
|
|
Exit;
|
|
end;
|
|
D := FStore.Discovered(Idx);
|
|
NewIdx := FStore.AddSaved(D.DisplayName, D.IPAddress, D.BoardType);
|
|
RefreshSavedList;
|
|
LstSaved.ItemIndex := NewIdx;
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnConnectClick(Sender: TObject);
|
|
var
|
|
IP: string;
|
|
Idx: Integer;
|
|
begin
|
|
IP := '';
|
|
if FStore = nil then Exit;
|
|
|
|
// Приоритет: выбранное сохранённое > выбранное найденное > ручной IP
|
|
Idx := LstSaved.ItemIndex;
|
|
if (Idx >= 0) and (Idx < FStore.SavedCount) then
|
|
begin
|
|
IP := FStore.Saved(Idx).IPAddress;
|
|
FResult.SavedIdx := Idx;
|
|
end
|
|
else
|
|
begin
|
|
Idx := LstFound.ItemIndex;
|
|
if (Idx >= 0) and (Idx < FStore.DiscoveredCount) then
|
|
begin
|
|
IP := FStore.Discovered(Idx).IPAddress;
|
|
FResult.SavedIdx := -1;
|
|
end
|
|
else if Trim(EdIP.Text) <> '' then
|
|
begin
|
|
IP := Trim(EdIP.Text);
|
|
FResult.SavedIdx := -1;
|
|
end;
|
|
end;
|
|
|
|
if IP = '' then
|
|
begin
|
|
ShowMessage('Select or enter a device to connect');
|
|
Exit;
|
|
end;
|
|
|
|
FResult.Accepted := True;
|
|
FResult.IPAddress := IP;
|
|
ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure TDeviceDialog.BtnCancelClick(Sender: TObject);
|
|
begin
|
|
FResult.Accepted := False;
|
|
ModalResult := mrCancel;
|
|
end;
|
|
|
|
procedure TDeviceDialog.ClearResult;
|
|
begin
|
|
FResult.Accepted := False;
|
|
FResult.IPAddress := '';
|
|
FResult.SavedIdx := -1;
|
|
end;
|
|
|
|
function TDeviceDialog.GetAutoStartIP: string;
|
|
begin
|
|
if FStore <> nil then Result := FStore.AutoStartIP
|
|
else Result := '';
|
|
end;
|
|
|
|
function TDeviceDialog.GetAutoStartBoardType: Integer;
|
|
begin
|
|
if FStore <> nil then Result := FStore.AutoStartBoardType
|
|
else Result := 0;
|
|
end;
|
|
|
|
function TDeviceDialog.GetSavedBoardType(Idx: Integer): Integer;
|
|
begin
|
|
if FStore <> nil then Result := FStore.SavedBoardType(Idx)
|
|
else Result := 0;
|
|
end;
|
|
|
|
end.
|