fix(ui): DPI-масштабирование SettingsForm/DeviceForm + общий DpiScale

Вся раскладка окон, построенных кодом (SettingsForm, DeviceForm), была
захардкожена в пикселях под неявные 96 DPI — на Windows 125-200% или
HiDPI-десктопах контролы физически не росли вместе с укрупнившимся
шрифтом. Добавлено масштабирование SetBounds через MulDiv(V,
Screen.PixelsPerInch, 96) на каждой листовой точке потребления
(const-блоки раскладки не трогались).

Общий DpiScale вынесен в новый юнит DpiUtils.pas — убрана дублированная
копия одноимённого приватного метода в 9 классах (FlatCheckBox,
FlatComboBox, FlatListBox, FlatSpinEdit, FlatFloatSpinEdit, FlatEdit,
FlatRadioButton, FlatPopupMenu, SettingsForm, DeviceForm) и инлайн-MulDiv
без обёртки в MainForm.pas/PanafallPanel.pas.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
This commit is contained in:
2026-07-29 16:05:39 +03:00
co-authored by Claude Sonnet 5
parent 041bc6ba7a
commit c95620fb23
14 changed files with 222 additions and 237 deletions
+16 -12
View File
@@ -6,8 +6,8 @@ interface
uses
Classes, SysUtils, FlatButton, FlatEdit, FlatListBox, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, ComCtrls,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend;
StdCtrls, ExtCtrls, ComCtrls, LCLType,
BoardUtils, PlatformUtils, DeviceStore, RadioBackend, DpiUtils;
type
// Результат диалога
@@ -124,8 +124,8 @@ constructor TDeviceDialog.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'Device Selection';
Width := DLG_W;
Height := DLG_H;
Width := DpiScale(DLG_W);
Height := DpiScale(DLG_H);
Position := poScreenCenter;
BorderStyle := bsDialog;
Color := CLR_BG;
@@ -149,7 +149,11 @@ 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);
// MakeFlatBtn — общая фабрика в FlatButton.pas, используется и другими
// окнами (PanafallPanel/PopSignalPopup/...) со своей раскладкой; масштаб
// применяем только здесь, на границе вызова из DeviceForm, а не внутри
// самой MakeFlatBtn (иначе задело бы все остальные вызовы).
Result := MakeFlatBtn(AParent, Cap, DpiScale(X), DpiScale(Y), DpiScale(W), DpiScale(H), AClick);
end;
function TDeviceDialog.MakeLbl(AParent: TWinControl; const Cap: string;
@@ -158,7 +162,7 @@ begin
Result := TLabel.Create(Self);
Result.Parent := AParent;
Result.Caption := Cap;
Result.Left := X; Result.Top := Y;
Result.Left := DpiScale(X); Result.Top := DpiScale(Y);
Result.Font.Name := 'Courier New';
Result.Font.Size := 8;
Result.Font.Color := CLR_TEXTDIM;
@@ -174,7 +178,7 @@ begin
// --- Левая панель: сохранённые устройства ---
PanelLeft := TPanel.Create(Self);
PanelLeft.Parent := Self;
PanelLeft.SetBounds(GAP, GAP, LEFT_W, PANEL_H);
PanelLeft.SetBounds(DpiScale(GAP), DpiScale(GAP), DpiScale(LEFT_W), DpiScale(PANEL_H));
PanelLeft.BevelOuter := bvNone;
PanelLeft.Color := CLR_PANEL;
@@ -182,7 +186,7 @@ begin
LstSaved := TFlatListBox.Create(Self);
LstSaved.Parent := PanelLeft;
LstSaved.SetBounds(PAD, PAD + LabelH, LEFT_W - PAD * 2, 174);
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';
@@ -194,7 +198,7 @@ begin
MakeLbl(PanelLeft, 'Name:', PAD, FieldTop + 5);
EdName := TFlatEdit.Create(Self);
EdName.Parent := PanelLeft;
EdName.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
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';
@@ -204,7 +208,7 @@ begin
MakeLbl(PanelLeft, 'IP:', PAD, FieldTop + 5);
EdIP := TFlatEdit.Create(Self);
EdIP.Parent := PanelLeft;
EdIP.SetBounds(76, FieldTop, LEFT_W - 76 - PAD, EDIT_H);
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';
@@ -228,7 +232,7 @@ begin
// --- Правая панель: discovery ---
PanelRight := TPanel.Create(Self);
PanelRight.Parent := Self;
PanelRight.SetBounds(GAP + LEFT_W + GAP, GAP, RIGHT_W, PANEL_H);
PanelRight.SetBounds(DpiScale(GAP + LEFT_W + GAP), DpiScale(GAP), DpiScale(RIGHT_W), DpiScale(PANEL_H));
PanelRight.BevelOuter := bvNone;
PanelRight.Color := CLR_PANEL;
@@ -236,7 +240,7 @@ begin
LstFound := TFlatListBox.Create(Self);
LstFound.Parent := PanelRight;
LstFound.SetBounds(PAD, PAD + LabelH, RIGHT_W - PAD * 2, 250);
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';
+37
View File
@@ -0,0 +1,37 @@
unit DpiUtils;
{
DpiUtils.pas — общий пересчёт «дизайн-пикселей» в реальные экранные.
Вся UI-раскладка приложения (кастомные Flat*-контролы и окна, построенные
кодом — SettingsForm, DeviceForm) написана литеральными пикселями под
неявные 96 DPI. DpiScale переводит такое значение в пиксели текущего
монитора: на 96 DPI (обычный десктоп, Windows 100%) возвращает V без
изменений; на более высоком DPI (Windows 125/150/200%, HiDPI-десктопы)
масштабирует пропорционально — тот же приём, что и для стандартных
Windows-контролов (MulDiv), но управляемый вручную, т.к. вся раскладка
строится кодом, а не читается из .lfm (там масштабирование сделал бы LCL
сам через DesignTimePPI).
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Forms, LCLType;
function DpiScale(V: Integer): Integer;
implementation
function DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
end.
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
AppTheme;
AppTheme, DpiUtils;
type
TFlatCheckBox = class(TCustomControl)
@@ -27,7 +27,6 @@ type
FClrCheck: TColor;
FClrText: TColor;
FClrTextDisabled: TColor;
function DpiScale(V: Integer): Integer;
procedure SetChecked(V: Boolean);
procedure DoChange;
procedure CMTextChanged(var Msg: TLMessage); message CM_TEXTCHANGED;
@@ -92,13 +91,6 @@ begin
FClrTextDisabled := TColor($00666666);
end;
function TFlatCheckBox.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
procedure TFlatCheckBox.SetAppTheme(const T: TAppTheme);
begin
FClrBG := T.Panel;
+2 -10
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
Math, AppTheme;
Math, AppTheme, DpiUtils;
type
TFlatComboBox = class;
@@ -52,7 +52,6 @@ type
FClrPopupBG: TColor;
FClrPopupHot: TColor;
FClrPopupSel: TColor;
function DpiScale(V: Integer): Integer;
function ItemHeight: Integer;
function ArrowWidth: Integer;
procedure ItemsChanged(Sender: TObject);
@@ -162,7 +161,7 @@ begin
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FCombo.FClrText;
TextY := Y + (FCombo.ItemHeight - Canvas.TextHeight('Ag')) div 2;
Canvas.TextOut(FCombo.DpiScale(BASE_PAD), TextY, FCombo.Items[ItemIdx]);
Canvas.TextOut(DpiScale(BASE_PAD), TextY, FCombo.Items[ItemIdx]);
Canvas.Brush.Style := bsSolid;
end;
@@ -288,13 +287,6 @@ begin
FClrPopupSel := TColor($00183618);
end;
function TFlatComboBox.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
function TFlatComboBox.ItemHeight: Integer;
begin
Result := DpiScale(BASE_ITEM_H);
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
Clipbrd, Math, LazUTF8, AppTheme;
Clipbrd, Math, LazUTF8, AppTheme, DpiUtils;
type
TFlatEdit = class(TCustomControl)
@@ -33,7 +33,6 @@ type
FClrTextDim: TColor;
FClrSelBG: TColor;
FClrSelText: TColor;
function DpiScale(V: Integer): Integer;
function DisplayText: string;
function TextLen: Integer;
function HasSelection: Boolean;
@@ -133,13 +132,6 @@ begin
inherited Destroy;
end;
function TFlatEdit.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
procedure TFlatEdit.SetAppTheme(const T: TAppTheme);
begin
FClrOuterBG := T.Panel;
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
Clipbrd, Math, AppTheme;
Clipbrd, Math, AppTheme, DpiUtils;
type
TFlatFloatSpinPart = (ffspNone, ffspEdit, ffspUp, ffspDown);
@@ -42,7 +42,6 @@ type
FClrBtnHot: TColor;
FClrBtnDown: TColor;
FClrBtnText: TColor;
function DpiScale(V: Integer): Integer;
function ButtonWidth: Integer;
function EditRect: TRect;
function UpRect: TRect;
@@ -160,13 +159,6 @@ begin
inherited Destroy;
end;
function TFlatFloatSpinEdit.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
function TFlatFloatSpinEdit.ButtonWidth: Integer;
begin
Result := DpiScale(BASE_BTN_W);
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
Math, AppTheme;
Math, AppTheme, DpiUtils;
type
TFlatListBox = class(TCustomControl)
@@ -28,7 +28,6 @@ type
FClrSelBG: TColor;
FClrSelText: TColor;
FClrScroll: TColor;
function DpiScale(V: Integer): Integer;
function ItemHeight: Integer;
function VisibleCount: Integer;
function ItemAt(Y: Integer): Integer;
@@ -114,13 +113,6 @@ begin
inherited Destroy;
end;
function TFlatListBox.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
function TFlatListBox.ItemHeight: Integer;
begin
Canvas.Font.Assign(Font);
+1 -8
View File
@@ -30,7 +30,7 @@ interface
uses
Classes, SysUtils, Math, Types, Controls, Graphics, Forms, LCLType, LCLIntf,
AppTheme;
AppTheme, DpiUtils;
type
TFlatMenuSelect = procedure(Tag: Integer) of object;
@@ -45,7 +45,6 @@ type
FItemH: Integer;
FTheme: TAppTheme;
FOnSelect: TFlatMenuSelect;
function DpiScale(V: Integer): Integer;
function ItemAt(Y: Integer): Integer;
procedure Commit(Idx: Integer);
protected
@@ -92,12 +91,6 @@ begin
FTheme := DarkTheme;
end;
function TFlatPopupMenu.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then Result := 1;
end;
procedure TFlatPopupMenu.SetTheme(const T: TAppTheme);
begin
FTheme := T;
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types, Math,
AppTheme;
AppTheme, DpiUtils;
type
TFlatRadioButton = class(TCustomControl)
@@ -27,7 +27,6 @@ type
FClrDot: TColor;
FClrText: TColor;
FClrTextDisabled: TColor;
function DpiScale(V: Integer): Integer;
procedure SetCheckedSilently(V: Boolean);
procedure SetChecked(V: Boolean);
procedure DoChange;
@@ -93,13 +92,6 @@ begin
FClrTextDisabled := TColor($00666666);
end;
function TFlatRadioButton.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
procedure TFlatRadioButton.SetAppTheme(const T: TAppTheme);
begin
FClrBG := T.Panel;
+1 -9
View File
@@ -9,7 +9,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, Forms, LCLType, LMessages, Types,
Clipbrd, Math, AppTheme;
Clipbrd, Math, AppTheme, DpiUtils;
type
TFlatSpinPart = (fspNone, fspEdit, fspUp, fspDown);
@@ -41,7 +41,6 @@ type
FClrBtnHot: TColor;
FClrBtnDown: TColor;
FClrBtnText: TColor;
function DpiScale(V: Integer): Integer;
function ButtonWidth: Integer;
function EditRect: TRect;
function UpRect: TRect;
@@ -153,13 +152,6 @@ begin
inherited Destroy;
end;
function TFlatSpinEdit.DpiScale(V: Integer): Integer;
begin
Result := MulDiv(V, Screen.PixelsPerInch, 96);
if (V > 0) and (Result < 1) then
Result := 1;
end;
function TFlatSpinEdit.ButtonWidth: Integer;
begin
Result := DpiScale(BASE_BTN_W);
+6 -6
View File
@@ -45,7 +45,7 @@ uses
PowerInhibit,
DeviceStore,
RadioBackend, PlutoBackend,
RadioController, ChannelController;
RadioController, ChannelController, DpiUtils;
const
// Меню шапки пана: теги ниже — rate в кГц, от DDC_MENU_TAG — выбор hw-DDC.
@@ -2746,21 +2746,21 @@ var
RULER_H: Integer;
PANZOOM_H: Integer;
begin
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
RULER_H := DpiScale(18);
if PanelRight = nil then Exit;
if Assigned(FSpecView) then SyncSpecViewFreq;
RW := PanelRight.ClientWidth;
RH := PanelRight.ClientHeight;
// Низ занят панелью пана/зума (позиционирует FPan.Layout той же формулой) —
// wideband-блок делит оставшуюся высоту.
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
PANZOOM_H := DpiScale(22);
if FController.FShowSpectrum or FController.FShowWaterfall then
RH := RH - PANZOOM_H;
UpdateWidebandFrequencyView;
WideH := 0;
WideSpecH := 0;
if FController.FShowWideband then
WideH := Min(MulDiv(WB_H, Screen.PixelsPerInch, 96), Max(40, RH div 2));
WideH := Min(DpiScale(WB_H), Max(40, RH div 2));
if WideH > 0 then
WideSpecH := Max(1, WideH - RULER_H);
// Wideband — всегда во всю ширину PanelRight, самой верхней полосой.
@@ -2816,7 +2816,7 @@ end;
function TMainForm.Pan0HeaderH: Integer;
begin
if Pan0HeaderVisible then
Result := MulDiv(20, Screen.PixelsPerInch, 96) // = HEADER_H панели
Result := DpiScale(20) // = HEADER_H панели
else
Result := 0;
end;
@@ -7829,7 +7829,7 @@ begin
MaxBottom := BtnBand[i].Top + BtnBand[i].Height;
BtnH := BtnBand[i].Height;
end;
if BtnH = 0 then BtnH := MulDiv(24, Screen.PixelsPerInch, 96);
if BtnH = 0 then BtnH := DpiScale(24);
RowH := BtnH + 3; // шаг ряда: высота кнопки + 3px зазор (как 27=24+3 при 1x)
Pos := 0; // позиция среди enabled слотов
+9 -9
View File
@@ -35,7 +35,7 @@ uses
LCLIntf, LCLType,
OpenGLContextEx,
AppTheme, WDSPEngine, RadioController, DMRDecoder, VfoOverlay,
SpectrumView, SpectrumViewOpengl, PanZoomBar, FlatButton;
SpectrumView, SpectrumViewOpengl, PanZoomBar, FlatButton, DpiUtils;
type
TWireFlagEvent = procedure(O: TVfoOverlay) of object;
@@ -682,7 +682,7 @@ begin
if FBtnAddPan <> nil then FBtnAddPan.Visible := AVisible and WantAdd;
if FBtnGrid <> nil then FBtnGrid.Visible := AVisible and WantGrid;
if not AVisible then Exit;
Gap := MulDiv(2, Screen.PixelsPerInch, 96);
Gap := DpiScale(2);
BtnW := H; // квадратные кнопки в высоту строки
NBtns := 3;
if WantAdd then Inc(NBtns);
@@ -716,9 +716,9 @@ const
var
RULER_H, PANZOOM_H, HEADER_H: Integer;
begin
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
HEADER_H := MulDiv(20, Screen.PixelsPerInch, 96);
RULER_H := DpiScale(18);
PANZOOM_H := DpiScale(22);
HEADER_H := DpiScale(20);
Result := ATopOffset;
if FHeaderVisible then Inc(Result, HEADER_H);
if (AShowSpectrum or AShowWaterfall) and FShowZoomRow then
@@ -751,7 +751,7 @@ begin
FShowSpectrum := AShowSpectrum;
FShowWaterfall := AShowWaterfall;
FSplitAvailH := 0; // валидно только в режиме «спектр+водопад» (ниже)
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
RULER_H := DpiScale(18);
// Регион пана — прямоугольник [X0..X0+RW) × [FStackTop..RH): грид-раскладка
// ставит паны колонками; 0/0 по каждой оси = весь родитель.
X0 := FStackLeft;
@@ -767,7 +767,7 @@ begin
else
RH := FParent.ClientHeight;
// Шапка пана — первой строкой региона (видна при панах >= 2).
HEADER_H := MulDiv(20, Screen.PixelsPerInch, 96);
HEADER_H := DpiScale(20);
if FHeaderPanel <> nil then
begin
FHeaderPanel.Visible := FHeaderVisible;
@@ -778,7 +778,7 @@ begin
end;
end;
// Резервируем низ под панель пана/зума (видна, если виден спектр или водопад).
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
PANZOOM_H := DpiScale(22);
ShowPZ := (AShowSpectrum or AShowWaterfall) and FShowZoomRow;
PositionPanZoomBar(X0, RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
if ShowPZ then RH := RH - PANZOOM_H;
@@ -943,7 +943,7 @@ const
MIN_SH = 60;
MIN_WH = 40;
begin
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
RULER_H := DpiScale(18);
if not FSplitterDrag then Exit;
// Геометрия региона ЭТОГО пана из последнего Layout (стек панов!),
// а не от всего родителя.
+137 -136
View File
File diff suppressed because it is too large Load Diff
+8 -2
View File
@@ -17,9 +17,9 @@
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="9"/>
<BuildNr Value="287"/>
<BuildNr Value="293"/>
</VersionInfo>
<MacroValues Count="120">
<MacroValues Count="126">
<Macro1 Name="LCLWidgetType" Value="qt6"/>
<Macro2 Name="LCLWidgetType" Value="qt6"/>
<Macro3 Name="LCLWidgetType" Value="qt6"/>
@@ -140,6 +140,12 @@
<Macro118 Name="LCLWidgetType" Value="qt6"/>
<Macro119 Name="LCLWidgetType" Value="qt6"/>
<Macro120 Name="LCLWidgetType" Value="qt6"/>
<Macro121 Name="LCLWidgetType" Value="qt6"/>
<Macro122 Name="LCLWidgetType" Value="qt6"/>
<Macro123 Name="LCLWidgetType" Value="qt6"/>
<Macro124 Name="LCLWidgetType" Value="qt6"/>
<Macro125 Name="LCLWidgetType" Value="qt6"/>
<Macro126 Name="LCLWidgetType" Value="qt6"/>
</MacroValues>
<BuildModes>
<Item Name="Debug" Default="True"/>