ui: плашка ADC OVERLOAD — общий образ CPU/GL без пер-кадрового жора

AlertOverlay переписан в общий builder: BuildAlertImage строит RGBA-образ
плашки (попиксельная альфа, Canvas один раз на своём битмапе). GL грузит
образ текстурой (кэш как был), CPU блендит кэш в raw-кадр — убраны
canvas-путь в кадре и полный проход восстановления альфы битмапа.
GL-плашка теперь 1:1 с CPU (было: упрощённый бокс по центру), позиция —
правый верхний угол в обоих рендерах. Удалена мёртвая подсветочная линия
(перекрывалась рамкой).

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>

AlertOverlay.pas

@@ -1,7 +1,15 @@
 unit AlertOverlay;
 
 {
-  Reusable overlays for spectrum-like bitmap surfaces.
+  Общая плашка-алерт для CPU- и GL-рендеров спектра.
+
+  Единственный источник внешнего вида: BuildAlertImage строит готовый
+  RGBA-образ (straight alpha, попиксельная) ОДИН раз — Canvas используется
+  только здесь, на собственном маленьком битмапе. Дальше каждый рендер
+  использует образ по-своему без пер-кадрового жора CPU:
+    - GL: загружает как текстуру (один раз) и рисует квадом;
+    - CPU: блендит кэшированный образ в raw-кадр (BlendAlertImage,
+      ~10 тыс. пикселей — без Canvas и синков режима доступа Qt6).
 }
 
 {$IFDEF FPC}
@@ -11,105 +19,174 @@ unit AlertOverlay;
 interface
 
 uses
-  Graphics, Types, Math;
+  Classes, Graphics, Types, Math;
 
-procedure DrawAlertOverlay(Target: TBitmap; C: TCanvas; W, H: Integer;
+const
-  const Title, Detail: string);
+  ALERT_PAD = 12;   // отступ плашки от правого/верхнего края спектра
+
+type
+  TAlertImage = record
+    W, H: Integer;
+    RGBA: array of Byte;   // W*H*4, порядок R,G,B,A; straight alpha
+  end;
+
+// Построить образ плашки (полупрозрачный красный фон, рамка, акцент-полоса,
+// заголовок + деталь). Вызывать один раз и кэшировать результат.
+procedure BuildAlertImage(const Title, Detail: string; out Img: TAlertImage);
+
+// Смешать образ в raw-битмап кадра (32bpp, BGRA / ARGB на Darwin) по
+// straight-alpha. (X,Y) — левый верхний угол плашки; клиппинг внутри.
+procedure BlendAlertImage(const Img: TAlertImage; Base: PByte;
+  BPL, RawW, RawH, X, Y: Integer);
 
 implementation
 
-procedure BlendRect(Target: TBitmap; const Rct: TRect; R, G, B, Alpha: Byte);
+procedure BuildAlertImage(const Title, Detail: string; out Img: TAlertImage);
+const
+  INNER_X = 12; ACCENT_W = 4; BOX_H = 42;
 var
-  Y, X, InvA: Integer;
+  B: TBitmap;
-  Row: PByte;
+  TitleW, DetailW, BoxW: Integer;
-  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;
+  procedure FillBuf(X1, Y1, X2, Y2: Integer; R, G, Bl, A: Byte); // [X1..X2)
-  Target.BeginUpdate(False);
+  var X, Y, I: Integer;
-  try
+  begin
-    for Y := RR.Top to RR.Bottom - 1 do
+    for Y := Max(0, Y1) to Min(BOX_H, Y2) - 1 do
     begin
-      Row := PByte(Target.ScanLine[Y]);
+      I := (Y * BoxW + Max(0, X1)) * 4;
-      if Row = nil then Continue;
+      for X := Max(0, X1) to Min(BoxW, X2) - 1 do
-      Inc(Row, RR.Left * 4);
-      for X := RR.Left to RR.Right - 1 do
       begin
