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 uses
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls, LCLType, StdCtrls, ExtCtrls, ComCtrls, LCLType,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend, DpiUtils; BoardUtils, DeviceStore, RadioBackend, DpiUtils;
type type
// Результат диалога // Результат диалога
@@ -26,8 +26,6 @@ type
FResult: TDeviceDialogResult; FResult: TDeviceDialogResult;
// UI // UI
PanelTop: TPanel;
PanelBottom: TPanel;
PanelLeft: TPanel; PanelLeft: TPanel;
PanelRight: TPanel; PanelRight: TPanel;
@@ -40,6 +38,7 @@ type
EdIP: TFlatEdit; EdIP: TFlatEdit;
LblName: TLabel; LblName: TLabel;
LblIP: TLabel; LblIP: TLabel;
LblAutoHint: TLabel;
LblFound: TLabel; LblFound: TLabel;
LstFound: TFlatListBox; LstFound: TFlatListBox;
@@ -52,7 +51,6 @@ type
FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery FOnDiscover: TNotifyEvent; // внешний callback для запуска discovery
procedure BuildUI; procedure BuildUI;
procedure ApplyTheme;
procedure SetStore(AStore: TDeviceStore); procedure SetStore(AStore: TDeviceStore);
procedure RefreshSavedList; procedure RefreshSavedList;
@@ -105,7 +103,6 @@ const
CLR_PANEL = TColor($001A1A1A); CLR_PANEL = TColor($001A1A1A);
CLR_TEXT = TColor($00E0E0E0); CLR_TEXT = TColor($00E0E0E0);
CLR_TEXTDIM = TColor($00888888); CLR_TEXTDIM = TColor($00888888);
CLR_BORDER = TColor($00303030);
CLR_ACCENT = TColor($0040FF80); CLR_ACCENT = TColor($0040FF80);
CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства CLR_AUTO = TColor($0000CCFF); // цвет авто-устройства
DLG_W = 760; DLG_W = 760;
@@ -123,18 +120,20 @@ const
constructor TDeviceDialog.Create(AOwner: TComponent); constructor TDeviceDialog.Create(AOwner: TComponent);
begin begin
inherited CreateNew(AOwner); inherited CreateNew(AOwner);
// Форма целиком строится кодом и уже масштабирует геометрию через DpiScale.
// Автоскейл LCL поверх неё дал бы повторный множитель (125% -> 156.25%).
Scaled := False;
Caption := 'Device Selection'; Caption := 'Device Selection';
Width := DpiScale(DLG_W); Width := DpiScale(DLG_W);
Height := DpiScale(DLG_H); Height := DpiScale(DLG_H);
Position := poScreenCenter; Position := poScreenCenter;
BorderStyle := bsDialog; BorderStyle := bsDialog;
Color := CLR_BG; Color := CLR_BG;
Font.Name := 'Courier New';
Font.Size := 8; Font.Size := 8;
Font.Color := CLR_TEXT; Font.Color := CLR_TEXT;
FStore := nil; // назначается владельцем через property Store до показа FStore := nil; // назначается владельцем через property Store до показа
FResult.Accepted := False; ClearResult;
BuildUI; BuildUI;
SetTheme(DarkTheme); SetTheme(DarkTheme);
@@ -163,7 +162,6 @@ begin
Result.Parent := AParent; Result.Parent := AParent;
Result.Caption := Cap; Result.Caption := Cap;
Result.Left := DpiScale(X); Result.Top := DpiScale(Y); Result.Left := DpiScale(X); Result.Top := DpiScale(Y);
Result.Font.Name := 'Courier New';
Result.Font.Size := 8; Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM; Result.Font.Color := CLR_TEXTDIM;
end; end;
@@ -172,7 +170,6 @@ procedure TDeviceDialog.BuildUI;
const const
LabelH = 18; LabelH = 18;
var var
LblHint: TLabel;
FieldTop, ButtonsTop, BottomTop: Integer; FieldTop, ButtonsTop, BottomTop: Integer;
begin begin
// --- Левая панель: сохранённые устройства --- // --- Левая панель: сохранённые устройства ---
@@ -182,36 +179,33 @@ begin
PanelLeft.BevelOuter := bvNone; PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL; PanelLeft.Color := CLR_PANEL;
MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD); LblSaved := MakeLbl(PanelLeft, 'SAVED DEVICES', PAD, PAD);
LstSaved := TFlatListBox.Create(Self); LstSaved := TFlatListBox.Create(Self);
LstSaved.Parent := PanelLeft; LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(LEFT_W - PAD * 2), DpiScale(174)); LstSaved.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(LEFT_W - PAD * 2), DpiScale(174));
LstSaved.Color := CLR_BG; LstSaved.Color := CLR_BG;
LstSaved.Font.Color:= CLR_TEXT; LstSaved.Font.Color:= CLR_TEXT;
LstSaved.Font.Name := 'Courier New';
LstSaved.Font.Size := 8; LstSaved.Font.Size := 8;
LstSaved.OnClick := @LstSavedClick; LstSaved.OnClick := @LstSavedClick;
LstSaved.OnDblClick := @LstSavedDblClick; LstSaved.OnDblClick := @LstSavedDblClick;
FieldTop := 212; FieldTop := 212;
MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5); LblName := MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
EdName := TFlatEdit.Create(Self); EdName := TFlatEdit.Create(Self);
EdName.Parent := PanelLeft; EdName.Parent := PanelLeft;
EdName.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H)); EdName.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H));
EdName.Color := CLR_BG; EdName.Color := CLR_BG;
EdName.Font.Color:= CLR_TEXT; EdName.Font.Color:= CLR_TEXT;
EdName.Font.Name := 'Courier New';
EdName.Font.Size := 8; EdName.Font.Size := 8;
Inc(FieldTop, EDIT_H + 10); Inc(FieldTop, EDIT_H + 10);
MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5); LblIP := MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
EdIP := TFlatEdit.Create(Self); EdIP := TFlatEdit.Create(Self);
EdIP.Parent := PanelLeft; EdIP.Parent := PanelLeft;
EdIP.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H)); EdIP.SetBounds(DpiScale(76), DpiScale(FieldTop), DpiScale(LEFT_W - 76 - PAD), DpiScale(EDIT_H));
EdIP.Color := CLR_BG; EdIP.Color := CLR_BG;
EdIP.Font.Color:= CLR_TEXT; EdIP.Font.Color:= CLR_TEXT;
EdIP.Font.Name := 'Courier New';
EdIP.Font.Size := 8; EdIP.Font.Size := 8;
EdIP.TextHint := '192.168.1.x'; EdIP.TextHint := '192.168.1.x';
@@ -221,8 +215,9 @@ begin
Inc(ButtonsTop, BTN_H + 8); Inc(ButtonsTop, BTN_H + 8);
BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', PAD, ButtonsTop, 154, BTN_H, @BtnSetAutoClick); BtnSetAuto := MakeBtn(PanelLeft, 'SET AUTOSTART', PAD, ButtonsTop, 154, BTN_H, @BtnSetAutoClick);
LblHint := MakeLbl(PanelLeft, '* = autostart', PAD + 168, ButtonsTop + 6); LblAutoHint := MakeLbl(PanelLeft, '* = autostart',
LblHint.Font.Color := CLR_AUTO; PAD + 168, ButtonsTop + 6);
LblAutoHint.Font.Color := CLR_AUTO;
BottomTop := PANEL_H - PAD - BTN_H - 6; BottomTop := PANEL_H - PAD - BTN_H - 6;
BtnConnect := MakeBtn(PanelLeft, 'CONNECT', PAD, BottomTop, LEFT_W - PAD * 2, BTN_H + 6, @BtnConnectClick); BtnConnect := MakeBtn(PanelLeft, 'CONNECT', PAD, BottomTop, LEFT_W - PAD * 2, BTN_H + 6, @BtnConnectClick);
@@ -236,14 +231,13 @@ begin
PanelRight.BevelOuter := bvNone; PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL; PanelRight.Color := CLR_PANEL;
MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD); LblFound := MakeLbl(PanelRight, 'DISCOVERED DEVICES', PAD, PAD);
LstFound := TFlatListBox.Create(Self); LstFound := TFlatListBox.Create(Self);
LstFound.Parent := PanelRight; LstFound.Parent := PanelRight;
LstFound.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(RIGHT_W - PAD * 2), DpiScale(250)); LstFound.SetBounds(DpiScale(PAD), DpiScale(PAD + LabelH), DpiScale(RIGHT_W - PAD * 2), DpiScale(250));
LstFound.Color := CLR_BG; LstFound.Color := CLR_BG;
LstFound.Font.Color:= CLR_TEXT; LstFound.Font.Color:= CLR_TEXT;
LstFound.Font.Name := 'Courier New';
LstFound.Font.Size := 8; LstFound.Font.Size := 8;
LstFound.OnDblClick := @LstFoundDblClick; LstFound.OnDblClick := @LstFoundDblClick;
@@ -254,11 +248,6 @@ begin
BtnCancel := MakeBtn(PanelRight, 'CANCEL', RIGHT_W - PAD - 116, BottomTop, 116, BTN_H + 6, @BtnCancelClick); BtnCancel := MakeBtn(PanelRight, 'CANCEL', RIGHT_W - PAD - 116, BottomTop, 116, BTN_H + 6, @BtnCancelClick);
end; end;
procedure TDeviceDialog.ApplyTheme;
begin
SetTheme(DarkTheme);
end;
procedure TDeviceDialog.SetTheme(const T: TAppTheme); procedure TDeviceDialog.SetTheme(const T: TAppTheme);
procedure StyleButton(B: TFlatButton; Active: Boolean); procedure StyleButton(B: TFlatButton; Active: Boolean);
@@ -272,7 +261,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
else B.ClrBorder := T.BtnBorderNorm; else B.ClrBorder := T.BtnBorderNorm;
B.ClrText := T.BtnText; B.ClrText := T.BtnText;
B.ClrTextAct := T.BtnTextActive; B.ClrTextAct := T.BtnTextActive;
B.Font.Name := 'Courier New';
B.Font.Size := 8; B.Font.Size := 8;
B.Font.Color := T.Text; B.Font.Color := T.Text;
B.Invalidate; B.Invalidate;
@@ -288,7 +276,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
B.ClrBorder := T.TbDiscoverBorder; B.ClrBorder := T.TbDiscoverBorder;
B.ClrText := T.TbDiscoverText; B.ClrText := T.TbDiscoverText;
B.ClrTextAct := T.TbDiscoverText; B.ClrTextAct := T.TbDiscoverText;
B.Font.Name := 'Courier New';
B.Font.Size := 8; B.Font.Size := 8;
B.Font.Color := T.TbDiscoverText; B.Font.Color := T.TbDiscoverText;
B.Invalidate; B.Invalidate;
@@ -304,7 +291,6 @@ procedure TDeviceDialog.SetTheme(const T: TAppTheme);
B.ClrBorder := T.TbStartBorder; B.ClrBorder := T.TbStartBorder;
B.ClrText := T.TbStartText; B.ClrText := T.TbStartText;
B.ClrTextAct := T.TbStartText; B.ClrTextAct := T.TbStartText;
B.Font.Name := 'Courier New';
B.Font.Size := 8; B.Font.Size := 8;
B.Font.Color := T.TbStartText; B.Font.Color := T.TbStartText;
B.Invalidate; B.Invalidate;
@@ -340,6 +326,7 @@ begin
if EdName <> nil then EdName.SetAppTheme(T); if EdName <> nil then EdName.SetAppTheme(T);
if EdIP <> nil then EdIP.SetAppTheme(T); if EdIP <> nil then EdIP.SetAppTheme(T);
WalkLabels(Self); WalkLabels(Self);
if LblAutoHint <> nil then LblAutoHint.Font.Color := T.Amber;
Invalidate; Invalidate;
end; end;