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); // Перерисовать список найденных из store (вызывается по rfDeviceList) procedure RefreshFound; 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.RefreshFound; // Рендер списка найденных из store. Пустой store во время поиска → 'Searching...'. var I: Integer; S: string; D: TDiscoveredDevice; begin if FStore = nil then Exit; LstFound.Items.Clear; if FStore.DiscoveredCount = 0 then begin LstFound.Items.Add('Searching...'); Exit; end; for I := 0 to FStore.DiscoveredCount - 1 do begin D := FStore.Discovered(I); S := D.DisplayName; if D.BoardType > 0 then S := S + ' ' + BoardTypeName(D.BoardType); LstFound.Items.Add(S); end; 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.