add alert overlay

This commit is contained in:
2026-05-21 15:38:56 +03:00
parent 5800e9ec35
commit b5103bf474
2 changed files with 126 additions and 1 deletions
+109
View File
@@ -0,0 +1,109 @@
unit AlertOverlay;
{
Reusable overlays for spectrum-like bitmap surfaces.
}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
interface
uses
Graphics, Types, Math;
procedure DrawAlertOverlay(Target: TBitmap; C: TCanvas; W, H: Integer;
const Title, Detail: string);
implementation
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;
procedure DrawAlertOverlay(Target: TBitmap; C: TCanvas; W, H: Integer;
const Title, Detail: string);
const
PAD = 12;
INNER_X = 12;
ACCENT_W = 4;
var
R, AccentR: TRect;
TW, DW, BoxW, BoxH: Integer;
begin
if (Target = nil) or (C = nil) then Exit;
if (W < 220) or (H < 60) then Exit;
C.Font.Name := 'Courier New';
C.Font.Style := [fsBold];
C.Font.Size := 9;
TW := C.TextWidth(Title);
C.Font.Style := [];
C.Font.Size := 7;
DW := C.TextWidth(Detail);
BoxW := Max(TW, DW) + INNER_X * 2 + ACCENT_W + 8;
BoxH := 42;
R := Rect(W - PAD - BoxW, PAD, W - PAD, PAD + BoxH);
BlendRect(Target, R, $A8, $10, $16, 118);
BlendRect(Target, Rect(R.Left, R.Top, R.Right, R.Top + 1), $FF, $68, $68, 80);
C.Brush.Style := bsClear;
C.Pen.Style := psSolid;
C.Pen.Width := 1;
C.Pen.Color := TColor($003838C8);
C.Rectangle(R);
AccentR := Rect(R.Left + 7, R.Top + 7, R.Left + 7 + ACCENT_W, R.Bottom - 7);
C.Brush.Style := bsSolid;
C.Brush.Color := TColor($002828F0);
C.Pen.Style := psClear;
C.FillRect(AccentR);
C.Brush.Style := bsClear;
C.Font.Name := 'Courier New';
C.Font.Style := [fsBold];
C.Font.Size := 9;
C.Font.Color := TColor($008888FF);
C.TextOut(R.Left + INNER_X + ACCENT_W + 8, R.Top + 7, Title);
C.Font.Style := [];
C.Font.Size := 7;
C.Font.Color := TColor($00C8C8E8);
C.TextOut(R.Left + INNER_X + ACCENT_W + 8, R.Top + 25, Detail);
end;
end.
+17 -1
View File
@@ -18,7 +18,8 @@ interface
uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
IntfGraphics, FPImage, LCLIntf, LCLType, GraphType, AppTheme;
IntfGraphics, FPImage, LCLIntf, LCLType, GraphType, AppTheme,
AlertOverlay;
const
SV_CLR_BG = TColor($00101010);
@@ -98,6 +99,9 @@ type
// красным сверху). Без DUP при TX оба флага True. Без TX оба False.
FTXOverlay: Boolean;
// ── ADC overload overlay ─────────────────────────────────────────────────
FADCOverloadVisible: Boolean;
// ── Marker ────────────────────────────────────────────────────────────────
FMarkerActive: Boolean;
FMarkerX: Integer;
@@ -139,6 +143,7 @@ type
// Используется для прозрачной заливки полосы фильтра разными цветами
// (RX-зелёный / TX-красный) поверх градиента сетки.
procedure BlendBand(X1, X2, H: Integer; R, G, B, Alpha: Byte);
procedure DrawADCOverloadOverlay(C: TCanvas; W, H: Integer);
// Считает X1/X2 для полосы фильтра вокруг указанной частоты VFO, c учётом
// текущего режима (LSB/USB/DSB и пр.) и FFilterBW.
procedure CalcFilterBandX(VfoFreq: Double; W: Integer;
@@ -181,6 +186,9 @@ type
property TXVfoIndex: Integer read FTXVfoIndex write FTXVfoIndex;
property TXOverlay: Boolean read FTXOverlay write FTXOverlay;
// Test overlay for ADC overload; later this will be driven from HP Status.
property ADCOverloadVisible: Boolean read FADCOverloadVisible write FADCOverloadVisible;
// ── Маркер ────────────────────────────────────────────────────────────────
property MarkerActive: Boolean read FMarkerActive write FMarkerActive;
property MarkerX: Integer read FMarkerX write FMarkerX;
@@ -433,6 +441,7 @@ begin
FTXSpanHz := 192000.0;
FTXVfoIndex := 0;
FTXOverlay := False;
FADCOverloadVisible := True; // test indicator; later driven by HP Status.
FSpectrumBufCount := 1024;
FWaterfallBufCount := 1024;
FWfFrameInterval := 2;
@@ -540,6 +549,12 @@ begin
end;
end;
procedure TSpectrumView.DrawADCOverloadOverlay(C: TCanvas; W, H: Integer);
begin
if not FADCOverloadVisible then Exit;
DrawAlertOverlay(FSpectrumBitmap, C, W, H, 'ADC OVERLOAD', 'Input clipping detected');
end;
procedure TSpectrumView.CalcFilterBandX(VfoFreq: Double; W: Integer;
out X1, X2, VfoX: Integer);
// Возвращает X-координаты левого/правого края полосы фильтра вокруг VfoFreq
@@ -962,6 +977,7 @@ begin
end;
if FMarkerActive then DrawMarkerLine(C, W, H);
DrawADCOverloadOverlay(C, W, H);
end;
// ────────────────────────────────────────────────────────────────────────────