Render sample rate overlay into spectrum bitmap

This commit is contained in:
2026-05-22 17:15:29 +03:00
parent ea6e57b8b8
commit 26aa55ddde
3 changed files with 195 additions and 90 deletions
+155 -84
View File
@@ -1,9 +1,9 @@
unit SampleRateOverlay;
{
Overlay виджет для выбора sample rate (span) спектра.
Размещается в верхнем левом углу спектрограммы поверх PbSpectrum.
Содержит кнопку скрытия левой панели и ряд кнопок span.
Bitmap overlay для выбора sample rate (span) спектра.
Рисуется прямо в bitmap спектра, как AlertOverlay, поэтому фон под ним
смешивается вручную через alpha.
}
{$IFDEF FPC}
@@ -19,32 +19,43 @@ type
TSpanSelectEvent = procedure(SampleRate: Integer) of object;
THidePanelEvent = procedure of object;
TSampleRateOverlay = class(TCustomControl)
TSampleRateOverlay = class(TComponent)
private
FCurrentRate: Integer;
FPanelHidden: Boolean;
FOnSpanSelect: TSpanSelectEvent;
FOnHidePanel: THidePanelEvent;
FOnInvalidate: TNotifyEvent;
FLeft: Integer;
FTop: Integer;
FWidth: Integer;
FHeight: Integer;
FHitRects: array[0..6] of TRect; // [0]=hide button, [1..6]=span buttons
FHitValues: array[0..6] of Integer; // 0=hide, else sample rate
FHitCount: Integer;
FHotIdx: Integer;
procedure DrawSelf(C: TCanvas; W, H: Integer);
procedure DrawSelf(Target: TBitmap; C: TCanvas; OriginX, OriginY, W, H: Integer);
procedure RegisterHit(const HR: TRect; Value: 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 RequestInvalidate;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
procedure DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
function HandleMouseMove(X, Y: Integer): Boolean;
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
function HandleMouseLeave: Boolean;
procedure SetCurrentRate(Rate: Integer);
procedure SetPanelHidden(Hidden: Boolean);
property Left: Integer read FLeft;
property Top: Integer read FTop;
property Width: Integer read FWidth;
property Height: Integer read FHeight;
property HotIdx: Integer read FHotIdx;
property OnSpanSelect: TSpanSelectEvent read FOnSpanSelect write FOnSpanSelect;
property OnHidePanel: THidePanelEvent read FOnHidePanel write FOnHidePanel;
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
end;
implementation
@@ -59,14 +70,44 @@ const
PAD_Y = 4;
BTN_GAP = 3;
CLR_BG = TColor($00141414);
CLR_BORDER = TColor($00505050);
CLR_TEXT = TColor($00D8E6EE);
CLR_BTN_NORM = TColor($00543F18);
CLR_BTN_HOT = TColor($00624B1D);
CLR_BTN_ACT = TColor($00785A20);
CLR_BTN_BDR = TColor($00685624);
procedure BlendRect(Target: TBitmap; const Rct: TRect; R, G, B, Alpha: Byte);
var
Y, X, InvA: Integer;
Row: PByte;
RR: TRect;
begin
if (Target = nil) or (Alpha = 0) then Exit;
RR := Rct;
if RR.Left < 0 then RR.Left := 0;
if RR.Top < 0 then RR.Top := 0;
if RR.Right > Target.Width then RR.Right := Target.Width;
if RR.Bottom > Target.Height then RR.Bottom := Target.Height;
if (RR.Right <= RR.Left) or (RR.Bottom <= RR.Top) then Exit;
InvA := 255 - Alpha;
Target.BeginUpdate(False);
try
for Y := RR.Top to RR.Bottom - 1 do
begin
Row := PByte(Target.ScanLine[Y]);
if Row = nil then Continue;
Inc(Row, RR.Left * 4);
for X := RR.Left to RR.Right - 1 do
begin
Row[0] := Byte((Alpha * B + InvA * Row[0]) div 255);
Row[1] := Byte((Alpha * G + InvA * Row[1]) div 255);
Row[2] := Byte((Alpha * R + InvA * Row[2]) div 255);
Inc(Row, 4);
end;
end;
finally
Target.EndUpdate(False);
end;
end;
function SpanBtnWidth(const Name: string; C: TCanvas): Integer;
begin
C.Font.Name := 'Courier New';
@@ -79,108 +120,133 @@ end;
constructor TSampleRateOverlay.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FCurrentRate := 192000;
FPanelHidden := False;
FHitCount := 0;
FHotIdx := -1;
Cursor := crHandPoint;
Width := 320;
Height := SPAN_H + PAD_Y * 2;
FCurrentRate := 192000;
FPanelHidden := False;
FHitCount := 0;
FHotIdx := -1;
FWidth := 320;
FHeight := SPAN_H + PAD_Y * 2;
end;
procedure TSampleRateOverlay.RequestInvalidate;
begin
if Assigned(FOnInvalidate) then FOnInvalidate(Self);
end;
procedure TSampleRateOverlay.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if (FLeft = ALeft) and (FTop = ATop) and
(FWidth = AWidth) and (FHeight = AHeight) then Exit;
FLeft := ALeft;
FTop := ATop;
FWidth := AWidth;
FHeight := AHeight;
RequestInvalidate;
end;
procedure TSampleRateOverlay.RegisterHit(const HR: TRect; Value: Integer);
begin
if FHitCount > High(FHitRects) then Exit;
FHitRects[FHitCount] := HR;
FHitRects[FHitCount] := HR;
FHitValues[FHitCount] := Value;
Inc(FHitCount);
end;
procedure TSampleRateOverlay.DrawSelf(C: TCanvas; W, H: Integer);
procedure TSampleRateOverlay.DrawSelf(Target: TBitmap; C: TCanvas;
OriginX, OriginY, W, H: Integer);
var
X, I, TW, TH, BtnW: Integer;
HR: TRect;
X, I, TW, TH, BtnW, ContentW: Integer;
HR, FullR: TRect;
IsAct, IsHot: Boolean;
Cap: string;
begin
if (Target = nil) or (C = nil) then Exit;
FHitCount := 0;
// Фон
C.Brush.Color := CLR_BG;
C.Brush.Style := bsSolid;
C.Pen.Style := psClear;
C.FillRect(Rect(0, 0, W, H));
// Рамка
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BORDER;
C.Brush.Style := bsClear;
C.Rectangle(0, 0, W, H);
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Name := 'Courier New';
C.Font.Size := 7;
C.Font.Style := [];
TH := C.TextHeight('A');
X := PAD_X;
// Кнопка скрытия панели (◀ или ▶)
HR := Rect(X, PAD_Y, X + HIDE_W, PAD_Y + SPAN_H);
IsHot := (FHotIdx = 0);
if IsHot then C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid; C.Pen.Style := psClear;
C.FillRect(HR);
C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR;
C.Brush.Style := bsClear; C.Rectangle(HR);
C.Font.Size := 8;
if FPanelHidden then Cap := '▶' else Cap := '◀';
TW := C.TextWidth(Cap); C.Font.Size := 7;
C.Font.Color := CLR_TEXT;
ContentW := PAD_X + HIDE_W + BTN_GAP;
for I := 0 to High(SPAN_NAMES) do
begin
Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], C));
if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP);
end;
Inc(ContentW, PAD_X);
if ContentW > W then ContentW := W;
FullR := Rect(OriginX, OriginY, OriginX + ContentW, OriginY + H);
BlendRect(Target, FullR, $14, $14, $14, 104);
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Right, FullR.Top + 1),
$80, $80, $80, 56);
BlendRect(Target, Rect(FullR.Left, FullR.Bottom - 1, FullR.Right, FullR.Bottom),
$00, $00, $00, 48);
BlendRect(Target, Rect(FullR.Left, FullR.Top, FullR.Left + 1, FullR.Bottom),
$80, $80, $80, 42);
BlendRect(Target, Rect(FullR.Right - 1, FullR.Top, FullR.Right, FullR.Bottom),
$00, $00, $00, 42);
X := OriginX + PAD_X;
HR := Rect(X, OriginY + PAD_Y, X + HIDE_W, OriginY + PAD_Y + SPAN_H);
IsHot := FHotIdx = 0;
if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
else BlendRect(Target, HR, $18, $3F, $54, 182);
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BTN_BDR;
C.Brush.Style := bsClear;
C.Rectangle(HR);
C.Font.Size := 8;
if FPanelHidden then Cap := '>' else Cap := '<';
TW := C.TextWidth(Cap);
C.Font.Color := CLR_TEXT;
C.Brush.Style := bsClear;
C.Font.Size := 8;
C.TextOut(HR.Left + (HIDE_W - TW) div 2,
HR.Top + (SPAN_H - TH) div 2, Cap);
HR.Top + (SPAN_H - TH) div 2, Cap);
C.Font.Size := 7;
RegisterHit(HR, 0);
Inc(X, HIDE_W + BTN_GAP);
// Кнопки span
for I := 0 to High(SPAN_RATES) do
begin
BtnW := SpanBtnWidth(SPAN_NAMES[I], C);
HR := Rect(X, PAD_Y, X + BtnW, PAD_Y + SPAN_H);
IsAct := (SPAN_RATES[I] = FCurrentRate);
IsHot := (FHotIdx = I + 1);
BtnW := SpanBtnWidth(SPAN_NAMES[I], C);
HR := Rect(X, OriginY + PAD_Y, X + BtnW, OriginY + PAD_Y + SPAN_H);
IsAct := SPAN_RATES[I] = FCurrentRate;
IsHot := FHotIdx = I + 1;
if IsAct then C.Brush.Color := CLR_BTN_ACT
else if IsHot then C.Brush.Color := CLR_BTN_HOT
else C.Brush.Color := CLR_BTN_NORM;
C.Brush.Style := bsSolid; C.Pen.Style := psClear;
C.FillRect(HR);
C.Pen.Style := psSolid; C.Pen.Color := CLR_BTN_BDR;
C.Brush.Style := bsClear; C.Rectangle(HR);
if IsAct then BlendRect(Target, HR, $20, $5A, $78, 220)
else if IsHot then BlendRect(Target, HR, $1D, $4B, $62, 206)
else BlendRect(Target, HR, $18, $3F, $54, 182);
C.Pen.Style := psSolid;
C.Pen.Color := CLR_BTN_BDR;
C.Brush.Style := bsClear;
C.Rectangle(HR);
TW := C.TextWidth(SPAN_NAMES[I]);
C.Font.Color := CLR_TEXT;
C.Font.Color := CLR_TEXT;
C.Brush.Style := bsClear;
C.TextOut(HR.Left + (BtnW - TW) div 2,
HR.Top + (SPAN_H - TH) div 2, SPAN_NAMES[I]);
HR.Top + (SPAN_H - TH) div 2, SPAN_NAMES[I]);
RegisterHit(HR, SPAN_RATES[I]);
Inc(X, BtnW + BTN_GAP);
end;
end;
procedure TSampleRateOverlay.Paint;
procedure TSampleRateOverlay.DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
begin
DrawSelf(Canvas, Width, Height);
if (FWidth <= 0) or (FHeight <= 0) then Exit;
if (FLeft >= W) or (FTop >= H) then Exit;
DrawSelf(Target, C, FLeft, FTop, Min(FWidth, W - FLeft), Min(FHeight, H - FTop));
end;
procedure TSampleRateOverlay.MouseMove(Shift: TShiftState; X, Y: Integer);
function TSampleRateOverlay.HandleMouseMove(X, Y: Integer): Boolean;
var
I, OldHot: Integer;
begin
Result := False;
OldHot := FHotIdx;
FHotIdx := -1;
for I := 0 to FHitCount - 1 do
@@ -189,15 +255,18 @@ begin
FHotIdx := I;
Break;
end;
if FHotIdx <> OldHot then Invalidate;
inherited MouseMove(Shift, X, Y);
if FHotIdx <> OldHot then
begin
RequestInvalidate;
Result := True;
end;
end;
procedure TSampleRateOverlay.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
function TSampleRateOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
var
I: Integer;
begin
Result := False;
if Button <> mbLeft then Exit;
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
@@ -210,32 +279,34 @@ begin
begin
if Assigned(FOnSpanSelect) then FOnSpanSelect(FHitValues[I]);
end;
Result := True;
Break;
end;
end;
procedure TSampleRateOverlay.MouseLeave;
function TSampleRateOverlay.HandleMouseLeave: Boolean;
begin
Result := False;
if FHotIdx >= 0 then
begin
FHotIdx := -1;
Invalidate;
RequestInvalidate;
Result := True;
end;
inherited MouseLeave;
end;
procedure TSampleRateOverlay.SetCurrentRate(Rate: Integer);
begin
if FCurrentRate = Rate then Exit;
FCurrentRate := Rate;
Invalidate;
RequestInvalidate;
end;
procedure TSampleRateOverlay.SetPanelHidden(Hidden: Boolean);
begin
if FPanelHidden = Hidden then Exit;
FPanelHidden := Hidden;
Invalidate;
RequestInvalidate;
end;
end.