From c5f225332bbafdfeb1dbc938086ab3973fe2c0e2 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Fri, 22 May 2026 18:07:05 +0300 Subject: [PATCH] Add audio buffer setting and optimize overlays --- AudioOutput.pas | 18 +++++- MainForm.pas | 105 +++++++++++++++++++++++------- Settings.pas | 23 +++++++ SettingsForm.pas | 49 +++++++++++++- SpectrumView.pas | 6 +- VfoOverlay.pas | 164 +++++++++++++++++++++++++++++++++++++++++++---- 6 files changed, 327 insertions(+), 38 deletions(-) diff --git a/AudioOutput.pas b/AudioOutput.pas index 49b61e7..45db65c 100644 --- a/AudioOutput.pas +++ b/AudioOutput.pas @@ -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; diff --git a/MainForm.pas b/MainForm.pas index 9bb4a12..7ef67fe 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -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,20 +4422,15 @@ begin FNetwork.SendFullHP; end; - // Перерисовываем спектр всегда (маркер и полоса двигаются) - // Если идёт drag — не вызываем Draw напрямую, таймер подхватит + // Не рисуем синхронно из wheel/drag path: частые события мыши иначе + // забивают UI-поток и мешают аудио. Таймер подхватит ближайший кадр. SyncSpecViewFreq; - if FSpecDrag then - FSpectrumDirty := True - else + FSpectrumDirty := True; + PbSpectrum.Invalidate; + if Scrolled then begin - FSpecView.DrawSpectrum; - PbSpectrum.Invalidate; - if Scrolled then - begin - FSpecView.DrawWaterfall; - PbWaterfall.Invalidate; - end; + FWaterfallDirty := True; + PbWaterfall.Invalidate; end; end; @@ -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( diff --git a/Settings.pas b/Settings.pas index 914bcd4..f472832 100644 --- a/Settings.pas +++ b/Settings.pas @@ -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 diff --git a/SettingsForm.pas b/SettingsForm.pas index 27ee697..c583e35 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -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; diff --git a/SpectrumView.pas b/SpectrumView.pas index 0f3fda2..f359546 100644 --- a/SpectrumView.pas +++ b/SpectrumView.pas @@ -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; // ──────────────────────────────────────────────────────────────────────────── diff --git a/VfoOverlay.pas b/VfoOverlay.pas index 74f5e82..84c66de 100644 --- a/VfoOverlay.pas +++ b/VfoOverlay.pas @@ -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;