-{$IFDEF DARWIN}
+        Img.RGBA[I] := R; Img.RGBA[I+1] := G;
-        Row[1] := Byte((Alpha * R + InvA * Row[1]) div 255);
+        Img.RGBA[I+2] := Bl; Img.RGBA[I+3] := A;
-        Row[2] := Byte((Alpha * G + InvA * Row[2]) div 255);
+        Inc(I, 4);
-        Row[3] := Byte((Alpha * B + InvA * Row[3]) div 255);
-{$ELSE}
-        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);
-{$ENDIF}
-        Inc(Row, 4);
       end;
     end;
+  end;
+
+  procedure BlendText(TxtB: TBitmap);
+  // Композит текстового слоя (белым на чёрном) в образ: покрытие = max(R,G,B),
+  // цвет по строке (заголовок/деталь), сложение по straight-alpha.
+  var
+    X, Y, I, MaxC: Integer;
+    Src: PByte;
+    CR, CG, CB: Byte;
+    AT, AB, AO: Double;
+  begin
+    TxtB.BeginUpdate(False);
+    try
+      for Y := 0 to BOX_H - 1 do
+      begin
+        Src := PByte(TxtB.ScanLine[Y]);
+        I := Y * BoxW * 4;
+        for X := 0 to BoxW - 1 do
+        begin
+{$IFDEF DARWIN}
+          MaxC := Max(Src[1], Max(Src[2], Src[3]));
+{$ELSE}
+          MaxC := Max(Src[0], Max(Src[1], Src[2]));
+{$ENDIF}
+          if MaxC > 0 then
+          begin
+            if Y < 24 then begin CR := $FF; CG := $88; CB := $88; end  // $008888FF
+            else           begin CR := $E8; CG := $C8; CB := $C8; end; // $00C8C8E8
+            AT := MaxC / 255.0;
+            AB := Img.RGBA[I+3] / 255.0 * (1.0 - AT);
+            AO := AT + AB;
+            Img.RGBA[I]   := Round((CR * AT + Img.RGBA[I]   * AB) / AO);
+            Img.RGBA[I+1] := Round((CG * AT + Img.RGBA[I+1] * AB) / AO);
+            Img.RGBA[I+2] := Round((CB * AT + Img.RGBA[I+2] * AB) / AO);
+            Img.RGBA[I+3] := Round(AO * 255.0);
+          end;
+          Inc(Src, 4);
+          Inc(I, 4);
+        end;
+      end;
+    finally
+      TxtB.EndUpdate(False);
+    end;
+  end;
+
+begin
+  Img.W := 0; Img.H := 0; Img.RGBA := nil;
+  B := TBitmap.Create;
+  try
+    B.PixelFormat := pf32bit;
+    B.SetSize(8, 8);
+    B.Canvas.Font.Name := 'Courier New';
+    B.Canvas.Font.Style := [fsBold];
+    B.Canvas.Font.Size := 9;
+    TitleW := B.Canvas.TextWidth(Title);
+    B.Canvas.Font.Style := [];
+    B.Canvas.Font.Size := 7;
+    DetailW := B.Canvas.TextWidth(Detail);
+    BoxW := Max(TitleW, DetailW) + INNER_X * 2 + ACCENT_W + 8;
+
+    SetLength(Img.RGBA, BoxW * BOX_H * 4);
+    Img.W := BoxW;
+    Img.H := BOX_H;
+    FillBuf(0, 0, BoxW, BOX_H, $A8, $10, $16, 118);              // фон
+    FillBuf(0, 0, BoxW, 1, $C8, $38, $38, 255);                  // рамка
+    FillBuf(0, BOX_H - 1, BoxW, BOX_H, $C8, $38, $38, 255);
+    FillBuf(0, 0, 1, BOX_H, $C8, $38, $38, 255);
+    FillBuf(BoxW - 1, 0, BoxW, BOX_H, $C8, $38, $38, 255);
+    FillBuf(7, 7, 7 + ACCENT_W, BOX_H - 7, $F0, $28, $28, 255);  // акцент
+
+    B.SetSize(BoxW, BOX_H);
+    B.Canvas.Brush.Color := clBlack;
+    B.Canvas.Brush.Style := bsSolid;
+    B.Canvas.FillRect(Rect(0, 0, BoxW, BOX_H));
+    B.Canvas.Brush.Style := bsClear;
+    B.Canvas.Font.Name := 'Courier New';
+    B.Canvas.Font.Color := clWhite;
+    B.Canvas.Font.Style := [fsBold];
+    B.Canvas.Font.Size := 9;
+    B.Canvas.TextOut(INNER_X + ACCENT_W + 8, 7, Title);
+    B.Canvas.Font.Style := [];
+    B.Canvas.Font.Size := 7;
+    B.Canvas.TextOut(INNER_X + ACCENT_W + 8, 25, Detail);
+    BlendText(B);
   finally
