fix(discovery): use system fonts and correct DPI scaling

This commit is contained in:
2026-08-05 13:49:23 +03:00
parent b7b9119339
commit 1d04973d6f
+14 -27
View File
@@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, LCLType,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend, DpiUtils;
BoardUtils, DeviceStore, RadioBackend, DpiUtils;
type
// Результат диалога
@@ -26,8 +26,6 @@ type
FResult: TDeviceDialogResult;
// UI
PanelTop: TPanel;
PanelBottom: TPanel;
PanelLeft: TPanel;
PanelRight: TPanel;
@@ -40,6 +38,7 @@ type
EdIP: TFlatEdit;
LblName: TLabel;
LblIP: TLabel;
LblAutoHint: TLabel;
LblFound: TLabel;
LstFound: TFlatListBox;
@@ -52,7 +51,6 @@ type
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
procedure BuildUI;
procedure ApplyTheme;
procedure SetStore(AStore: TDeviceStore);
procedure RefreshSavedList;
@@ -105,7 +103,6 @@ const
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;
@@ -123,18 +120,20 @@ const
constructor TDeviceDialog.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
// Форма целиком строится кодом и уже масштабирует геометрию через DpiScale.
// Автоскейл LCL поверх неё дал бы повторный множитель (125% -> 156.25%).
Scaled := False;
Caption := 'Device Selection';
Width := DpiScale(DLG_W);
Height := DpiScale(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;
ClearResult;
BuildUI;
SetTheme(DarkTheme);
@@ -163,7 +162,6 @@ begin
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := DpiScale(X); Result.Top := DpiScale(Y);
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM;
end;
@@ -172,7 +170,6 @@ procedure TDeviceDialog.BuildUI;
const
LabelH = 18;
var
LblHint: TLabel;
FieldTop, ButtonsTop, BottomTop: Integer;
begin
// --- Левая панель: сохранённые устройства ---
@@ -182,36 +179,33 @@ begin
PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL;
MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LblSaved := MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LstSaved := TFlatListBox.Create(Self);
LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(LEFT_W - PAD * 2), DpiScale(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);
LblName := MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
EdName := TFlatEdit.Create(Self);
EdName.Parent := PanelLeft;
EdName.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(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);
LblIP := MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
EdIP := TFlatEdit.Create(Self);
EdIP.Parent := PanelLeft;
EdIP.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(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';
@@ -221,8 +215,9 @@ begin
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;
LblAutoHint := MakeLbl(PanelLeft, '* = autostart',
PAD + 168, ButtonsTop + 6);
LblAutoHint.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);
@@ -236,14 +231,13 @@ begin
PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL;
MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LblFound := MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LstFound := TFlatListBox.Create(Self);
LstFound.Parent := PanelRight;
LstFound.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(RIGHT_W - PAD * 2), DpiScale(250));
LstFound.Color := CLR_BG;
LstFound.Font.Color:= CLR_TEXT;
LstFound.Font.Name := 'Courier New';
LstFound.Font.Size := 8;
LstFound.OnDblClick := @LstFoundDblClick;
@@ -254,11 +248,6 @@ begin
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);
@@ -272,7 +261,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
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;
@@ -288,7 +276,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
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;
@@ -304,7 +291,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
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;
@@ -340,6 +326,7 @@ begin
if EdName <> nil then EdName.SetAppTheme(T);
if EdIP <> nil then EdIP.SetAppTheme(T);
WalkLabels(Self);
if LblAutoHint <> nil then LblAutoHint.Font.Color := T.Amber;
Invalidate;
end;