mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
feat(slices): кастомные тематизированные popup-меню панов + фиксы позиционирования
Селекторы диапазона/samplerate панов N переведены с нативного TPopupMenu на своё меню в стиле приложения (одинаково на всех платформах, в цветовой теме). - FlatPopupMenu.pas (new): TFlatPopupMenu — owner-draw меню как ДОЧЕРНИЙ контрол формы (не top-level окно: Wayland центрирует свои top-level окна). Hover, галка текущего, клавиатура (↑↓/Enter/Esc), закрытие по клику-вне (MouseCapture) и потере фокуса. Позиционируется под лейблом-якорем в клиентских координатах. - PanDisplayPopup: поповер «◑» тоже переведён с top-level формы на дочерний контрол (центрировался на Wayland) — открывается под кнопкой, закрытие «×» или повторным «◑». - MainForm: band/rate-селекторы на FlatPopupMenu; свёртка повторяющегося выбора темы (9 инлайнов) в CurrentAppTheme. - PanafallPanel: курсор-«палец» кликабельных лейблов шапки переприменяется в конце Build (флаги *Clickable могли выставляться до создания лейблов — samplerate-лейбл не получал crHandPoint). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,314 @@
|
||||
unit FlatPopupMenu;
|
||||
|
||||
{
|
||||
TFlatPopupMenu — кастомное popup-меню в стиле приложения (не нативное
|
||||
TPopupMenu, чтобы одинаково выглядело на всех платформах и жило в цветовой
|
||||
теме). Реализовано как ДОЧЕРНИЙ контрол верхнеуровневой формы (а не отдельное
|
||||
окно): Wayland не позволяет клиенту позиционировать свои top-level окна —
|
||||
они центрируются компоновщиком. Дочерний контрол позиционируется в клиентских
|
||||
координатах формы и работает на всех платформах (тот же приём, что у
|
||||
выпадающего списка TFlatComboBox).
|
||||
|
||||
Owner-draw список: hover-подсветка, галка текущего пункта, клавиатура
|
||||
(↑↓/Enter/Esc), закрытие по клику вне (MouseCapture) и по потере фокуса.
|
||||
|
||||
Использование:
|
||||
Menu.SetTheme(T);
|
||||
Menu.Clear;
|
||||
Menu.AddItem('20m', BandIdx, Checked);
|
||||
Menu.OnSelect := Handler; // Handler(Tag)
|
||||
Menu.PopupBelow(AnchorControl); // выпадает под якорем
|
||||
|
||||
Селекторы диапазона/samplerate панадаптеров (этап 3.6).
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, Types, Controls, Graphics, Forms, LCLType, LCLIntf,
|
||||
AppTheme;
|
||||
|
||||
type
|
||||
TFlatMenuSelect = procedure(Tag: Integer) of object;
|
||||
|
||||
TFlatPopupMenu = class(TCustomControl)
|
||||
private
|
||||
FCaptions: array of string;
|
||||
FTags: array of Integer;
|
||||
FChecked: array of Boolean;
|
||||
FEnabled: array of Boolean;
|
||||
FHot: Integer;
|
||||
FItemH: Integer;
|
||||
FTheme: TAppTheme;
|
||||
FOnSelect: TFlatMenuSelect;
|
||||
function DpiScale(V: Integer): Integer;
|
||||
function ItemAt(Y: Integer): Integer;
|
||||
procedure Commit(Idx: Integer);
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer); override;
|
||||
procedure MouseLeave; override;
|
||||
procedure DoExit; override;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure Clear;
|
||||
procedure AddItem(const ACaption: string; ATag: Integer;
|
||||
AChecked: Boolean = False; AEnabled: Boolean = True);
|
||||
procedure SetTheme(const T: TAppTheme);
|
||||
procedure PopupBelow(Anchor: TControl); // выпадает под контролом-якорем
|
||||
procedure ClosePopup;
|
||||
property OnSelect: TFlatMenuSelect read FOnSelect write FOnSelect;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
{$IFDEF WINDOWS}
|
||||
UI_FONT = 'Segoe UI';
|
||||
{$ELSE}
|
||||
UI_FONT = 'Sans';
|
||||
{$ENDIF}
|
||||
BASE_ITEM_H = 22;
|
||||
BASE_PAD = 10; // левый отступ текста
|
||||
BASE_CHECKW = 16; // колонка галки слева
|
||||
BASE_MINW = 96;
|
||||
|
||||
constructor TFlatPopupMenu.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csOpaque];
|
||||
TabStop := True;
|
||||
Visible := False;
|
||||
Font.Name := UI_FONT;
|
||||
Font.Size := 9;
|
||||
FHot := -1;
|
||||
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;
|
||||
Font.Color := T.Text;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.Clear;
|
||||
begin
|
||||
SetLength(FCaptions, 0);
|
||||
SetLength(FTags, 0);
|
||||
SetLength(FChecked, 0);
|
||||
SetLength(FEnabled, 0);
|
||||
FHot := -1;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.AddItem(const ACaption: string; ATag: Integer;
|
||||
AChecked: Boolean; AEnabled: Boolean);
|
||||
var n: Integer;
|
||||
begin
|
||||
n := Length(FCaptions);
|
||||
SetLength(FCaptions, n + 1);
|
||||
SetLength(FTags, n + 1);
|
||||
SetLength(FChecked, n + 1);
|
||||
SetLength(FEnabled, n + 1);
|
||||
FCaptions[n] := ACaption;
|
||||
FTags[n] := ATag;
|
||||
FChecked[n] := AChecked;
|
||||
FEnabled[n] := AEnabled;
|
||||
end;
|
||||
|
||||
function TFlatPopupMenu.ItemAt(Y: Integer): Integer;
|
||||
begin
|
||||
if FItemH <= 0 then Exit(-1);
|
||||
Result := (Y - 1) div FItemH; // -1: верхняя 1px-рамка
|
||||
if (Result < 0) or (Result >= Length(FCaptions)) then Result := -1;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.Paint;
|
||||
var
|
||||
i, Y, TextY, TextX, W, H: Integer;
|
||||
R: TRect;
|
||||
begin
|
||||
W := ClientWidth;
|
||||
H := ClientHeight;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Color := FTheme.Panel;
|
||||
Canvas.Pen.Style := psClear;
|
||||
Canvas.FillRect(0, 0, W, H);
|
||||
Canvas.Font.Assign(Font);
|
||||
|
||||
for i := 0 to High(FCaptions) do
|
||||
begin
|
||||
Y := 1 + i * FItemH;
|
||||
R := Rect(1, Y, W - 1, Y + FItemH);
|
||||
if i = FHot then
|
||||
begin
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Color := FTheme.BtnActive;
|
||||
Canvas.Pen.Style := psClear;
|
||||
Canvas.FillRect(R);
|
||||
end;
|
||||
// Галка текущего пункта.
|
||||
Canvas.Brush.Style := bsClear;
|
||||
if FChecked[i] then
|
||||
begin
|
||||
Canvas.Font.Color := FTheme.BtnTextActive;
|
||||
Canvas.TextOut(DpiScale(BASE_PAD) - DpiScale(2),
|
||||
Y + (FItemH - Canvas.TextHeight('Ag')) div 2, '✓');
|
||||
end;
|
||||
// Текст пункта.
|
||||
if FEnabled[i] then Canvas.Font.Color := FTheme.Text
|
||||
else Canvas.Font.Color := FTheme.TextDim;
|
||||
TextX := DpiScale(BASE_PAD) + DpiScale(BASE_CHECKW);
|
||||
TextY := Y + (FItemH - Canvas.TextHeight('Ag')) div 2;
|
||||
Canvas.TextOut(TextX, TextY, FCaptions[i]);
|
||||
end;
|
||||
|
||||
// Рамка.
|
||||
Canvas.Brush.Style := bsClear;
|
||||
Canvas.Pen.Style := psSolid;
|
||||
Canvas.Pen.Color := FTheme.Border;
|
||||
Canvas.Rectangle(0, 0, W, H);
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var Idx: Integer;
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if PtInRect(ClientRect, Point(X, Y)) then Idx := ItemAt(Y) else Idx := -1;
|
||||
if Idx = FHot then Exit;
|
||||
FHot := Idx;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.MouseLeave;
|
||||
begin
|
||||
inherited MouseLeave;
|
||||
if FHot <> -1 then begin FHot := -1; Invalidate; end;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.Commit(Idx: Integer);
|
||||
var T: Integer;
|
||||
begin
|
||||
if (Idx < 0) or (Idx > High(FCaptions)) or not FEnabled[Idx] then
|
||||
begin
|
||||
ClosePopup;
|
||||
Exit;
|
||||
end;
|
||||
T := FTags[Idx];
|
||||
ClosePopup;
|
||||
if Assigned(FOnSelect) then FOnSelect(T);
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
// Клик вне списка (MouseCapture доставляет сюда координаты вне ClientRect) —
|
||||
// просто закрыть.
|
||||
if (Button <> mbLeft) or not PtInRect(ClientRect, Point(X, Y)) then
|
||||
begin
|
||||
ClosePopup;
|
||||
Exit;
|
||||
end;
|
||||
Commit(ItemAt(Y));
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.DoExit;
|
||||
begin
|
||||
inherited DoExit;
|
||||
ClosePopup;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
var n: Integer;
|
||||
begin
|
||||
inherited KeyDown(Key, Shift);
|
||||
n := Length(FCaptions);
|
||||
case Key of
|
||||
VK_ESCAPE: begin ClosePopup; Key := 0; end;
|
||||
VK_RETURN: begin Commit(FHot); Key := 0; end;
|
||||
VK_UP:
|
||||
begin
|
||||
if n > 0 then FHot := EnsureRange(FHot - 1, 0, n - 1);
|
||||
Invalidate; Key := 0;
|
||||
end;
|
||||
VK_DOWN:
|
||||
begin
|
||||
if n > 0 then
|
||||
begin
|
||||
if FHot < 0 then FHot := 0
|
||||
else FHot := EnsureRange(FHot + 1, 0, n - 1);
|
||||
end;
|
||||
Invalidate; Key := 0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.ClosePopup;
|
||||
begin
|
||||
if not Visible then Exit;
|
||||
MouseCapture := False;
|
||||
Visible := False;
|
||||
end;
|
||||
|
||||
procedure TFlatPopupMenu.PopupBelow(Anchor: TControl);
|
||||
var
|
||||
Root: TCustomForm;
|
||||
bmp: TBitmap;
|
||||
i, maxTW, W, H, L, T: Integer;
|
||||
ScreenPt, Cl: TPoint;
|
||||
begin
|
||||
if (Anchor = nil) or (Length(FCaptions) = 0) then Exit;
|
||||
Root := GetParentForm(Anchor);
|
||||
if Root = nil then Exit;
|
||||
|
||||
// Размеры по временному холсту (у контрола Canvas может быть ещё невалиден).
|
||||
bmp := TBitmap.Create;
|
||||
try
|
||||
bmp.Canvas.Font.Assign(Font);
|
||||
FItemH := Max(DpiScale(BASE_ITEM_H),
|
||||
bmp.Canvas.TextHeight('Ag') + DpiScale(8));
|
||||
maxTW := 0;
|
||||
for i := 0 to High(FCaptions) do
|
||||
maxTW := Max(maxTW, bmp.Canvas.TextWidth(FCaptions[i]));
|
||||
finally
|
||||
bmp.Free;
|
||||
end;
|
||||
W := DpiScale(BASE_PAD) + DpiScale(BASE_CHECKW) + maxTW + DpiScale(BASE_PAD);
|
||||
W := Max(W, DpiScale(BASE_MINW));
|
||||
H := Length(FCaptions) * FItemH + 2;
|
||||
|
||||
// Позиция под якорем в КЛИЕНТСКИХ координатах формы.
|
||||
ScreenPt := Anchor.ClientToScreen(Point(0, Anchor.Height + 1));
|
||||
Cl := Root.ScreenToClient(ScreenPt);
|
||||
L := Cl.X;
|
||||
T := Cl.Y;
|
||||
if L + W > Root.ClientWidth then L := Root.ClientWidth - W;
|
||||
if L < 0 then L := 0;
|
||||
if T + H > Root.ClientHeight then
|
||||
T := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, 0))).Y - H; // вверх
|
||||
if T < 0 then T := 0;
|
||||
|
||||
FHot := -1;
|
||||
Parent := Root;
|
||||
SetBounds(L, T, W, H);
|
||||
Visible := True;
|
||||
BringToFront;
|
||||
SetFocus;
|
||||
MouseCapture := True;
|
||||
end;
|
||||
|
||||
end.
|
||||
+47
-49
@@ -33,7 +33,7 @@ uses
|
||||
WebServer, WebAdapter,
|
||||
CATAdapter,
|
||||
SpectrumView, SpectrumViewOpengl,
|
||||
PanZoomBar, PanafallPanel, PanDisplayPopup,
|
||||
PanZoomBar, PanafallPanel, PanDisplayPopup, FlatPopupMenu,
|
||||
WidebandView,
|
||||
StatusBar,
|
||||
PlatformUtils,
|
||||
@@ -200,9 +200,9 @@ type
|
||||
FPanWideH: Integer; // wideband-высота последнего LayoutPanStack (для PanMinHeight)
|
||||
FPendingPanClose: Integer; // «×» шапки: PanId к закрытию в тике (0 = нет)
|
||||
// Меню rate пана («NNN kHz» в шапке панов N; создаётся лениво).
|
||||
FPanRateMenu: TPopupMenu;
|
||||
FPanRateMenu: TFlatPopupMenu; // тематизированное меню (не нативное)
|
||||
FPanRateMenuPanId: Integer;
|
||||
FPanBandMenu: TPopupMenu; // селектор диапазона пана N (3.6, КВ)
|
||||
FPanBandMenu: TFlatPopupMenu; // селектор диапазона пана N (3.6, КВ)
|
||||
FPanBandMenuPanId: Integer;
|
||||
// Pop-out (3.5): пан N в отдельном OS-окне. nil = пан в стеке.
|
||||
FPanFloatForm: array[1..MAX_PANS-1] of TForm;
|
||||
@@ -605,9 +605,10 @@ type
|
||||
procedure ApplyPanHeaderTheme(P: TPanafallPanel); // цвета шапки пана
|
||||
procedure UpdateAddPanButton;
|
||||
procedure OnPanRateClick(Sender: TObject); // «NNN kHz» шапки пана N
|
||||
procedure PanRateMenuItemClick(Sender: TObject);
|
||||
procedure OnPanRateSelect(Tag: Integer); // выбор rate из flat-меню
|
||||
procedure OnPanBandClick(Sender: TObject); // «20m» шапки пана N (3.6)
|
||||
procedure PanBandMenuItemClick(Sender: TObject);
|
||||
procedure OnPanBandSelect(Tag: Integer); // выбор диапазона из flat-меню
|
||||
function CurrentAppTheme: TAppTheme; // тек. тема (light/dark)
|
||||
procedure ApplyPanBand(P: TPanafallPanel; BandIdx: Integer); // Flex-style смена банда пана
|
||||
function PanBandSelectorVisible: Boolean; // КВ (не XVTR, не Pluto)
|
||||
procedure OnPanADCClick(Sender: TObject); // бейдж «RX1/RX2» (3.4)
|
||||
@@ -2829,7 +2830,7 @@ var T: TAppTheme; i: Integer;
|
||||
T.SliderThumbNorm, T.SliderThumbHot, T.SliderThumbDrag, T.SliderThumbBdr);
|
||||
end;
|
||||
begin
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
|
||||
Color := T.BG; Font.Color := T.Text;
|
||||
DP(PanelToolbar); DP(PanelLeft);
|
||||
@@ -2994,7 +2995,7 @@ end;
|
||||
procedure TMainForm.StyleButton(B: TFlatButton; Active: Boolean);
|
||||
var T: TAppTheme;
|
||||
begin
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
B.Active := Active;
|
||||
B.ClrNorm := T.BtnNorm;
|
||||
B.ClrActive := T.BtnActive;
|
||||
@@ -3010,7 +3011,7 @@ end;
|
||||
procedure TMainForm.StyleSpanButton(B: TFlatButton; Active: Boolean);
|
||||
var T: TAppTheme;
|
||||
begin
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
B.Active := Active;
|
||||
B.ClrNorm := T.SpanNorm;
|
||||
B.ClrActive := T.SpanActive;
|
||||
@@ -3068,7 +3069,7 @@ const
|
||||
TOP_VFO_FREQ_H = 47;
|
||||
var T: TAppTheme;
|
||||
begin
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
|
||||
FreqDispA.Frequency := Round(FController.FVfoA);
|
||||
FreqDispB.Frequency := Round(FController.FVfoB);
|
||||
@@ -3747,8 +3748,7 @@ begin
|
||||
FDeviceDialog := TDeviceDialog.Create(Self);
|
||||
FDeviceDialog.Store := FController.FDeviceStore;
|
||||
FDeviceDialog.OnDiscover := BtnDiscoverFromDialog;
|
||||
if FLightTheme then FDeviceDialog.SetTheme(LightTheme)
|
||||
else FDeviceDialog.SetTheme(DarkTheme);
|
||||
FDeviceDialog.SetTheme(CurrentAppTheme);
|
||||
FDeviceDialog.ClearResult; // сбрасываем старый выбор перед открытием
|
||||
FDeviceDialog.ShowModal;
|
||||
// Если пользователь нажал CONNECT — результат хранится в DialogResult,
|
||||
@@ -3836,8 +3836,7 @@ begin
|
||||
FDeviceDialog := TDeviceDialog.Create(Self);
|
||||
FDeviceDialog.Store := FController.FDeviceStore;
|
||||
FDeviceDialog.OnDiscover := BtnDiscoverFromDialog;
|
||||
if FLightTheme then FDeviceDialog.SetTheme(LightTheme)
|
||||
else FDeviceDialog.SetTheme(DarkTheme);
|
||||
FDeviceDialog.SetTheme(CurrentAppTheme);
|
||||
if FDeviceDialog.ShowModal <> mrOk then Exit;
|
||||
if not FDeviceDialog.DialogResult.Accepted then Exit;
|
||||
FPendingIP := FDeviceDialog.DialogResult.IPAddress;
|
||||
@@ -5468,7 +5467,7 @@ begin
|
||||
O.OnClose := OnVfoOverlayClose;
|
||||
O.OnInvalidate := OnVfoOverlayInvalidate;
|
||||
// Актуальная тема (цвета кнопок флага = как на левой панели).
|
||||
if FLightTheme then O.SetTheme(LightTheme) else O.SetTheme(DarkTheme);
|
||||
O.SetTheme(CurrentAppTheme);
|
||||
end;
|
||||
|
||||
// Добавить софт-слайс на частоте Hz (режим/полоса копируются с главного).
|
||||
@@ -5601,32 +5600,30 @@ procedure TMainForm.OnPanRateClick(Sender: TObject);
|
||||
// (фильтр PanRateAllowed — кратные 48 кГц). Текущий rate отмечен галкой.
|
||||
var
|
||||
P: TPanafallPanel;
|
||||
MI: TMenuItem;
|
||||
i, kHz: Integer;
|
||||
i, kHz, Cur: Integer;
|
||||
begin
|
||||
if not (Sender is TPanafallPanel) then Exit;
|
||||
P := TPanafallPanel(Sender);
|
||||
if (P.PanId < 1) or not FController.PanDDCActive(P.PanId) then Exit;
|
||||
if FPanRateMenu = nil then
|
||||
FPanRateMenu := TPopupMenu.Create(Self);
|
||||
FPanRateMenu.Items.Clear;
|
||||
begin
|
||||
FPanRateMenu := TFlatPopupMenu.Create(Self);
|
||||
FPanRateMenu.OnSelect := OnPanRateSelect;
|
||||
end;
|
||||
FPanRateMenu.SetTheme(CurrentAppTheme);
|
||||
FPanRateMenu.Clear;
|
||||
Cur := FController.PanDDCRateKHz(P.PanId);
|
||||
for i := 0 to High(FController.BackendCaps.RatePresets) do
|
||||
begin
|
||||
kHz := FController.BackendCaps.RatePresets[i] div 1000;
|
||||
if not FController.PanRateAllowed(Word(kHz)) then Continue;
|
||||
MI := TMenuItem.Create(FPanRateMenu);
|
||||
MI.Caption := Format('%d kHz', [kHz]);
|
||||
MI.Tag := kHz;
|
||||
MI.Checked := kHz = FController.PanDDCRateKHz(P.PanId);
|
||||
MI.OnClick := PanRateMenuItemClick;
|
||||
FPanRateMenu.Items.Add(MI);
|
||||
FPanRateMenu.AddItem(Format('%d kHz', [kHz]), kHz, kHz = Cur);
|
||||
end;
|
||||
if FPanRateMenu.Items.Count = 0 then Exit;
|
||||
FPanRateMenuPanId := P.PanId;
|
||||
FPanRateMenu.PopUp; // в позиции курсора
|
||||
FPanRateMenu.PopupBelow(P.HeaderRateLabel); // дочерний контрол формы
|
||||
end;
|
||||
|
||||
procedure TMainForm.PanRateMenuItemClick(Sender: TObject);
|
||||
procedure TMainForm.OnPanRateSelect(Tag: Integer);
|
||||
var
|
||||
P: TPanafallPanel;
|
||||
PanId: Integer;
|
||||
@@ -5636,7 +5633,7 @@ begin
|
||||
if (PanId < 1) or (PanId >= MAX_PANS) then Exit;
|
||||
P := FPans[PanId];
|
||||
if P = nil then Exit;
|
||||
if not FController.SetPanDDCRate(PanId, Word(TMenuItem(Sender).Tag)) then Exit;
|
||||
if not FController.SetPanDDCRate(PanId, Word(Tag)) then Exit;
|
||||
// Вьюха/шапка/флаги под новый span (слайсы могли клампнуться к краям).
|
||||
SyncPanViews;
|
||||
P.PushAllSliceFlagStates;
|
||||
@@ -5644,6 +5641,11 @@ begin
|
||||
MarkPanDirty(P);
|
||||
end;
|
||||
|
||||
function TMainForm.CurrentAppTheme: TAppTheme;
|
||||
begin
|
||||
if FLightTheme then Result := LightTheme else Result := DarkTheme;
|
||||
end;
|
||||
|
||||
function TMainForm.PanBandSelectorVisible: Boolean;
|
||||
// Селектор диапазона пана — только на «настоящих КВ»: не в XVTR и не Pluto
|
||||
// (у Pluto/трансвертера band-стек другой, сценарий не актуален).
|
||||
@@ -5656,7 +5658,6 @@ procedure TMainForm.OnPanBandClick(Sender: TObject);
|
||||
// частоте DDC пана) отмечен галкой.
|
||||
var
|
||||
P: TPanafallPanel;
|
||||
MI: TMenuItem;
|
||||
i, CurBand: Integer;
|
||||
begin
|
||||
if not (Sender is TPanafallPanel) then Exit;
|
||||
@@ -5665,31 +5666,29 @@ begin
|
||||
if not PanBandSelectorVisible then Exit;
|
||||
CurBand := FreqToBandIdx(FController.PanDDCFreq(P.PanId), False);
|
||||
if FPanBandMenu = nil then
|
||||
FPanBandMenu := TPopupMenu.Create(Self);
|
||||
FPanBandMenu.Items.Clear;
|
||||
begin
|
||||
FPanBandMenu := TFlatPopupMenu.Create(Self);
|
||||
FPanBandMenu.OnSelect := OnPanBandSelect;
|
||||
end;
|
||||
FPanBandMenu.SetTheme(CurrentAppTheme);
|
||||
FPanBandMenu.Clear;
|
||||
for i := 0 to CFG_BAND_COUNT - 1 do
|
||||
begin
|
||||
if BandName(i, False) = '' then Continue; // 6m-дубль/пустые слоты
|
||||
MI := TMenuItem.Create(FPanBandMenu);
|
||||
MI.Caption := BandName(i, False);
|
||||
MI.Tag := i;
|
||||
MI.Checked := i = CurBand;
|
||||
MI.OnClick := PanBandMenuItemClick;
|
||||
FPanBandMenu.Items.Add(MI);
|
||||
FPanBandMenu.AddItem(BandName(i, False), i, i = CurBand);
|
||||
end;
|
||||
if FPanBandMenu.Items.Count = 0 then Exit;
|
||||
FPanBandMenuPanId := P.PanId;
|
||||
FPanBandMenu.PopUp;
|
||||
FPanBandMenu.PopupBelow(P.HeaderBandLabel);
|
||||
end;
|
||||
|
||||
procedure TMainForm.PanBandMenuItemClick(Sender: TObject);
|
||||
procedure TMainForm.OnPanBandSelect(Tag: Integer);
|
||||
var PanId: Integer;
|
||||
begin
|
||||
PanId := FPanBandMenuPanId;
|
||||
FPanBandMenuPanId := 0;
|
||||
if (PanId < 1) or (PanId >= MAX_PANS) then Exit;
|
||||
if FPans[PanId] = nil then Exit;
|
||||
ApplyPanBand(FPans[PanId], TMenuItem(Sender).Tag);
|
||||
ApplyPanBand(FPans[PanId], Tag);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ApplyPanBand(P: TPanafallPanel; BandIdx: Integer);
|
||||
@@ -5791,18 +5790,17 @@ begin
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnPanDisplayClick(Sender: TObject);
|
||||
// «◑» в шапке пана: показать поповер под кнопкой.
|
||||
// «◑» в шапке пана: тоггл поповера под кнопкой (дочерний контрол формы).
|
||||
var
|
||||
P: TPanafallPanel;
|
||||
Pop: TPanDisplayPopup;
|
||||
Pt: TPoint;
|
||||
begin
|
||||
if not (Sender is TPanafallPanel) then Exit;
|
||||
P := TPanafallPanel(Sender);
|
||||
if P.BtnDisplay = nil then Exit;
|
||||
if FPanDisplayPopup = nil then
|
||||
begin
|
||||
Pop := TPanDisplayPopup.CreateNew(Self);
|
||||
Pop := TPanDisplayPopup.Create(Self);
|
||||
Pop.OnApplied := OnPanDisplayApplied;
|
||||
Pop.OnResetDefault := OnPanDisplayReset;
|
||||
Pop.OnApplyAll := OnPanDisplayApplyAll;
|
||||
@@ -5810,9 +5808,9 @@ begin
|
||||
end
|
||||
else
|
||||
Pop := TPanDisplayPopup(FPanDisplayPopup);
|
||||
// Экранная позиция левого-нижнего угла кнопки.
|
||||
Pt := P.BtnDisplay.ClientToScreen(Point(0, P.BtnDisplay.Height + 2));
|
||||
Pop.ShowFor(P, Pt.X, Pt.Y);
|
||||
// Повторный клик по «◑» — закрыть.
|
||||
if Pop.Visible then begin Pop.Hide; Exit; end;
|
||||
Pop.PopupBelow(P, P.BtnDisplay);
|
||||
end;
|
||||
|
||||
procedure TMainForm.OnPanDisplayApplied(P: TPanafallPanel; FullRefresh: Boolean);
|
||||
@@ -5904,7 +5902,7 @@ begin
|
||||
if (PanId < 1) or (PanId >= MAX_PANS) then Exit;
|
||||
P := FPans[PanId];
|
||||
if (P = nil) or PanFloating(PanId) then Exit;
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
F := TForm.CreateNew(Self);
|
||||
F.Caption := Format('EWSDR · PAN %d', [PanId]);
|
||||
F.Color := T.BG;
|
||||
@@ -6021,7 +6019,7 @@ procedure TMainForm.ApplyPanHeaderTheme(P: TPanafallPanel);
|
||||
var T: TAppTheme;
|
||||
begin
|
||||
if (P = nil) or (P.HeaderPanel = nil) then Exit;
|
||||
if FLightTheme then T := LightTheme else T := DarkTheme;
|
||||
T := CurrentAppTheme;
|
||||
P.HeaderPanel.Color := T.Panel;
|
||||
P.HeaderLabel.Font.Color := T.Text;
|
||||
// Rate-лейбл: кликабельный (паны N) подсвечиваем акцентом селектора.
|
||||
|
||||
+47
-30
@@ -8,7 +8,10 @@ unit PanDisplayPopup;
|
||||
зеркалит глобальные (для пана 0). Кнопки «Сброс к дефолту» / «Применить ко
|
||||
всем» — через OnResetDefault / OnApplyAll.
|
||||
|
||||
Форма без рамки, поверх всех, гаснет по потере фокуса (OnDeactivate).
|
||||
Реализован как ДОЧЕРНИЙ контрол верхнеуровневой формы (не отдельное окно):
|
||||
Wayland не даёт клиенту позиционировать свои top-level окна — они
|
||||
центрируются компоновщиком. Дочерний контрол позиционируется в клиентских
|
||||
координатах под кнопкой «◑». Закрытие — крестиком «×» или повторным «◑».
|
||||
Этап 3.6 плана мультислайсов (doc/SLICES_PLAN.md), per-pan дисплей.
|
||||
}
|
||||
|
||||
@@ -19,7 +22,7 @@ unit PanDisplayPopup;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, Controls, ExtCtrls, StdCtrls, Graphics, Forms,
|
||||
Classes, SysUtils, Math, Types, Controls, ExtCtrls, StdCtrls, Graphics, Forms,
|
||||
AppTheme, PanafallPanel,
|
||||
FlatButton, FlatComboBox, FlatCheckBox, FlatSpinEdit, FlatFloatSpinEdit;
|
||||
|
||||
@@ -28,7 +31,7 @@ type
|
||||
// FullRefresh=True ⇒ смена палитры/gamma/авто: чистим историю водопада.
|
||||
TPanDisplayApplyEvent = procedure(P: TPanafallPanel; FullRefresh: Boolean) of object;
|
||||
|
||||
TPanDisplayPopup = class(TForm)
|
||||
TPanDisplayPopup = class(TCustomControl)
|
||||
private
|
||||
FPan: TPanafallPanel; // пан, чьи настройки правим (не владеем)
|
||||
FLoading: Boolean; // подавляет OnApplied при программной заливке
|
||||
@@ -61,13 +64,14 @@ type
|
||||
procedure CloseClick(Sender: TObject);
|
||||
procedure ResetClick(Sender: TObject);
|
||||
procedure AllClick(Sender: TObject);
|
||||
procedure DoDeactivate(Sender: TObject);
|
||||
procedure UpdateWfRowEnable;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
public
|
||||
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure LoadFrom(P: TPanafallPanel);
|
||||
// Показать под кнопкой (экранные координаты левого-нижнего угла кнопки).
|
||||
procedure ShowFor(P: TPanafallPanel; ScreenX, ScreenY: Integer);
|
||||
// Показать под контролом-якорем (кнопкой «◑») как дочерний контрол формы.
|
||||
procedure PopupBelow(P: TPanafallPanel; Anchor: TControl);
|
||||
property OnApplied: TPanDisplayApplyEvent read FOnApplied write FOnApplied;
|
||||
property OnResetDefault: TPanDisplayEvent read FOnResetDefault write FOnResetDefault;
|
||||
property OnApplyAll: TPanDisplayEvent read FOnApplyAll write FOnApplyAll;
|
||||
@@ -97,7 +101,7 @@ const
|
||||
|
||||
WF_PALETTE_NAMES: array[0..2] of string = ('Classic', 'Inferno', 'Turbo');
|
||||
|
||||
constructor TPanDisplayPopup.CreateNew(AOwner: TComponent; Num: Integer);
|
||||
constructor TPanDisplayPopup.Create(AOwner: TComponent);
|
||||
var
|
||||
Y: Integer;
|
||||
|
||||
@@ -123,14 +127,13 @@ var
|
||||
end;
|
||||
|
||||
begin
|
||||
inherited CreateNew(AOwner, Num);
|
||||
BorderStyle := bsNone;
|
||||
FormStyle := fsStayOnTop;
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csOpaque];
|
||||
Visible := False;
|
||||
Color := CLR_BG;
|
||||
Font.Name := UI_FONT;
|
||||
Font.Size := 9;
|
||||
Font.Color := CLR_TEXT;
|
||||
OnDeactivate := DoDeactivate;
|
||||
FLoading := False;
|
||||
|
||||
FBg := TPanel.Create(Self);
|
||||
@@ -235,9 +238,18 @@ begin
|
||||
FBtnAll.ClrTextAct := CLR_ACCENT;
|
||||
Inc(Y, ROWH + PAD);
|
||||
|
||||
FBg.Height := Y - 1;
|
||||
ClientWidth := POP_W;
|
||||
ClientHeight := Y + 1;
|
||||
FBg.Height := Y - 1;
|
||||
Width := POP_W;
|
||||
Height := Y + 1;
|
||||
end;
|
||||
|
||||
procedure TPanDisplayPopup.Paint;
|
||||
begin
|
||||
// 1px рамка вокруг FBg (FBg = CLR_PANEL перекрывает нутро).
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Color := CLR_BG;
|
||||
Canvas.Pen.Style := psClear;
|
||||
Canvas.FillRect(0, 0, Width, Height);
|
||||
end;
|
||||
|
||||
function TPanDisplayPopup.MakeLbl(const Cap: string; ALeft, ATop, AW: Integer): TLabel;
|
||||
@@ -334,24 +346,29 @@ begin
|
||||
FOnApplyAll(FPan);
|
||||
end;
|
||||
|
||||
procedure TPanDisplayPopup.DoDeactivate(Sender: TObject);
|
||||
begin
|
||||
Hide;
|
||||
end;
|
||||
|
||||
procedure TPanDisplayPopup.ShowFor(P: TPanafallPanel; ScreenX, ScreenY: Integer);
|
||||
var L, T: Integer;
|
||||
procedure TPanDisplayPopup.PopupBelow(P: TPanafallPanel; Anchor: TControl);
|
||||
var
|
||||
Root: TCustomForm;
|
||||
L, T: Integer;
|
||||
Cl: TPoint;
|
||||
begin
|
||||
if Anchor = nil then Exit;
|
||||
Root := GetParentForm(Anchor);
|
||||
if Root = nil then Exit;
|
||||
LoadFrom(P);
|
||||
L := ScreenX;
|
||||
T := ScreenY;
|
||||
// Кламп в экран.
|
||||
if L + Width > Screen.Width then L := Screen.Width - Width - 4;
|
||||
if L < 0 then L := 4;
|
||||
if T + Height > Screen.Height then T := ScreenY - Height - 4; // раскрыть вверх
|
||||
if T < 0 then T := 4;
|
||||
// Позиция под якорем в КЛИЕНТСКИХ координатах формы (не top-level окно!).
|
||||
Cl := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, Anchor.Height + 2)));
|
||||
L := Cl.X;
|
||||
T := Cl.Y;
|
||||
if L + Width > Root.ClientWidth then L := Root.ClientWidth - Width;
|
||||
if L < 0 then L := 0;
|
||||
if T + Height > Root.ClientHeight then
|
||||
T := Root.ScreenToClient(Anchor.ClientToScreen(Point(0, 0))).Y - Height; // вверх
|
||||
if T < 0 then T := 0;
|
||||
Parent := Root;
|
||||
SetBounds(L, T, Width, Height);
|
||||
Show;
|
||||
Visible := True;
|
||||
BringToFront;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -472,6 +472,13 @@ begin
|
||||
FBtnPopPan.Visible := False; // хозяин включает у панов N>0
|
||||
FBtnClosePan := MakeFlatBtn(FHeaderPanel, '×', 0, 0, 10, 10, BtnClosePanClick);
|
||||
FBtnClosePan.Visible := False; // хозяин включает у панов N>0
|
||||
|
||||
// Курсоры кликабельных лейблов: флаги *Clickable могли быть выставлены ДО
|
||||
// Build (rate — в CreatePanCore), когда лейблов ещё не было → крючок курсора
|
||||
// не применился. Переприменяем теперь, когда лейблы созданы.
|
||||
SetRateClickable(FRateClickable);
|
||||
SetBandClickable(FBandClickable);
|
||||
SetADCClickable(FADCClickable);
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.ReparentTo(NewParent: TWinControl);
|
||||
|
||||
Reference in New Issue
Block a user