Add audio buffer setting and optimize overlays

This commit is contained in:
2026-05-22 18:07:05 +03:00
parent 26aa55ddde
commit c5f225332b
6 changed files with 327 additions and 38 deletions
+15 -3
View File
@@ -10,7 +10,7 @@ unit AudioOutput;
- Callback читает по одному сэмплу, обновляет outpt внутри цикла
- Low water mark: вставляет тишину + полбуфера silence
- High water mark: удаляет лишние сэмплы
- MY_AUDIO_BUFFER_SIZE = 128 frames (низкая латентность)
- output buffer size defaults to 128 frames (низкая латентность)
}
{$IFDEF FPC}
@@ -24,7 +24,7 @@ uses
Classes, SysUtils, Math, SyncObjs, DynLibs;
const
MY_AUDIO_BUFFER_SIZE = 128; // PA frames per callback — как piHPSDR
MY_AUDIO_BUFFER_SIZE = 128; // default PA frames per callback — как piHPSDR
MY_RING_BUFFER_SIZE = 9600; // как piHPSDR
MY_RING_LOW_WATER = 512; // как piHPSDR
MY_RING_HIGH_WATER = 9000; // как piHPSDR
@@ -95,6 +95,7 @@ type
FLibHandle: TLibHandle;
FStream: TPaStream;
FSampleRate: Integer;
FOutputBufferSize: Integer;
FOpen: Boolean;
FPAInited: Boolean; // Pa_Initialize прошла
FLastError: string;
@@ -120,6 +121,7 @@ type
function LoadLib: Boolean;
function GetLastError: string;
procedure SetOutputBufferSize(V: Integer);
public
constructor Create(SampleRate: Integer = 48000);
@@ -148,6 +150,7 @@ type
property LastError: string read GetLastError;
property DeviceIndex: Integer read FDeviceIndex write FDeviceIndex;
property SampleRate: Integer read FSampleRate write FSampleRate;
property OutputBufferSize: Integer read FOutputBufferSize write SetOutputBufferSize;
end;
// Глобальный callback (cdecl, не метод)
@@ -239,6 +242,7 @@ constructor TAudioOutput.Create(SampleRate: Integer);
begin
inherited Create;
FSampleRate := SampleRate;
FOutputBufferSize := MY_AUDIO_BUFFER_SIZE;
FDeviceIndex := -1; // -1 = default output device
FOpen := False;
FPAInited := False;
@@ -493,7 +497,7 @@ begin
nil, // no input
@OutParam,
FSampleRate,
MY_AUDIO_BUFFER_SIZE, // 128 frames как в оригинале
FOutputBufferSize,
PA_NO_FLAG,
@PaOutCallback,
Self
@@ -531,6 +535,14 @@ begin
Result := True;
end;
procedure TAudioOutput.SetOutputBufferSize(V: Integer);
begin
if V <= 128 then V := 128
else if V <= 256 then V := 256
else V := 512;
FOutputBufferSize := V;
end;
procedure TAudioOutput.Close;
begin
if not FOpen then Exit;
+80 -19
View File
@@ -660,6 +660,7 @@ type
procedure OnModeFilterSelect(Mode: Integer; FilterBW: Integer);
procedure OnVfoOverlayDSPChange(NRMode, NBMode: Integer; SNBOn, ANFOn: Boolean);
procedure OnVfoOverlayAGCChange(AGCMode: Integer);
procedure OnVfoOverlayInvalidate(Sender: TObject);
procedure PbSpectrumDblClick(Sender: TObject);
procedure TrkDriveChange(Sender: TObject);
procedure TrkVolumeChange(Sender: TObject);
@@ -702,6 +703,7 @@ type
procedure ApplySpecViewGridFromState;
procedure ApplyAudioDevice(DevIndex: Integer; const DevName: string);
procedure ApplyAudioInputDevice(DevIndex: Integer; const DevName: string);
procedure ApplyAudioBufferSize(BufferSize: Integer);
// TX settings: применить FTXSettings к WDSP и переслать DUC Specific
// (mic-биты Boost/Bias/LineIn/PTT попадают в byte 50 DUCSpecific).
procedure ApplyTXSettingsToDSP;
@@ -1321,6 +1323,7 @@ begin
FVfoOverlay.OnSelect := OnModeFilterSelect;
FVfoOverlay.OnDSPChange := OnVfoOverlayDSPChange;
FVfoOverlay.OnAGCChange := OnVfoOverlayAGCChange;
FVfoOverlay.OnInvalidate := OnVfoOverlayInvalidate;
FVfoOverlay.Visible := False;
FPanelHidden := False;
FShowSpectrum := True;
@@ -1331,6 +1334,7 @@ begin
FSplitterDrag := False;
FSpecView := TSpectrumView.Create;
FSpecView.VfoOverlay := FVfoOverlay;
FSpecView.VfoA := FVfoA;
FSpecView.VfoB := FVfoB;
FSpecView.ActiveVfo := FActiveVfo;
@@ -1387,6 +1391,7 @@ begin
// Audio output/input — создаём объекты сейчас, открываем после показа формы
// (Pa_Initialize на Linux пишет в stderr до перехвата сигналов FPC)
FAudioOut := TAudioOutput.Create(48000);
FAudioOut.OutputBufferSize := FSettings.LoadAudioBufferSize;
FAudioIn := TAudioInput.Create(48000);
FMeterTimer := TTimer.Create(Self);
@@ -4417,22 +4422,17 @@ begin
FNetwork.SendFullHP;
end;
// Перерисовываем спектр всегда (маркер и полоса двигаются)
// Если идёт drag — не вызываем Draw напрямую, таймер подхватит
// Не рисуем синхронно из wheel/drag path: частые события мыши иначе
// забивают UI-поток и мешают аудио. Таймер подхватит ближайший кадр.
SyncSpecViewFreq;
if FSpecDrag then
FSpectrumDirty := True
else
begin
FSpecView.DrawSpectrum;
FSpectrumDirty := True;
PbSpectrum.Invalidate;
if Scrolled then
begin
FSpecView.DrawWaterfall;
FWaterfallDirty := True;
PbWaterfall.Invalidate;
end;
end;
end;
// ---------------------------------------------------------------------------
// CTUN toggle
@@ -4648,6 +4648,8 @@ end;
procedure TMainForm.PbSpectrumMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Assigned(FVfoOverlay) and
FVfoOverlay.HandleMouseDown(Button, X, Y) then Exit;
if Assigned(FSampleRateOverlay) and
FSampleRateOverlay.HandleMouseDown(Button, X, Y) then Exit;
@@ -4694,9 +4696,15 @@ begin
if Assigned(FSampleRateOverlay) then
begin
FSampleRateOverlay.HandleMouseMove(X, Y);
if (FSampleRateOverlay.HotIdx >= 0) and (not FSpecDrag) then
end;
if Assigned(FVfoOverlay) then
FVfoOverlay.HandleMouseMove(X, Y);
if not FSpecDrag then
begin
if (Assigned(FVfoOverlay) and (FVfoOverlay.HotIdx >= 0)) or
(Assigned(FSampleRateOverlay) and (FSampleRateOverlay.HotIdx >= 0)) then
PbSpectrum.Cursor := crHandPoint
else if not FSpecDrag then
else
PbSpectrum.Cursor := crDefault;
end;
@@ -4726,6 +4734,8 @@ procedure TMainForm.PbSpectrumMouseLeave(Sender: TObject);
begin
if Assigned(FSampleRateOverlay) then
FSampleRateOverlay.HandleMouseLeave;
if Assigned(FVfoOverlay) then
FVfoOverlay.HandleMouseLeave;
if not FSpecDrag then PbSpectrum.Cursor := crDefault;
end;
@@ -5304,18 +5314,17 @@ begin
if FPanelHidden then
begin
PanelLeft.Width := 0;
FVfoOverlay.Parent := PanelRight;
FVfoOverlay.Width := 260;
FVfoOverlay.Height := 136; // OVL_H_NORM — расширяется сам при открытии AGC-пикера
FVfoOverlay.SetState(FMode, FFilterBW, FVfoA, FLastSMeter);
FVfoOverlay.SetDSPState(BtnNR.Tag, BtnNB.Tag, BtnSNB.Tag <> 0, BtnANF.Tag <> 0, FAGCMode);
FVfoOverlay.Visible := True;
FVfoOverlay.BringToFront;
PositionVfoOverlay;
end
else
begin
PanelLeft.Width := 232;
FVfoOverlay.HandleMouseLeave;
FVfoOverlay.Visible := False;
end;
if Assigned(FSampleRateOverlay) then
@@ -5326,20 +5335,40 @@ end;
procedure TMainForm.PositionVfoOverlay;
var
VfoX, OW, SpTop: Integer;
VfoX, FilterEndX, OW, NewLeft, NewTop: Integer;
HiHz: Double;
begin
if not Assigned(FVfoOverlay) or not FVfoOverlay.Visible then Exit;
OW := FVfoOverlay.Width;
SpTop := PbSpectrum.Top; // смещение PbSpectrum внутри PanelRight
if PbSpectrum.Width > 0 then
if (PbSpectrum.Width > 0) and (FSpanHz > 0) then
begin
VfoX := Round((FVfoA - FCenterFreq + FSpanHz / 2) / FSpanHz * PbSpectrum.Width)
end
else
VfoX := PbSpectrum.Width div 2;
// Всегда справа от VFO-линии
FVfoOverlay.Left := Min(PanelRight.Width - OW - 4, VfoX + 6);
FVfoOverlay.Top := SpTop + 6;
case FMode of
MODE_LSB: HiHz := -100;
MODE_USB: HiHz := FFilterBW;
else
HiHz := FFilterBW / 2;
end;
if (PbSpectrum.Width > 0) and (FSpanHz > 0) then
FilterEndX := VfoX + Round(HiHz / FSpanHz * PbSpectrum.Width)
else
FilterEndX := VfoX;
FilterEndX := Max(0, Min(PbSpectrum.Width - 1, FilterEndX));
// Всегда справа от правого края полосы фильтра.
NewLeft := Max(4, Min(PbSpectrum.Width - OW - 4, FilterEndX + 6));
NewTop := 16;
if (FVfoOverlay.Left <> NewLeft) or (FVfoOverlay.Top <> NewTop) then
begin
FVfoOverlay.Left := NewLeft;
FVfoOverlay.Top := NewTop;
OnVfoOverlayInvalidate(FVfoOverlay);
end;
end;
procedure TMainForm.PbSpectrumDblClick(Sender: TObject);
@@ -5400,6 +5429,13 @@ begin
FBandCache[FCurrentBand].AGCMode := FAGCMode;
end;
procedure TMainForm.OnVfoOverlayInvalidate(Sender: TObject);
begin
FSpectrumDirty := True;
if Assigned(FSpecView) then FSpecView.SpectrumDirty := True;
if Assigned(PbSpectrum) then PbSpectrum.Invalidate;
end;
procedure TMainForm.OnSampleRateSelect(SampleRate: Integer);
var
NewRate: Integer;
@@ -6731,6 +6767,29 @@ begin
end;
end;
procedure TMainForm.ApplyAudioBufferSize(BufferSize: Integer);
var
WasOpen: Boolean;
begin
if BufferSize <= 128 then BufferSize := 128
else if BufferSize <= 256 then BufferSize := 256
else BufferSize := 512;
if FAudioOut.OutputBufferSize = BufferSize then Exit;
WasOpen := FAudioOut.IsOpen;
if WasOpen then FAudioOut.Close;
FAudioOut.OutputBufferSize := BufferSize;
if WasOpen then
begin
try
FAudioOut.Open;
except
end;
end;
FSettings.SaveAudioBufferSize(BufferSize);
FSettings.Save;
end;
procedure TMainForm.ApplyVisibility(ShowSpectrum, ShowWaterfall: Boolean);
begin
FShowSpectrum := ShowSpectrum;
@@ -6781,6 +6840,7 @@ begin
SF.OnGridChange := ApplyGridParams;
SF.OnAudioDevChange := ApplyAudioDevice;
SF.OnAudioInDevChange := ApplyAudioInputDevice;
SF.OnAudioBufferChange := ApplyAudioBufferSize;
SF.OnVisibilityChange := ApplyVisibility;
SF.OnFPSChange := ApplyFPS;
SF.OnPAChange := OnPASettingsChange;
@@ -6821,6 +6881,7 @@ begin
SF.LoadFPS(FDisplayFPS);
SF.LoadLightTheme(FLightTheme);
SF.LoadFreqMhzDigits(FFreqMhzDigits);
SF.LoadAudioBufferSize(FAudioOut.OutputBufferSize);
// Загружаем текущие значения
if FWDSPReady then
SF.LoadValues(
+23
View File
@@ -286,6 +286,8 @@ type
procedure LoadWindowBounds(out L, T, W, H: Integer);
procedure SaveStartupPreview(VfoA, VfoB: Double; SampleRate: Integer);
function LoadStartupPreview(out VfoA, VfoB: Double; out SampleRate: Integer): Boolean;
procedure SaveAudioBufferSize(BufferSize: Integer);
function LoadAudioBufferSize: Integer;
// CAT settings — не привязаны к MAC, хранятся в корне JSON (доступны до подключения)
procedure SaveCATSettings(const G: TGlobalSettings);
procedure LoadCATSettings(var G: TGlobalSettings);
@@ -798,6 +800,27 @@ begin
SampleRate := JI(O, 'sample_rate', 192000);
end;
procedure TSettingsManager.SaveAudioBufferSize(BufferSize: Integer);
var O: TJSONObject;
begin
if BufferSize <= 128 then BufferSize := 128
else if BufferSize <= 256 then BufferSize := 256
else BufferSize := 512;
O := EnsureObj(FRoot, 'audio');
JW(O, 'output_buffer_size', BufferSize);
end;
function TSettingsManager.LoadAudioBufferSize: Integer;
var O: TJSONObject;
begin
if FRoot.Find('audio') = nil then Exit(128);
O := EnsureObj(FRoot, 'audio');
Result := JI(O, 'output_buffer_size', 128);
if Result <= 128 then Result := 128
else if Result <= 256 then Result := 256
else Result := 512;
end;
procedure TSettingsManager.SaveCATSettings(const G: TGlobalSettings);
var O: TJSONObject; i: Integer;
begin
+48 -1
View File
@@ -46,6 +46,7 @@ type
TOnGridParamChange = procedure(RefLevel, Range, GridStep: Double) of object;
TOnAudioDevChange = procedure(DevIndex: Integer; const DevName: string) of object;
TOnAudioInDevChange = procedure(DevIndex: Integer; const DevName: string) of object;
TOnAudioBufferChange = procedure(BufferSize: Integer) of object;
TOnVisibilityChange = procedure(ShowSpectrum, ShowWaterfall: Boolean) of object;
TOnFPSChange = procedure(FPS: Integer) of object;
TOnThemeChange = procedure(LightTheme: Boolean) of object;
@@ -94,6 +95,7 @@ type
FCmbTXDev: TComboBox;
FTXDevIndices: array[0..63] of Integer;
FTXDevCount: Integer;
FCmbAudioBuffer: TComboBox;
// ---- RX1 sub-tab controls ----
FCmbFFTSize: TComboBox;
@@ -263,6 +265,7 @@ type
FOnGridChange: TOnGridParamChange;
FOnAudioDevChange: TOnAudioDevChange;
FOnAudioInDevChange: TOnAudioInDevChange;
FOnAudioBufferChange: TOnAudioBufferChange;
FOnVisibilityChange: TOnVisibilityChange;
FOnFPSChange: TOnFPSChange;
FOnThemeChange: TOnThemeChange;
@@ -325,6 +328,7 @@ type
procedure OnGridStepChange(Sender: TObject);
procedure OnRXDevChange(Sender: TObject);
procedure OnTXDevChange(Sender: TObject);
procedure OnAudioBufferCmbChange(Sender: TObject);
procedure OnVisibilityChkChange(Sender: TObject);
procedure OnFPSCmbChange(Sender: TObject);
procedure OnLightThemeChkChange(Sender: TObject);
@@ -364,6 +368,7 @@ type
const AudioInDevName: string);
procedure RefreshAudioDevices(AudioOut: TAudioOutput; AudioIn: TAudioInput);
procedure LoadAudioBufferSize(BufferSize: Integer);
procedure LoadVisibility(ShowSpectrum, ShowWaterfall: Boolean);
procedure LoadFPS(FPS: Integer);
procedure LoadLightTheme(ALight: Boolean);
@@ -393,6 +398,7 @@ type
property OnGridChange: TOnGridParamChange read FOnGridChange write FOnGridChange;
property OnAudioDevChange: TOnAudioDevChange read FOnAudioDevChange write FOnAudioDevChange;
property OnAudioInDevChange: TOnAudioInDevChange read FOnAudioInDevChange write FOnAudioInDevChange;
property OnAudioBufferChange: TOnAudioBufferChange read FOnAudioBufferChange write FOnAudioBufferChange;
property OnVisibilityChange: TOnVisibilityChange read FOnVisibilityChange write FOnVisibilityChange;
property OnFPSChange: TOnFPSChange read FOnFPSChange write FOnFPSChange;
property OnThemeChange: TOnThemeChange read FOnThemeChange write FOnThemeChange;
@@ -737,7 +743,7 @@ begin
Font.Color := CLR_TEXTDIM;
end;
Grp := MakeGroupPanel(FPageAudio, 'Audio Devices', MARGIN, 86, 650, 142);
Grp := MakeGroupPanel(FPageAudio, 'Audio Devices', MARGIN, 86, 650, 184);
MakeLbl(Grp, 'TX input device', PAD, R1 + 5, LW);
FCmbTXDev := MakeCombo(Grp, CX, R1, CMB_W, OnTXDevChange);
@@ -746,6 +752,13 @@ begin
MakeLbl(Grp, 'RX output device', PAD, R1 + STEP + 5, LW);
FCmbRXDev := MakeCombo(Grp, CX, R1 + STEP, CMB_W, OnRXDevChange);
FCmbRXDev.Items.Add('Default');
MakeLbl(Grp, 'Output buffer', PAD, R1 + STEP * 2 + 5, LW);
FCmbAudioBuffer := MakeCombo(Grp, CX, R1 + STEP * 2, 160, OnAudioBufferCmbChange);
FCmbAudioBuffer.Items.Add('128 frames');
FCmbAudioBuffer.Items.Add('256 frames');
FCmbAudioBuffer.Items.Add('512 frames');
FCmbAudioBuffer.ItemIndex := 0;
end;
// ---------------------------------------------------------------------------
@@ -1972,6 +1985,25 @@ begin
end;
end;
// ---------------------------------------------------------------------------
// LoadAudioBufferSize
// ---------------------------------------------------------------------------
procedure TSettingsForm.LoadAudioBufferSize(BufferSize: Integer);
begin
FLoading := True;
try
case BufferSize of
256: FCmbAudioBuffer.ItemIndex := 1;
512: FCmbAudioBuffer.ItemIndex := 2;
else
FCmbAudioBuffer.ItemIndex := 0;
end;
finally
FLoading := False;
end;
end;
// ---------------------------------------------------------------------------
// RefreshAudioDevices
// ---------------------------------------------------------------------------
@@ -2243,6 +2275,21 @@ begin
end;
end;
procedure TSettingsForm.OnAudioBufferCmbChange(Sender: TObject);
var
BufferSize: Integer;
begin
if FLoading then Exit;
if not Assigned(FOnAudioBufferChange) then Exit;
case FCmbAudioBuffer.ItemIndex of
1: BufferSize := 256;
2: BufferSize := 512;
else
BufferSize := 128;
end;
FOnAudioBufferChange(BufferSize);
end;
procedure TSettingsForm.LoadVisibility(ShowSpectrum, ShowWaterfall: Boolean);
begin
FLoading := True;
+5 -1
View File
@@ -20,7 +20,7 @@ interface
uses
Classes, SysUtils, Graphics, ExtCtrls, Controls, Math,
IntfGraphics, FPImage, LCLIntf, LCLType, GraphType, AppTheme,
AlertOverlay, SampleRateOverlay,
AlertOverlay, SampleRateOverlay, VfoOverlay,
WaterfallView, SMeterView, RulerView;
const
@@ -70,6 +70,7 @@ type
// ── ADC overload overlay ─────────────────────────────────────────────────
FADCOverloadVisible: Boolean;
FSampleRateOverlay: TSampleRateOverlay;
FVfoOverlay: TVfoOverlay;
// ── Marker ────────────────────────────────────────────────────────────────
FMarkerActive: Boolean;
FMarkerX: Integer;
@@ -199,6 +200,7 @@ type
property PbRuler: TPaintBox write SetPbRuler;
property PbSMeterRight: TPaintBox write SetPbSMeterRight;
property SampleRateOverlay: TSampleRateOverlay read FSampleRateOverlay write FSampleRateOverlay;
property VfoOverlay: TVfoOverlay read FVfoOverlay write FVfoOverlay;
// ── Данные от DSP ─────────────────────────────────────────────────────────
procedure SetSpectrumData(const Pixels: array of Single; Count: Integer);
@@ -918,6 +920,8 @@ begin
DrawADCOverloadOverlay(C, W, H);
if Assigned(FSampleRateOverlay) then
FSampleRateOverlay.DrawOverlay(FSpectrumBitmap, C, W, H);
if Assigned(FVfoOverlay) then
FVfoOverlay.DrawOverlay(FSpectrumBitmap, W, H);
end;
// ────────────────────────────────────────────────────────────────────────────
+153 -11
View File
@@ -21,6 +21,7 @@ type
FOnSelect: TModeFilterEvent;
FOnDSPChange: TDSPChangeEvent;
FOnAGCChange: TAGCChangeEvent;
FOnInvalidate: TNotifyEvent;
FModeFilter: array[0..7] of Integer;
FNRMode: Integer; // 0=off, 1..4=NR/NR2/NR3/NR4
@@ -34,6 +35,8 @@ type
FHitActions: array[0..24] of Integer;
FHitCount: Integer;
FHotIdx: Integer;
FCacheBitmap: TBitmap;
FCacheDirty: Boolean;
procedure DrawSelf(C: TCanvas; W, H: Integer);
procedure DrawSMeterBar(C: TCanvas; X, Y, BW, BH: Integer);
@@ -47,6 +50,7 @@ type
function GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
function GetFilterLblForMode(ModeIdx, FilterIdx: Integer): string;
function GetFilterCountForMode(ModeIdx: Integer): Integer;
procedure RequestInvalidate;
protected
procedure Paint; override;
@@ -57,19 +61,28 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawOverlay(Target: TBitmap; W, H: Integer);
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
function HandleMouseMove(X, Y: Integer): Boolean;
function HandleMouseLeave: Boolean;
procedure SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
procedure SetDSPState(ANRMode, ANBMode: Integer; ASNBOn, AANFOn: Boolean;
AAGCMode: Integer);
procedure UpdateSMeter(DB: Double);
procedure UpdateVfo(AVfoHz: Double);
property HotIdx: Integer read FHotIdx;
property OnSelect: TModeFilterEvent read FOnSelect write FOnSelect;
property OnDSPChange: TDSPChangeEvent read FOnDSPChange write FOnDSPChange;
property OnAGCChange: TAGCChangeEvent read FOnAGCChange write FOnAGCChange;
property OnInvalidate: TNotifyEvent read FOnInvalidate write FOnInvalidate;
end;
implementation
const
KEY_COLOR = TColor($00FF00FF);
HIT_NR = -9;
HIT_NB = -10;
HIT_SNB = -11;
@@ -126,6 +139,53 @@ const
// S-шкала: S1..S9
DB_S: array[1..9] of Double = (-121,-115,-109,-103,-97,-91,-85,-79,-73);
procedure BlendBitmapKey(Target, Source: TBitmap; DstX, DstY: Integer; Alpha: Byte);
var
Y, X, SX0, SY0, SX1, SY1, TY, InvA: Integer;
SrcRow, DstRow: PByte;
begin
if (Target = nil) or (Source = nil) or (Alpha = 0) then Exit;
SX0 := 0;
SY0 := 0;
SX1 := Source.Width;
SY1 := Source.Height;
if DstX < 0 then begin SX0 := -DstX; DstX := 0; end;
if DstY < 0 then begin SY0 := -DstY; DstY := 0; end;
if DstX + (SX1 - SX0) > Target.Width then SX1 := SX0 + Target.Width - DstX;
if DstY + (SY1 - SY0) > Target.Height then SY1 := SY0 + Target.Height - DstY;
if (SX1 <= SX0) or (SY1 <= SY0) then Exit;
InvA := 255 - Alpha;
Target.BeginUpdate(False);
Source.BeginUpdate(False);
try
for Y := SY0 to SY1 - 1 do
begin
TY := DstY + (Y - SY0);
SrcRow := PByte(Source.ScanLine[Y]);
DstRow := PByte(Target.ScanLine[TY]);
if (SrcRow = nil) or (DstRow = nil) then Continue;
Inc(SrcRow, SX0 * 4);
Inc(DstRow, DstX * 4);
for X := SX0 to SX1 - 1 do
begin
// KEY_COLOR is clFuchsia in pf32bit B,G,R order.
if not ((SrcRow[0] = $FF) and (SrcRow[1] = $00) and (SrcRow[2] = $FF)) then
begin
DstRow[0] := Byte((Alpha * SrcRow[0] + InvA * DstRow[0]) div 255);
DstRow[1] := Byte((Alpha * SrcRow[1] + InvA * DstRow[1]) div 255);
DstRow[2] := Byte((Alpha * SrcRow[2] + InvA * DstRow[2]) div 255);
end;
Inc(SrcRow, 4);
Inc(DstRow, 4);
end;
end;
finally
Source.EndUpdate(False);
Target.EndUpdate(False);
end;
end;
function TVfoOverlay.GetFilterBWForMode(ModeIdx, FilterIdx: Integer): Integer;
begin
case ModeIdx of
@@ -206,11 +266,20 @@ begin
FANFOn := False;
FAGCMode := 0;
FAGCPickerOpen := False;
FCacheBitmap := TBitmap.Create;
FCacheBitmap.PixelFormat := pf32bit;
FCacheDirty := True;
Width := 260;
Height := OVL_H_NORM;
Cursor := crHandPoint;
end;
destructor TVfoOverlay.Destroy;
begin
FCacheBitmap.Free;
inherited Destroy;
end;
procedure TVfoOverlay.RegisterHit(HR: TRect; HV: Integer);
begin
if FHitCount > High(FHitRects) then Exit;
@@ -219,6 +288,13 @@ begin
Inc(FHitCount);
end;
procedure TVfoOverlay.RequestInvalidate;
begin
FCacheDirty := True;
inherited Invalidate;
if Assigned(FOnInvalidate) then FOnInvalidate(Self);
end;
function TVfoOverlay.FormatFreq(Hz: Double): string;
var
iM, iK, iH: Integer;
@@ -534,6 +610,72 @@ begin
DrawSelf(Canvas, Width, Height);
end;
procedure TVfoOverlay.DrawOverlay(Target: TBitmap; W, H: Integer);
begin
if (not Visible) or (Target = nil) or (Width <= 0) or (Height <= 0) then Exit;
if (Left >= W) or (Top >= H) then Exit;
if (FCacheBitmap.Width <> Width) or (FCacheBitmap.Height <> Height) then
begin
FCacheBitmap.SetSize(Width, Height);
FCacheDirty := True;
end;
if FCacheDirty then
begin
FCacheBitmap.Canvas.Brush.Color := KEY_COLOR;
FCacheBitmap.Canvas.Brush.Style := bsSolid;
FCacheBitmap.Canvas.Pen.Style := psClear;
FCacheBitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
DrawSelf(FCacheBitmap.Canvas, Width, Height);
FCacheDirty := False;
end;
BlendBitmapKey(Target, FCacheBitmap, Left, Top, 218);
end;
function TVfoOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
begin
Result := False;
if not Visible then Exit;
if (X < Left) or (Y < Top) or (X >= Left + Width) or (Y >= Top + Height) then Exit;
MouseDown(Button, [], X - Left, Y - Top);
Result := True;
end;
function TVfoOverlay.HandleMouseMove(X, Y: Integer): Boolean;
var
I, OldHot, LX, LY: Integer;
begin
Result := False;
if not Visible then Exit;
LX := X - Left;
LY := Y - Top;
OldHot := FHotIdx;
FHotIdx := -1;
if (LX >= 0) and (LY >= 0) and (LX < Width) and (LY < Height) then
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(LX, LY)) then
begin
FHotIdx := I;
Break;
end;
if FHotIdx <> OldHot then
begin
RequestInvalidate;
Result := True;
end;
end;
function TVfoOverlay.HandleMouseLeave: Boolean;
begin
Result := False;
if FHotIdx >= 0 then
begin
FHotIdx := -1;
RequestInvalidate;
Result := True;
end;
end;
procedure TVfoOverlay.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
@@ -556,7 +698,7 @@ begin
FModeFilter[FMode] := FFilterBW;
FMode := NewMode;
FFilterBW := FModeFilter[FMode];
Invalidate;
RequestInvalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
end
@@ -568,7 +710,7 @@ begin
FAGCPickerOpen := not FAGCPickerOpen;
if FAGCPickerOpen then Height := OVL_H_AGC
else Height := OVL_H_NORM;
Invalidate;
RequestInvalidate;
end
else
begin
@@ -578,7 +720,7 @@ begin
HIT_SNB: FSNBOn := not FSNBOn;
HIT_ANF: FANFOn := not FANFOn;
end;
Invalidate;
RequestInvalidate;
if Assigned(FOnDSPChange) then
FOnDSPChange(FNRMode, FNBMode, FSNBOn, FANFOn);
end;
@@ -590,7 +732,7 @@ begin
FAGCMode := HV - HIT_AGC_PICK_BASE;
FAGCPickerOpen := False;
Height := OVL_H_NORM;
Invalidate;
RequestInvalidate;
if Assigned(FOnAGCChange) then FOnAGCChange(FAGCMode);
end
else if HV > 0 then
@@ -600,7 +742,7 @@ begin
begin
FFilterBW := NewBW;
FModeFilter[FMode] := FFilterBW;
Invalidate;
RequestInvalidate;
if Assigned(FOnSelect) then FOnSelect(FMode, FFilterBW);
end;
end;
@@ -617,13 +759,13 @@ begin
for I := 0 to FHitCount - 1 do
if PtInRect(FHitRects[I], Point(X, Y)) then
begin FHotIdx := I; Break; end;
if FHotIdx <> OldHot then Invalidate;
if FHotIdx <> OldHot then RequestInvalidate;
end;
procedure TVfoOverlay.MouseLeave;
begin
inherited;
if FHotIdx >= 0 then begin FHotIdx := -1; Invalidate; end;
if FHotIdx >= 0 then begin FHotIdx := -1; RequestInvalidate; end;
end;
procedure TVfoOverlay.SetState(AMode, ABW: Integer; AVfoHz, ASMeterDB: Double);
@@ -634,7 +776,7 @@ begin
FModeFilter[FMode] := ABW;
FVfoHz := AVfoHz;
FSMeterDB := ASMeterDB;
Invalidate;
RequestInvalidate;
end;
procedure TVfoOverlay.SetDSPState(ANRMode, ANBMode: Integer; ASNBOn, AANFOn: Boolean;
@@ -645,7 +787,7 @@ begin
FSNBOn := ASNBOn;
FANFOn := AANFOn;
FAGCMode := AAGCMode;
Invalidate;
RequestInvalidate;
end;
procedure TVfoOverlay.UpdateSMeter(DB: Double);
@@ -654,7 +796,7 @@ begin
if Abs(DB - FSMeterDB) > 0.4 then
begin
FSMeterDB := DB;
Invalidate;
RequestInvalidate;
end;
end;
@@ -663,7 +805,7 @@ begin
if FVfoHz <> AVfoHz then
begin
FVfoHz := AVfoHz;
Invalidate;
RequestInvalidate;
end;
end;