unit DeviceForm; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, IniFiles, BoardUtils, PlatformUtils; const DEVICE_CFG_NAME = 'hpsdr_devices.ini'; type // Запись о сохранённом устройстве TSavedDevice = record Name: string; // пользовательское имя IPAddress: string; BoardType: Integer; AutoStart: Boolean; // запускать автоматически при старте end; // Результат диалога TDeviceDialogResult = record Accepted: Boolean; IPAddress: string; SavedIdx: Integer; // -1 если выбрали из discovery, иначе индекс в SavedDevices end; { TDeviceDialog } TDeviceDialog = class(TForm) private // Сохранённые устройства FSavedDevices: array of TSavedDevice; FSavedCount: Integer; FResult: TDeviceDialogResult; // Discovered devices (IP strings) FDiscoveredIPs: array of string; FDiscoveredNames: array of string; FDiscoveredBoardTypes: array of Integer; FDiscoveredCount: Integer; // 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 LoadSaved; procedure SaveSaved; 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 = 0); procedure ClearDiscovered; // Автозапуск: возвращает IP если есть устройство с AutoStart=True function GetAutoStartIP: string; function GetAutoStartBoardType: Integer; function GetSavedBoardType(Idx: Integer): Integer; // Получить/сбросить результат procedure ClearResult; property DialogResult: TDeviceDialogResult read FResult; property OnDiscover: TNotifyEvent read FOnDiscover write FOnDiscover; property SavedCount: Integer read FSavedCount; 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; FSavedCount := 0; FDiscoveredCount := 0; FResult.Accepted := False; BuildUI; SetTheme(DarkTheme); LoadSaved; 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.LoadSaved; var Ini: TIniFile; I, N: Integer; Section: string; begin FSavedCount := 0; if not FileExists(GetAppCfgDir + DEVICE_CFG_NAME) then Exit; Ini := TIniFile.Create(GetAppCfgDir + DEVICE_CFG_NAME); try N := Ini.ReadInteger('Devices', 'Count', 0); SetLength(FSavedDevices, N); for I := 0 to N - 1 do begin Section := 'Device' + IntToStr(I); FSavedDevices[I].Name := Ini.ReadString (Section, 'Name', 'HPSDR'); FSavedDevices[I].IPAddress := Ini.ReadString (Section, 'IP', ''); FSavedDevices[I].BoardType := Ini.ReadInteger(Section, 'BoardType', 0); FSavedDevices[I].AutoStart := Ini.ReadBool (Section, 'AutoStart', False); Inc(FSavedCount); end; finally Ini.Free; end; end; procedure TDeviceDialog.SaveSaved; var Ini: TIniFile; I: Integer; Section: string; begin Ini := TIniFile.Create(GetAppCfgDir + DEVICE_CFG_NAME); try Ini.WriteInteger('Devices', 'Count', FSavedCount); for I := 0 to FSavedCount - 1 do begin Section := 'Device' + IntToStr(I); Ini.WriteString (Section, 'Name', FSavedDevices[I].Name); Ini.WriteString (Section, 'IP', FSavedDevices[I].IPAddress); Ini.WriteInteger(Section, 'BoardType', FSavedDevices[I].BoardType); Ini.WriteBool (Section, 'AutoStart', FSavedDevices[I].AutoStart); end; finally Ini.Free; end; end; procedure TDeviceDialog.RefreshSavedList; var I: Integer; S: string; begin LstSaved.Items.Clear; for I := 0 to FSavedCount - 1 do begin S := FSavedDevices[I].Name + ' [' + FSavedDevices[I].IPAddress + ']'; if FSavedDevices[I].BoardType > 0 then S := S + ' ' + BoardTypeName(FSavedDevices[I].BoardType); if FSavedDevices[I].AutoStart then S := '* ' + S; LstSaved.Items.Add(S); end; end; procedure TDeviceDialog.LstSavedClick(Sender: TObject); var Idx: Integer; begin Idx := LstSaved.ItemIndex; if (Idx < 0) or (Idx >= FSavedCount) then Exit; EdName.Text := FSavedDevices[Idx].Name; EdIP.Text := FSavedDevices[Idx].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 FDiscoveredCount := 0; SetLength(FDiscoveredIPs, 0); SetLength(FDiscoveredNames, 0); SetLength(FDiscoveredBoardTypes, 0); LstFound.Items.Clear; end; procedure TDeviceDialog.AddDiscovered(const IP, DisplayName: string; BoardType: Integer = 0); var Idx: Integer; S: string; begin if (LstFound.Items.Count = 1) and (LstFound.Items[0] = 'Searching...') then LstFound.Items.Clear; Idx := FDiscoveredCount; Inc(FDiscoveredCount); SetLength(FDiscoveredIPs, FDiscoveredCount); SetLength(FDiscoveredNames, FDiscoveredCount); SetLength(FDiscoveredBoardTypes, FDiscoveredCount); FDiscoveredIPs[Idx] := IP; FDiscoveredNames[Idx] := DisplayName; FDiscoveredBoardTypes[Idx] := BoardType; S := DisplayName; if BoardType > 0 then S := S + ' ' + BoardTypeName(BoardType); LstFound.Items.Add(S); end; procedure TDeviceDialog.BtnAddClick(Sender: TObject); var Idx: Integer; begin if Trim(EdIP.Text) = '' then begin ShowMessage('Enter IP address'); Exit; end; Idx := FSavedCount; Inc(FSavedCount); SetLength(FSavedDevices, FSavedCount); FSavedDevices[Idx].Name := Trim(EdName.Text); if FSavedDevices[Idx].Name = '' then FSavedDevices[Idx].Name := 'HPSDR'; FSavedDevices[Idx].IPAddress := Trim(EdIP.Text); FSavedDevices[Idx].BoardType := 0; FSavedDevices[Idx].AutoStart := False; SaveSaved; RefreshSavedList; LstSaved.ItemIndex := Idx; end; procedure TDeviceDialog.BtnRemoveClick(Sender: TObject); var Idx, I: Integer; begin Idx := LstSaved.ItemIndex; if (Idx < 0) or (Idx >= FSavedCount) then Exit; for I := Idx to FSavedCount - 2 do FSavedDevices[I] := FSavedDevices[I + 1]; Dec(FSavedCount); SetLength(FSavedDevices, FSavedCount); SaveSaved; RefreshSavedList; EdName.Text := ''; EdIP.Text := ''; end; procedure TDeviceDialog.BtnSetAutoClick(Sender: TObject); var Idx, I: Integer; begin Idx := LstSaved.ItemIndex; if (Idx < 0) or (Idx >= FSavedCount) then begin ShowMessage('Select a device first'); Exit; end; // Только одно устройство может быть AutoStart for I := 0 to FSavedCount - 1 do FSavedDevices[I].AutoStart := (I = Idx); SaveSaved; RefreshSavedList; LstSaved.ItemIndex := Idx; end; procedure TDeviceDialog.BtnAddFoundClick(Sender: TObject); var Idx: Integer; begin Idx := LstFound.ItemIndex; if (Idx < 0) or (Idx >= FDiscoveredCount) then begin ShowMessage('Select a discovered device first'); Exit; end; EdIP.Text := FDiscoveredIPs[Idx]; EdName.Text := FDiscoveredNames[Idx]; BtnAddClick(nil); // Обновляем BoardType только что добавленной записи if FSavedCount > 0 then begin FSavedDevices[FSavedCount - 1].BoardType := FDiscoveredBoardTypes[Idx]; SaveSaved; RefreshSavedList; LstSaved.ItemIndex := FSavedCount - 1; end; end; procedure TDeviceDialog.BtnConnectClick(Sender: TObject); var IP: string; Idx: Integer; begin IP := ''; // Приоритет: выбранное сохранённое > выбранное найденное > ручной IP Idx := LstSaved.ItemIndex; if (Idx >= 0) and (Idx < FSavedCount) then begin IP := FSavedDevices[Idx].IPAddress; FResult.SavedIdx := Idx; end else begin Idx := LstFound.ItemIndex; if (Idx >= 0) and (Idx < FDiscoveredCount) then begin IP := FDiscoveredIPs[Idx]; 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; var I: Integer; begin Result := ''; for I := 0 to FSavedCount - 1 do if FSavedDevices[I].AutoStart then begin Result := FSavedDevices[I].IPAddress; Exit; end; end; function TDeviceDialog.GetAutoStartBoardType: Integer; var I: Integer; begin Result := 0; for I := 0 to FSavedCount - 1 do if FSavedDevices[I].AutoStart then begin Result := FSavedDevices[I].BoardType; Exit; end; end; function TDeviceDialog.GetSavedBoardType(Idx: Integer): Integer; begin if (Idx >= 0) and (Idx < FSavedCount) then Result := FSavedDevices[Idx].BoardType else Result := 0; end; end.