-    Target.EndUpdate(False);
+    B.Free;
   end;
 end;
 
-procedure DrawAlertOverlay(Target: TBitmap; C: TCanvas; W, H: Integer;
+procedure BlendAlertImage(const Img: TAlertImage; Base: PByte;
-  const Title, Detail: string);
+  BPL, RawW, RawH, X, Y: Integer);
-const
-  PAD      = 12;
-  INNER_X  = 12;
-  ACCENT_W = 4;
 var
-  R, AccentR: TRect;
+  SX, SY, DX, DY, I, A, InvA: Integer;
-  TW, DW, BoxW, BoxH: Integer;
+  P: PByte;
 begin
-  if (Target = nil) or (C = nil) then Exit;
+  if (Img.W <= 0) or (Base = nil) then Exit;
-  if (W < 220) or (H < 60) then Exit;
+  for SY := 0 to Img.H - 1 do
-
+  begin
-  C.Font.Name := 'Courier New';
+    DY := Y + SY;
-  C.Font.Style := [fsBold];
+    if (DY < 0) or (DY >= RawH) then Continue;
-  C.Font.Size := 9;
+    I := SY * Img.W * 4;
-  TW := C.TextWidth(Title);
+    for SX := 0 to Img.W - 1 do
-  C.Font.Style := [];
+    begin
-  C.Font.Size := 7;
+      DX := X + SX;
-  DW := C.TextWidth(Detail);
+      A := Img.RGBA[I + 3];
-
+      if (DX >= 0) and (DX < RawW) and (A > 0) then
-  BoxW := Max(TW, DW) + INNER_X * 2 + ACCENT_W + 8;
+      begin
-  BoxH := 42;
+        InvA := 255 - A;
-  R := Rect(W - PAD - BoxW, PAD, W - PAD, PAD + BoxH);
+        P := Base + DY * BPL + DX * 4;
-
+{$IFDEF DARWIN}
-  BlendRect(Target, R, $A8, $10, $16, 118);
+        // ARGB: byte0=A, byte1=R, byte2=G, byte3=B
-  BlendRect(Target, Rect(R.Left, R.Top, R.Right, R.Top + 1), $FF, $68, $68, 80);
+        P[1] := Byte((Img.RGBA[I]   * A + P[1] * InvA) div 255);
-
+        P[2] := Byte((Img.RGBA[I+1] * A + P[2] * InvA) div 255);
-  C.Brush.Style := bsClear;
+        P[3] := Byte((Img.RGBA[I+2] * A + P[3] * InvA) div 255);
-  C.Pen.Style := psSolid;
+        P[0] := $FF;
-  C.Pen.Width := 1;
+{$ELSE}
-  C.Pen.Color := TColor($003838C8);
+        // BGRA: byte0=B, byte1=G, byte2=R
-  C.Rectangle(R);
+        P[0] := Byte((Img.RGBA[I+2] * A + P[0] * InvA) div 255);
-
+        P[1] := Byte((Img.RGBA[I+1] * A + P[1] * InvA) div 255);
-  AccentR := Rect(R.Left + 7, R.Top + 7, R.Left + 7 + ACCENT_W, R.Bottom - 7);
+        P[2] := Byte((Img.RGBA[I]   * A + P[2] * InvA) div 255);
-  C.Brush.Style := bsSolid;
+        P[3] := $FF;
-  C.Brush.Color := TColor($002828F0);
+{$ENDIF}
-  C.Pen.Style := psClear;
+      end;
-  C.FillRect(AccentR);
+      Inc(I, 4);
-
+    end;
-  C.Brush.Style := bsClear;
+  end;
-  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.

