mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
refactor(slices): этап 3.0A — панадаптер выделен в TPanafallPanel
PanafallPanel.pas: view (CPU/GL), контролы стека (спектр/линейка/сплиттер/ водопад/пан-зум/кнопки зума), геометрия Layout, drag сплиттера и мышь пан/зум-полосы. MainForm работает через алиасы (FSpecView/PbSpectrum/… = FPan.*), размеры областей — FPan.SpectrumWidth/SpectrumHeight/WaterfallHeight. Семантика мыши/флаги/тик пока в MainForm (фаза B). GL-аудит per-instance пройден (глобальных GL-ресурсов нет). План: doc/SLICES_PLAN.md. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
@@ -0,0 +1,518 @@
|
||||
unit PanafallPanel;
|
||||
|
||||
{
|
||||
TPanafallPanel — панадаптер (спектр + линейка частот + сплиттер + водопад +
|
||||
полоса пана/зума с кнопками) как единый composite-объект.
|
||||
|
||||
Этап 3.0 плана мультислайсов (doc/SLICES_PLAN.md): вынос панадаптера из
|
||||
MainForm без изменения поведения. Панель владеет:
|
||||
• конструированием контролов (Build) и SpectrumView (CPU или OpenGL);
|
||||
• геометрией стека спектр/линейка/сплиттер/водопад/пан-зум (Layout);
|
||||
• механикой сплиттера (drag с призраком, пересчёт по MouseUp);
|
||||
• прокидкой мыши пан/зум-полосы в TPanZoomBar.
|
||||
Семантика мыши спектра/водопада (тюн, слайсы, маркер, оверлеи) остаётся у
|
||||
хозяина — он подвешивает свои обработчики через публичные поля Spectrum*/
|
||||
Waterfall*/Zoom*Click ДО вызова Build.
|
||||
|
||||
Хозяин по-прежнему сам синхронизирует состояние view (частоты, палитры,
|
||||
wf-настройки) и решает, когда звать Layout (resize, show/hide, сплиттер).
|
||||
}
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$MODE Delphi}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Math, Controls, ExtCtrls, Graphics, Forms,
|
||||
LCLIntf, LCLType,
|
||||
OpenGLContextEx,
|
||||
SpectrumView, SpectrumViewOpengl, PanZoomBar, FlatButton;
|
||||
|
||||
type
|
||||
TPanafallPanel = class(TComponent)
|
||||
private
|
||||
FParent: TWinControl;
|
||||
FUseOpenGL: Boolean;
|
||||
FView: TSpectrumView;
|
||||
FPbSpectrum: TControl;
|
||||
FPbRuler: TPaintBox;
|
||||
FSplitter: TPanel;
|
||||
FPbWaterfall: TControl;
|
||||
FPbPanZoom: TPaintBox;
|
||||
FZoomBar: TPanZoomBar;
|
||||
FBtnZoomIn: TFlatButton;
|
||||
FBtnZoomDef: TFlatButton;
|
||||
FBtnZoomOut: TFlatButton;
|
||||
|
||||
// Актуальные размеры областей после Layout (для DSP-движка и
|
||||
// resize-детектора хозяина).
|
||||
FSpectrumWidth: Integer;
|
||||
FSpectrumHeight: Integer;
|
||||
FWaterfallHeight: Integer;
|
||||
FShowSpectrum: Boolean;
|
||||
FShowWaterfall: Boolean;
|
||||
FSplitterRatio: Double;
|
||||
|
||||
// Сплиттер-драг: обновление размеров только при отпускании мыши (MouseUp),
|
||||
// чтобы исключить фризы; во время перетаскивания двигаем контролы визуально.
|
||||
FSplitterDrag: Boolean;
|
||||
FSplitterDragY0: Integer;
|
||||
FSplitterSH0: Integer;
|
||||
|
||||
FOnSplitterMoved: TNotifyEvent;
|
||||
|
||||
procedure SplitterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure SplitterMouseMove(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
procedure SplitterMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure PanZoomMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure PanZoomMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||
procedure PanZoomMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure PanZoomDblClick(Sender: TObject);
|
||||
procedure PositionPanZoomBar(BottomY, RW, H: Integer; AVisible: Boolean);
|
||||
public
|
||||
// Обработчики мыши спектра/водопада и кликов зум-кнопок хозяина —
|
||||
// задать ДО вызова Build (Build подвешивает их на создаваемые контролы).
|
||||
SpectrumMouseDown: TMouseEvent;
|
||||
SpectrumMouseMove: TMouseMoveEvent;
|
||||
SpectrumMouseUp: TMouseEvent;
|
||||
SpectrumMouseLeave: TNotifyEvent;
|
||||
SpectrumDblClick: TNotifyEvent;
|
||||
WaterfallMouseDown: TMouseEvent;
|
||||
WaterfallMouseMove: TMouseMoveEvent;
|
||||
WaterfallMouseUp: TMouseEvent;
|
||||
ZoomInClick: TNotifyEvent;
|
||||
ZoomDefClick: TNotifyEvent;
|
||||
ZoomOutClick: TNotifyEvent;
|
||||
|
||||
constructor Create(AOwner: TComponent; AUseOpenGL: Boolean); reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
// Создаёт контролы в AParent и подвешивает обработчики (см. поля выше).
|
||||
procedure Build(AParent: TWinControl; AMSAA: Integer);
|
||||
// Полная раскладка стека. ATopOffset — высота wideband-блока хозяина
|
||||
// над спектром. Show-флаги приходят от контроллера (FShowSpectrum/
|
||||
// FShowWaterfall).
|
||||
procedure Layout(ATopOffset: Integer; AShowSpectrum, AShowWaterfall: Boolean);
|
||||
|
||||
property View: TSpectrumView read FView;
|
||||
property PbSpectrum: TControl read FPbSpectrum;
|
||||
property PbRuler: TPaintBox read FPbRuler;
|
||||
property Splitter: TPanel read FSplitter;
|
||||
property PbWaterfall: TControl read FPbWaterfall;
|
||||
property PbPanZoom: TPaintBox read FPbPanZoom;
|
||||
property ZoomBar: TPanZoomBar read FZoomBar;
|
||||
property BtnZoomIn: TFlatButton read FBtnZoomIn;
|
||||
property BtnZoomDef: TFlatButton read FBtnZoomDef;
|
||||
property BtnZoomOut: TFlatButton read FBtnZoomOut;
|
||||
|
||||
property SpectrumWidth: Integer read FSpectrumWidth;
|
||||
property SpectrumHeight: Integer read FSpectrumHeight;
|
||||
property WaterfallHeight: Integer read FWaterfallHeight;
|
||||
property SplitterRatio: Double read FSplitterRatio write FSplitterRatio;
|
||||
// Пользователь отпустил сплиттер (ratio уже обновлён) — хозяин делает
|
||||
// полный пересчёт (у него wideband/S-метр/оверлеи).
|
||||
property OnSplitterMoved: TNotifyEvent read FOnSplitterMoved write FOnSplitterMoved;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TPanafallPanel.Create(AOwner: TComponent; AUseOpenGL: Boolean);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FUseOpenGL := AUseOpenGL;
|
||||
if FUseOpenGL then
|
||||
FView := TSpectrumViewOpenGL.Create
|
||||
else
|
||||
FView := TSpectrumView.Create;
|
||||
FZoomBar := TPanZoomBar.Create;
|
||||
FSplitterRatio := 0.40;
|
||||
FSplitterDrag := False;
|
||||
end;
|
||||
|
||||
destructor TPanafallPanel.Destroy;
|
||||
begin
|
||||
// Порядок как в прежнем FormDestroy: view/зум-бар первыми, контролы
|
||||
// (Owner=Self) освободит inherited.
|
||||
FreeAndNil(FZoomBar);
|
||||
FreeAndNil(FView);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.Build(AParent: TWinControl; AMSAA: Integer);
|
||||
begin
|
||||
FParent := AParent;
|
||||
|
||||
if FUseOpenGL then
|
||||
begin
|
||||
FPbSpectrum := TOpenGLControl.Create(Self);
|
||||
TOpenGLControl(FPbSpectrum).AutoResizeViewport := False;
|
||||
TOpenGLControl(FPbSpectrum).DoubleBuffered := True;
|
||||
TOpenGLControl(FPbSpectrum).MultiSampling := Max(1, AMSAA);
|
||||
TOpenGLControl(FPbSpectrum).OnPaint := FView.PaintSpectrum;
|
||||
TOpenGLControl(FPbSpectrum).OnMouseDown := SpectrumMouseDown;
|
||||
TOpenGLControl(FPbSpectrum).OnDblClick := SpectrumDblClick;
|
||||
TOpenGLControl(FPbSpectrum).OnMouseMove := SpectrumMouseMove;
|
||||
TOpenGLControl(FPbSpectrum).OnMouseUp := SpectrumMouseUp;
|
||||
TOpenGLControl(FPbSpectrum).OnMouseLeave := SpectrumMouseLeave;
|
||||
TSpectrumViewOpenGL(FView).AttachControl(TOpenGLControl(FPbSpectrum));
|
||||
end
|
||||
else
|
||||
begin
|
||||
FPbSpectrum := TPaintBox.Create(Self);
|
||||
TPaintBox(FPbSpectrum).OnPaint := FView.PaintSpectrum;
|
||||
TPaintBox(FPbSpectrum).OnMouseDown := SpectrumMouseDown;
|
||||
TPaintBox(FPbSpectrum).OnDblClick := SpectrumDblClick;
|
||||
TPaintBox(FPbSpectrum).OnMouseMove := SpectrumMouseMove;
|
||||
TPaintBox(FPbSpectrum).OnMouseUp := SpectrumMouseUp;
|
||||
TPaintBox(FPbSpectrum).OnMouseLeave := SpectrumMouseLeave;
|
||||
end;
|
||||
FPbSpectrum.Parent := AParent;
|
||||
|
||||
FPbRuler := TPaintBox.Create(Self);
|
||||
FPbRuler.Parent := AParent;
|
||||
FPbRuler.OnPaint := FView.PaintRuler;
|
||||
FPbRuler.Cursor := crDefault;
|
||||
FView.PbRuler := FPbRuler;
|
||||
|
||||
// ---- Сплиттер между спектром+линейкой и водопадом ----
|
||||
FSplitter := TPanel.Create(Self);
|
||||
FSplitter.Parent := AParent;
|
||||
FSplitter.BevelOuter := bvNone;
|
||||
FSplitter.Color := TColor($00303030);
|
||||
FSplitter.Cursor := crVSplit;
|
||||
FSplitter.Height := 5;
|
||||
FSplitter.OnMouseDown := SplitterMouseDown;
|
||||
FSplitter.OnMouseMove := SplitterMouseMove;
|
||||
FSplitter.OnMouseUp := SplitterMouseUp;
|
||||
|
||||
if FUseOpenGL then
|
||||
begin
|
||||
FPbWaterfall := TOpenGLControl.Create(Self);
|
||||
TOpenGLControl(FPbWaterfall).AutoResizeViewport := False;
|
||||
TOpenGLControl(FPbWaterfall).DoubleBuffered := True;
|
||||
TOpenGLControl(FPbWaterfall).OnPaint := FView.PaintWaterfall;
|
||||
TOpenGLControl(FPbWaterfall).OnMouseDown := WaterfallMouseDown;
|
||||
TOpenGLControl(FPbWaterfall).OnMouseMove := WaterfallMouseMove;
|
||||
TOpenGLControl(FPbWaterfall).OnMouseUp := WaterfallMouseUp;
|
||||
TSpectrumViewOpenGL(FView).AttachWaterfallControl(TOpenGLControl(FPbWaterfall));
|
||||
end
|
||||
else
|
||||
begin
|
||||
FPbWaterfall := TPaintBox.Create(Self);
|
||||
TPaintBox(FPbWaterfall).OnPaint := FView.PaintWaterfall;
|
||||
TPaintBox(FPbWaterfall).OnMouseDown := WaterfallMouseDown;
|
||||
TPaintBox(FPbWaterfall).OnMouseMove := WaterfallMouseMove;
|
||||
TPaintBox(FPbWaterfall).OnMouseUp := WaterfallMouseUp;
|
||||
end;
|
||||
FPbWaterfall.Parent := AParent;
|
||||
|
||||
// ---- Панель пана/зума под водопадом ----
|
||||
// Кнопки создаём с дефолтными цветами; финальная тема — у хозяина
|
||||
// (ApplyDarkTheme → StyleButton/SetTheme через алиасы).
|
||||
FPbPanZoom := TPaintBox.Create(Self);
|
||||
FPbPanZoom.Parent := AParent;
|
||||
FPbPanZoom.OnPaint := FZoomBar.Paint;
|
||||
FPbPanZoom.OnMouseDown := PanZoomMouseDown;
|
||||
FPbPanZoom.OnMouseMove := PanZoomMouseMove;
|
||||
FPbPanZoom.OnMouseUp := PanZoomMouseUp;
|
||||
FPbPanZoom.OnDblClick := PanZoomDblClick;
|
||||
FZoomBar.PaintBox := FPbPanZoom;
|
||||
FBtnZoomOut := MakeFlatBtn(AParent, '−', 0, 0, 10, 10, ZoomOutClick);
|
||||
FBtnZoomDef := MakeFlatBtn(AParent, '⌂', 0, 0, 10, 10, ZoomDefClick);
|
||||
FBtnZoomIn := MakeFlatBtn(AParent, '+', 0, 0, 10, 10, ZoomInClick);
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.PositionPanZoomBar(BottomY, RW, H: Integer;
|
||||
AVisible: Boolean);
|
||||
var BtnW, Gap, StripW, X: Integer;
|
||||
begin
|
||||
if (FPbPanZoom = nil) or (FBtnZoomIn = nil) then Exit;
|
||||
FPbPanZoom.Visible := AVisible;
|
||||
FBtnZoomIn.Visible := AVisible;
|
||||
FBtnZoomDef.Visible := AVisible;
|
||||
FBtnZoomOut.Visible := AVisible;
|
||||
if not AVisible then Exit;
|
||||
Gap := MulDiv(2, Screen.PixelsPerInch, 96);
|
||||
BtnW := H; // квадратные кнопки в высоту строки
|
||||
StripW := RW - 3 * BtnW - 4 * Gap;
|
||||
if StripW < 20 then StripW := 20;
|
||||
FPbPanZoom.SetBounds(0, BottomY, StripW, H);
|
||||
X := StripW + Gap;
|
||||
FBtnZoomOut.SetBounds(X, BottomY, BtnW, H); Inc(X, BtnW + Gap);
|
||||
FBtnZoomDef.SetBounds(X, BottomY, BtnW, H); Inc(X, BtnW + Gap);
|
||||
FBtnZoomIn.SetBounds(X, BottomY, BtnW, H);
|
||||
FPbPanZoom.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.Layout(ATopOffset: Integer;
|
||||
AShowSpectrum, AShowWaterfall: Boolean);
|
||||
const
|
||||
SPLITTER_H = 5;
|
||||
MIN_SH = 60; // минимальная высота спектра
|
||||
MIN_WH = 40; // минимальная высота водопада
|
||||
var
|
||||
RW, RH, SH, WH, TopOff: Integer;
|
||||
AvailH: Integer;
|
||||
RULER_H: Integer;
|
||||
PANZOOM_H: Integer;
|
||||
ShowPZ: Boolean;
|
||||
begin
|
||||
if (FParent = nil) or (FPbSpectrum = nil) then Exit;
|
||||
FShowSpectrum := AShowSpectrum;
|
||||
FShowWaterfall := AShowWaterfall;
|
||||
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
|
||||
RW := FParent.ClientWidth;
|
||||
RH := FParent.ClientHeight;
|
||||
// Резервируем низ под панель пана/зума (видна, если виден спектр или водопад).
|
||||
PANZOOM_H := MulDiv(22, Screen.PixelsPerInch, 96);
|
||||
ShowPZ := AShowSpectrum or AShowWaterfall;
|
||||
PositionPanZoomBar(RH - PANZOOM_H, RW, PANZOOM_H, ShowPZ);
|
||||
if ShowPZ then RH := RH - PANZOOM_H;
|
||||
TopOff := ATopOffset;
|
||||
|
||||
// ---- Оба скрыты ----
|
||||
if (not AShowSpectrum) and (not AShowWaterfall) then
|
||||
begin
|
||||
FPbSpectrum.Visible := False;
|
||||
FPbRuler.Visible := False;
|
||||
FSplitter.Visible := False;
|
||||
FPbWaterfall.Visible := False;
|
||||
FSpectrumWidth := RW;
|
||||
FSpectrumHeight := 0;
|
||||
FWaterfallHeight := 0;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// ---- Только спектр (водопад скрыт) ----
|
||||
if AShowSpectrum and (not AShowWaterfall) then
|
||||
begin
|
||||
AvailH := RH - TopOff - RULER_H;
|
||||
if AvailH < MIN_SH then AvailH := MIN_SH;
|
||||
SH := AvailH;
|
||||
FPbSpectrum.SetBounds(0, TopOff, RW, SH);
|
||||
FPbSpectrum.Visible := True;
|
||||
FPbRuler.SetBounds(0, TopOff + SH, RW, RULER_H);
|
||||
FPbRuler.Visible := True;
|
||||
FSplitter.Visible := False;
|
||||
FPbWaterfall.Visible := False;
|
||||
FSpectrumWidth := RW;
|
||||
FSpectrumHeight := SH;
|
||||
FWaterfallHeight := 0;
|
||||
if RW > 0 then
|
||||
begin
|
||||
FView.SetSpectrumBitmapSize(RW, SH);
|
||||
FView.SetWaterfallBitmapSize(1, 1);
|
||||
FView.SetRulerSize(RW, RULER_H);
|
||||
FView.DrawSpectrum;
|
||||
FPbSpectrum.Invalidate;
|
||||
FPbRuler.Invalidate;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// ---- Только водопад (спектр скрыт): линейка под водопадом ----
|
||||
if (not AShowSpectrum) and AShowWaterfall then
|
||||
begin
|
||||
AvailH := RH - TopOff - RULER_H;
|
||||
if AvailH < MIN_WH then AvailH := MIN_WH;
|
||||
WH := AvailH;
|
||||
FPbSpectrum.Visible := False;
|
||||
FSplitter.Visible := False;
|
||||
FPbWaterfall.SetBounds(0, TopOff, RW, WH);
|
||||
FPbWaterfall.Visible := True;
|
||||
FPbRuler.SetBounds(0, TopOff + WH, RW, RULER_H);
|
||||
FPbRuler.Visible := True;
|
||||
FSpectrumWidth := RW;
|
||||
FSpectrumHeight := 0;
|
||||
FWaterfallHeight := WH;
|
||||
if RW > 0 then
|
||||
begin
|
||||
FView.SetSpectrumBitmapSize(1, 1);
|
||||
FView.SetWaterfallBitmapSize(RW, WH);
|
||||
FView.SetRulerSize(RW, RULER_H);
|
||||
FView.DrawWaterfall;
|
||||
FPbWaterfall.Invalidate;
|
||||
FPbRuler.Invalidate;
|
||||
end;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// ---- Оба видимы: стандартный режим со сплиттером ----
|
||||
FPbSpectrum.Visible := True;
|
||||
FPbRuler.Visible := True;
|
||||
FSplitter.Visible := True;
|
||||
FPbWaterfall.Visible := True;
|
||||
|
||||
AvailH := RH - TopOff - RULER_H - SPLITTER_H;
|
||||
if AvailH < (MIN_SH + MIN_WH) then Exit;
|
||||
|
||||
// Ограничиваем соотношение, чтобы каждая зона имела минимальный размер
|
||||
if FSplitterRatio < MIN_SH / AvailH then
|
||||
FSplitterRatio := MIN_SH / AvailH;
|
||||
if FSplitterRatio > 1.0 - MIN_WH / AvailH then
|
||||
FSplitterRatio := 1.0 - MIN_WH / AvailH;
|
||||
|
||||
SH := Round(AvailH * FSplitterRatio);
|
||||
WH := AvailH - SH;
|
||||
if WH < MIN_WH then WH := MIN_WH;
|
||||
|
||||
// Спектр
|
||||
FPbSpectrum.SetBounds(0, TopOff, RW, SH);
|
||||
// Линейка частот — всегда прижата к низу спектра
|
||||
FPbRuler.SetBounds(0, TopOff + SH, RW, RULER_H);
|
||||
// Сплиттер — между линейкой и водопадом
|
||||
FSplitter.SetBounds(0, TopOff + SH + RULER_H, RW, SPLITTER_H);
|
||||
// Водопад — под сплиттером
|
||||
FPbWaterfall.SetBounds(0, TopOff + SH + RULER_H + SPLITTER_H, RW, WH);
|
||||
|
||||
// Обновляем переменные размеров
|
||||
FSpectrumWidth := RW;
|
||||
FSpectrumHeight := SH;
|
||||
FWaterfallHeight := WH;
|
||||
|
||||
// Пересоздаём bitmap точно под новый размер
|
||||
if RW > 0 then
|
||||
begin
|
||||
if SH > 0 then FView.SetSpectrumBitmapSize(RW, SH);
|
||||
if WH > 0 then FView.SetWaterfallBitmapSize(RW, WH);
|
||||
FView.SetRulerSize(RW, RULER_H);
|
||||
FView.DrawSpectrum;
|
||||
FPbSpectrum.Invalidate;
|
||||
if FPbRuler <> nil then FPbRuler.Invalidate;
|
||||
FPbWaterfall.Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ===========================================================================
|
||||
// Splitter — перетаскивание границы спектр/водопад
|
||||
// Обновление размеров происходит только при отпускании мыши (MouseUp),
|
||||
// чтобы исключить фризы во время перетаскивания.
|
||||
// Во время перетаскивания рисуем только призрак-линию на сплиттере.
|
||||
// ===========================================================================
|
||||
|
||||
procedure TPanafallPanel.SplitterMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
if Button <> mbLeft then Exit;
|
||||
FSplitterDrag := True;
|
||||
FSplitterSH0 := FSpectrumHeight;
|
||||
// Y в координатах родителя (области панадаптера)
|
||||
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
|
||||
FSplitterDragY0 := P.Y;
|
||||
FSplitter.Color := TColor($005050A0); // подсветка при захвате
|
||||
{$IFDEF WINDOWS}
|
||||
SetCapture(FSplitter.Handle);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.SplitterMouseMove(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
var
|
||||
P: TPoint;
|
||||
DeltaY: Integer;
|
||||
NewSH: Integer;
|
||||
TopOff, AvailH: Integer;
|
||||
RULER_H: Integer;
|
||||
const
|
||||
SPLITTER_H = 5;
|
||||
MIN_SH = 60;
|
||||
MIN_WH = 40;
|
||||
begin
|
||||
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
|
||||
if not FSplitterDrag then Exit;
|
||||
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
|
||||
DeltaY := P.Y - FSplitterDragY0;
|
||||
|
||||
TopOff := 0;
|
||||
// Низ зарезервирован под панель пана/зума (она видна, пока виден водопад).
|
||||
AvailH := FParent.ClientHeight - TopOff - RULER_H - SPLITTER_H
|
||||
- MulDiv(22, Screen.PixelsPerInch, 96);
|
||||
if AvailH <= 0 then Exit;
|
||||
|
||||
NewSH := FSplitterSH0 + DeltaY;
|
||||
if NewSH < MIN_SH then NewSH := MIN_SH;
|
||||
if NewSH > AvailH - MIN_WH then NewSH := AvailH - MIN_WH;
|
||||
|
||||
// Только двигаем сплиттер визуально — без пересчёта битмапов
|
||||
FSplitter.Top := TopOff + NewSH + RULER_H;
|
||||
FPbWaterfall.Top := TopOff + NewSH + RULER_H + SPLITTER_H;
|
||||
FPbWaterfall.Height := AvailH - NewSH;
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.SplitterMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
P: TPoint;
|
||||
DeltaY: Integer;
|
||||
NewSH: Integer;
|
||||
TopOff, AvailH: Integer;
|
||||
RULER_H: Integer;
|
||||
const
|
||||
SPLITTER_H = 5;
|
||||
MIN_SH = 60;
|
||||
MIN_WH = 40;
|
||||
begin
|
||||
RULER_H := MulDiv(18, Screen.PixelsPerInch, 96);
|
||||
if not FSplitterDrag then Exit;
|
||||
FSplitterDrag := False;
|
||||
{$IFDEF WINDOWS}
|
||||
ReleaseCapture;
|
||||
{$ENDIF}
|
||||
FSplitter.Color := TColor($00303030); // обычный цвет
|
||||
|
||||
P := FParent.ScreenToClient(FSplitter.ClientToScreen(Point(X, Y)));
|
||||
DeltaY := P.Y - FSplitterDragY0;
|
||||
|
||||
TopOff := 0;
|
||||
// Низ зарезервирован под панель пана/зума (она видна, пока виден водопад).
|
||||
AvailH := FParent.ClientHeight - TopOff - RULER_H - SPLITTER_H
|
||||
- MulDiv(22, Screen.PixelsPerInch, 96);
|
||||
if AvailH <= 0 then Exit;
|
||||
|
||||
NewSH := FSplitterSH0 + DeltaY;
|
||||
if NewSH < MIN_SH then NewSH := MIN_SH;
|
||||
if NewSH > AvailH - MIN_WH then NewSH := AvailH - MIN_WH;
|
||||
|
||||
// Сохраняем новое соотношение; полный пересчёт с перерисовкой — у хозяина
|
||||
// (ему виднее: wideband, S-метр, оверлеи).
|
||||
FSplitterRatio := NewSH / AvailH;
|
||||
if Assigned(FOnSplitterMoved) then FOnSplitterMoved(Self);
|
||||
end;
|
||||
|
||||
// ===========================================================================
|
||||
// Пан/зум-полоса — прокидка мыши в TPanZoomBar
|
||||
// ===========================================================================
|
||||
|
||||
procedure TPanafallPanel.PanZoomMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if FZoomBar <> nil then FZoomBar.HandleMouseDown(Button, X, Y);
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.PanZoomMouseMove(Sender: TObject; Shift: TShiftState;
|
||||
X, Y: Integer);
|
||||
begin
|
||||
if FZoomBar <> nil then FZoomBar.HandleMouseMove(X, Y);
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.PanZoomMouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
if FZoomBar <> nil then FZoomBar.HandleMouseUp;
|
||||
end;
|
||||
|
||||
procedure TPanafallPanel.PanZoomDblClick(Sender: TObject);
|
||||
begin
|
||||
if FZoomBar <> nil then FZoomBar.HandleDblClick;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user