diff --git a/FlatPopupMenu.pas b/FlatPopupMenu.pas new file mode 100644 index 0000000..8be16ab --- /dev/null +++ b/FlatPopupMenu.pas @@ -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. diff --git a/MainForm.pas b/MainForm.pas index 9c4396f..08ea2a1 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -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) подсвечиваем акцентом селектора. diff --git a/PanDisplayPopup.pas b/PanDisplayPopup.pas index 1aa772b..41663be 100644 --- a/PanDisplayPopup.pas +++ b/PanDisplayPopup.pas @@ -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. diff --git a/PanafallPanel.pas b/PanafallPanel.pas index 6060b81..ce93591 100644 --- a/PanafallPanel.pas +++ b/PanafallPanel.pas @@ -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);