SpectrumView.pas

@@ -94,6 +94,7 @@ type
     FTXOverlay:     Boolean;
     // ── ADC overload overlay ─────────────────────────────────────────────────
     FADCOverloadVisible: Boolean;
+    FADCAlertImg: TAlertImage;   // кэш образа плашки (BuildAlertImage, 1 раз)
     FSampleRateOverlay: TSampleRateOverlay;
     FVfoOverlay: TVfoOverlay;
     FSliceOverlays: TFPList;   // доп. слайс-флаги (B+); не владеет (владелец MainForm)
@@ -173,7 +174,7 @@ type
     procedure BlendBand(X1, X2, H: Integer; R, G, B, Alpha: Byte);
     procedure FillBandRaw(X1, X2, H: Integer; Color: TColor);
     procedure CopyGridToSpectrum(W, H: Integer);
-    procedure DrawADCOverloadOverlay(C: TCanvas; W, H: Integer);
+    procedure DrawADCOverloadRaw(W, H: Integer);
     procedure CalcFilterBandX(VfoFreq: Double; W: Integer;
                               out X1, X2, VfoX: Integer);
     procedure CalcFilterBandXFor(VfoFreq: Double; Mode, BW, W: Integer;
@@ -1240,10 +1241,18 @@ begin
 {$ENDIF}
 end;
 
-procedure TSpectrumView.DrawADCOverloadOverlay(C: TCanvas; W, H: Integer);
+procedure TSpectrumView.DrawADCOverloadRaw(W, H: Integer);
+// Плашка ADC OVERLOAD: общий с GL-рендером образ (AlertOverlay.BuildAlertImage,
+// строится один раз и кэшируется), в кадре — только straight-alpha бленд
+// внутри RawBegin/RawEnd: без Canvas (дорогой raw↔canvas синк Qt6) и без
+// пофреймового восстановления альфы всего битмапа.
 begin
   if not FADCOverloadVisible then Exit;
-  DrawAlertOverlay(FSpectrumBitmap, C, W, H, 'ADC OVERLOAD', 'Input clipping detected');
+  if (W < 220) or (H < 60) or (FRawBase = nil) then Exit;
+  if FADCAlertImg.W = 0 then
+    BuildAlertImage('ADC OVERLOAD', 'Input clipping detected', FADCAlertImg);
+  BlendAlertImage(FADCAlertImg, FRawBase, FRawBPL, FRawW, FRawH,
+                  W - ALERT_PAD - FADCAlertImg.W, ALERT_PAD);
 end;
 
 procedure TSpectrumView.CalcFilterBandX(VfoFreq: Double; W: Integer;
@@ -1732,33 +1741,12 @@ begin
     for i := 0 to FSliceOverlays.Count - 1 do
       TVfoOverlay(FSliceOverlays[i]).DrawOverlay(FSpectrumBitmap, W, H);
 
+    DrawADCOverloadRaw(W, H);
+
   finally
     RawEnd;
   end;
 
-  // ADC overload — редкий canvas-путь (DrawAlertOverlay). Ломает альфу и
-  // режим доступа только в кадрах, где реально виден; после его canvas-
-  // операций восстанавливаем непрозрачность (пофреймовый OR-проход для
-  // обычных кадров удалён — Canvas на битмапе кадра больше не бывает).
-  if FADCOverloadVisible then
-  begin
-    DrawADCOverloadOverlay(C, W, H);
-{$IFNDEF DARWIN}
-    FSpectrumBitmap.BeginUpdate(False);
-    for i := 0 to H - 1 do
-    begin
-      RowLW := PLongWord(FSpectrumBitmap.ScanLine[i]);
-      if RowLW = nil then Continue;
-      for Yp := 0 to W - 1 do
-      begin
-        RowLW^ := RowLW^ or $FF000000;   // BGRA: альфа в байте 3
-        Inc(RowLW);
-      end;
-    end;
-    FSpectrumBitmap.EndUpdate(False);
-{$ENDIF}
-  end;
-
 end;
 
 // ────────────────────────────────────────────────────────────────────────────

SpectrumViewOpengl.pas

@@ -17,7 +17,7 @@ interface
 uses
   Classes, SysUtils, Graphics, Controls, Math, Types,
   OpenGLContextEx, GL,
-  AppTheme, SpectrumView, VfoOverlay, BandPlanOverlay,
+  AppTheme, AlertOverlay, SpectrumView, VfoOverlay, BandPlanOverlay,
   WaterfallView, WaterfallViewOpengl;
 
 type
@@ -887,37 +887,30 @@ begin
 end;
 
 procedure TSpectrumViewOpenGL.DrawADCOverlay(W, H: Integer);
+// Тот же образ, что CPU-путь (AlertOverlay.BuildAlertImage — единственный
+// источник внешнего вида): грузится текстурой ОДИН раз при появлении плашки
+// (кэш FADCOverlayTex), в кадре — только готовый DrawTexture.
 var
-  B: TBitmap;
+  Img: TAlertImage;
 begin
   if not FADCOverloadVisible then Exit;
+  if (W < 220) or (H < 60) then Exit;   // как CPU-путь
   if (not FLastADCVisible) or FADCOverlayTex.Dirty then
   begin
-    B := TBitmap.Create;
+    BuildAlertImage('ADC OVERLOAD', 'Input clipping detected', Img);
-    try
+    if FADCOverlayTex.Tex = 0 then glGenTextures(1, @FADCOverlayTex.Tex);
-      B.PixelFormat := pf32bit;
+    FADCOverlayTex.W := Img.W;
-      B.SetSize(210, 38);
+    FADCOverlayTex.H := Img.H;
-      B.Canvas.Brush.Color := TColor($00202020);
+    glBindTexture(GL_TEXTURE_2D, FADCOverlayTex.Tex);
-      B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
+    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-      B.Canvas.Pen.Color := TColor($000030C0);
+    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
-      B.Canvas.Brush.Style := bsClear;
+    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Img.W, Img.H, 0, GL_RGBA,
-      B.Canvas.Rectangle(0, 0, B.Width, B.Height);
+      GL_UNSIGNED_BYTE, @Img.RGBA[0]);
-      B.Canvas.Font.Name := 'Courier New';
+    glBindTexture(GL_TEXTURE_2D, 0);
-      B.Canvas.Font.Size := 10;
+    FADCOverlayTex.Dirty := False;
-      B.Canvas.Font.Style := [fsBold];
-      B.Canvas.Font.Color := TColor($000030C0);
-      B.Canvas.TextOut(12, 5, 'ADC OVERLOAD');
-      B.Canvas.Font.Size := 7;
-      B.Canvas.Font.Style := [];
-      B.Canvas.Font.Color := TColor($00D0D0D0);
-      B.Canvas.TextOut(12, 21, 'Input clipping detected');
-      UploadBitmap(FADCOverlayTex, B, False, 232);
-    finally
-      B.Free;
-    end;
   end;
   FLastADCVisible := True;
-  DrawTexture(FADCOverlayTex, (W - FADCOverlayTex.W) div 2, 8);
+  DrawTexture(FADCOverlayTex, W - FADCOverlayTex.W - ALERT_PAD, ALERT_PAD);
 end;
 
 procedure TSpectrumViewOpenGL.DrawCachedOverlays(W, H: Integer);