mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:37:33 +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:
Claude Opus 4.8
@@ -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.
|
||||
Reference in New Issue
Block a user