diff --git a/MainForm.pas b/MainForm.pas
index 3c9a062..ae19889 100644
--- a/MainForm.pas
+++ b/MainForm.pas
@@ -25,6 +25,7 @@ uses
Classes, SysUtils, StrUtils, FreqDisplay, DeviceForm, VfoOverlay, SampleRateOverlay,
FlatButton, FlatSlider, FlatDropDown, AppTheme, Forms, Controls, Graphics, Dialogs,
StdCtrls, ExtCtrls, Buttons, Menus, Math, Types,
+ OpenGLContext,
FlatProgressBar,
LCLIntf, LCLType, GraphType,
HPSDRProtocol, HPSDRNetwork,
@@ -32,7 +33,7 @@ uses
Settings,
WebServer,
CATEngine, CATSerial, CATTcp,
- SpectrumView,
+ SpectrumView, SpectrumViewOpengl,
StatusBar,
WinFirewall;
@@ -265,6 +266,7 @@ type
// ---- Spectrum / Waterfall view ----
FSpecView: TSpectrumView;
+ FUseOpenGLSpectrum: Boolean;
FSpectrumWidth: Integer; // актуальная ширина для FDSPEngine и resize-детектора
FSpectrumHeight: Integer;
FWaterfallHeight:Integer;
@@ -426,7 +428,7 @@ type
// ---- Right panel ----
PanelRight: TPanel;
- PbSpectrum: TPaintBox;
+ PbSpectrum: TControl;
PbRuler: TPaintBox; // полоса частотных меток между спектром и водопадом
PanelSplitter: TPanel; // перетаскиваемый разделитель спектр/водопад
PbWaterfall: TPaintBox;
@@ -766,6 +768,20 @@ uses SettingsForm;
{$R *.lfm}
+function HasOpenGLSpectrumSwitch: Boolean;
+var
+ I: Integer;
+ S: string;
+begin
+ Result := False;
+ for I := 1 to ParamCount do
+ begin
+ S := LowerCase(ParamStr(I));
+ if (S = '--opengl') or (S = '-opengl') or (S = '/opengl') then
+ Exit(True);
+ end;
+end;
+
function TMainForm.LeftPanelButtonWidth(PanelWidth, ColCount,
ColIndex: Integer): Integer;
var
@@ -1452,7 +1468,11 @@ begin
FSplitterRatio := 0.40;
FSplitterDrag := False;
- FSpecView := TSpectrumView.Create;
+ FUseOpenGLSpectrum := HasOpenGLSpectrumSwitch;
+ if FUseOpenGLSpectrum then
+ FSpecView := TSpectrumViewOpenGL.Create
+ else
+ FSpecView := TSpectrumView.Create;
FSpecView.VfoOverlay := FVfoOverlay;
FSpecView.VfoA := FVfoA;
FSpecView.VfoB := FVfoB;
@@ -2124,14 +2144,30 @@ begin
PbSMeterRight.OnPaint := FSpecView.PaintSMeterRight;
PbSMeterRight.Color := CLR_PANEL;
- PbSpectrum := TPaintBox.Create(Self);
+ if FUseOpenGLSpectrum then
+ begin
+ PbSpectrum := TOpenGLControl.Create(Self);
+ TOpenGLControl(PbSpectrum).AutoResizeViewport := False;
+ TOpenGLControl(PbSpectrum).DoubleBuffered := True;
+ TOpenGLControl(PbSpectrum).OnPaint := FSpecView.PaintSpectrum;
+ TOpenGLControl(PbSpectrum).OnMouseDown := PbSpectrumMouseDown;
+ TOpenGLControl(PbSpectrum).OnDblClick := PbSpectrumDblClick;
+ TOpenGLControl(PbSpectrum).OnMouseMove := PbSpectrumMouseMove;
+ TOpenGLControl(PbSpectrum).OnMouseUp := PbSpectrumMouseUp;
+ TOpenGLControl(PbSpectrum).OnMouseLeave := PbSpectrumMouseLeave;
+ TSpectrumViewOpenGL(FSpecView).AttachControl(TOpenGLControl(PbSpectrum));
+ end
+ else
+ begin
+ PbSpectrum := TPaintBox.Create(Self);
+ TPaintBox(PbSpectrum).OnPaint := FSpecView.PaintSpectrum;
+ TPaintBox(PbSpectrum).OnMouseDown := PbSpectrumMouseDown;
+ TPaintBox(PbSpectrum).OnDblClick := PbSpectrumDblClick;
+ TPaintBox(PbSpectrum).OnMouseMove := PbSpectrumMouseMove;
+ TPaintBox(PbSpectrum).OnMouseUp := PbSpectrumMouseUp;
+ TPaintBox(PbSpectrum).OnMouseLeave := PbSpectrumMouseLeave;
+ end;
PbSpectrum.Parent := PanelRight;
- PbSpectrum.OnPaint := FSpecView.PaintSpectrum;
- PbSpectrum.OnMouseDown := PbSpectrumMouseDown;
- PbSpectrum.OnDblClick := PbSpectrumDblClick;
- PbSpectrum.OnMouseMove := PbSpectrumMouseMove;
- PbSpectrum.OnMouseUp := PbSpectrumMouseUp;
- PbSpectrum.OnMouseLeave := PbSpectrumMouseLeave;
PbRuler := TPaintBox.Create(Self);
PbRuler.Parent := PanelRight;
@@ -2578,7 +2614,8 @@ begin
DP(PanelRX); DP(PanelTX);
DP(PanelRight);
- PbSpectrum.Color := T.BG;
+ if PbSpectrum is TPaintBox then
+ TPaintBox(PbSpectrum).Color := T.BG;
PbWaterfall.Color := T.BG;
if PanelSMeterRight <> nil then PanelSMeterRight.Color := T.Panel;
if PbSMeterRight <> nil then PbSMeterRight.Color := T.Panel;
@@ -2732,7 +2769,11 @@ end;
procedure TMainForm.OnSampleRateOverlayInvalidate(Sender: TObject);
begin
FSpectrumDirty := True;
- if Assigned(FSpecView) then FSpecView.SpectrumDirty := True;
+ if Assigned(FSpecView) then
+ begin
+ FSpecView.SpectrumDirty := True;
+ FSpecView.InvalidateOverlayCache;
+ end;
if Assigned(PbSpectrum) then PbSpectrum.Invalidate;
end;
@@ -5610,7 +5651,11 @@ end;
procedure TMainForm.OnVfoOverlayInvalidate(Sender: TObject);
begin
FSpectrumDirty := True;
- if Assigned(FSpecView) then FSpecView.SpectrumDirty := True;
+ if Assigned(FSpecView) then
+ begin
+ FSpecView.SpectrumDirty := True;
+ FSpecView.InvalidateOverlayCache;
+ end;
if Assigned(PbSpectrum) then PbSpectrum.Invalidate;
end;
diff --git a/SampleRateOverlay.pas b/SampleRateOverlay.pas
index bb5b4a0..0e10095 100644
--- a/SampleRateOverlay.pas
+++ b/SampleRateOverlay.pas
@@ -43,6 +43,7 @@ type
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
procedure DrawOverlay(Target: TBitmap; C: TCanvas; W, H: Integer);
+ procedure DrawOverlayBitmap(Target: TBitmap; W, H: Integer);
function HandleMouseMove(X, Y: Integer): Boolean;
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
function HandleMouseLeave: Boolean;
@@ -242,6 +243,46 @@ begin
DrawSelf(Target, C, FLeft, FTop, Min(FWidth, W - FLeft), Min(FHeight, H - FTop));
end;
+procedure TSampleRateOverlay.DrawOverlayBitmap(Target: TBitmap; W, H: Integer);
+var
+ HitTarget: TBitmap;
+ I, ContentW: Integer;
+begin
+ if (Target = nil) or (W <= 0) or (H <= 0) then Exit;
+ Target.PixelFormat := pf32bit;
+
+ Target.SetSize(8, 8);
+ Target.Canvas.Font.Name := 'Courier New';
+ Target.Canvas.Font.Size := 7;
+ Target.Canvas.Font.Style := [];
+ ContentW := PAD_X + HIDE_W + BTN_GAP;
+ for I := 0 to High(SPAN_NAMES) do
+ begin
+ Inc(ContentW, SpanBtnWidth(SPAN_NAMES[I], Target.Canvas));
+ if I < High(SPAN_NAMES) then Inc(ContentW, BTN_GAP);
+ end;
+ Inc(ContentW, PAD_X);
+ ContentW := Min(ContentW, W);
+
+ Target.SetSize(ContentW, H);
+ Target.Canvas.Brush.Color := TColor($00141414);
+ Target.Canvas.Brush.Style := bsSolid;
+ Target.Canvas.Pen.Style := psClear;
+ Target.Canvas.FillRect(Rect(0, 0, ContentW, H));
+ DrawSelf(Target, Target.Canvas, 0, 0, ContentW, H);
+
+ HitTarget := TBitmap.Create;
+ try
+ HitTarget.PixelFormat := pf32bit;
+ HitTarget.SetSize(Max(1, FLeft + ContentW), Max(1, FTop + H));
+ HitTarget.Canvas.Brush.Color := TColor($00141414);
+ HitTarget.Canvas.FillRect(Rect(0, 0, HitTarget.Width, HitTarget.Height));
+ DrawSelf(HitTarget, HitTarget.Canvas, FLeft, FTop, ContentW, H);
+ finally
+ HitTarget.Free;
+ end;
+end;
+
function TSampleRateOverlay.HandleMouseMove(X, Y: Integer): Boolean;
var
I, OldHot: Integer;
diff --git a/SpectrumView.pas b/SpectrumView.pas
index febc724..a6c0cd1 100644
--- a/SpectrumView.pas
+++ b/SpectrumView.pas
@@ -28,7 +28,7 @@ const
type
TSpectrumView = class
- private
+ protected
// ── Off-screen bitmaps ────────────────────────────────────────────────────
FSpectrumBitmap: TBitmap;
FGridBitmap: TBitmap;
@@ -202,34 +202,35 @@ type
property VfoOverlay: TVfoOverlay read FVfoOverlay write FVfoOverlay;
// ── Данные от DSP ─────────────────────────────────────────────────────────
- procedure SetSpectrumData(const Pixels: array of Single; Count: Integer);
- procedure SetWaterfallData(const Pixels: array of Single; Count: Integer);
+ procedure SetSpectrumData(const Pixels: array of Single; Count: Integer); virtual;
+ procedure SetWaterfallData(const Pixels: array of Single; Count: Integer); virtual;
// ── Рендеринг ─────────────────────────────────────────────────────────────
- procedure DrawSpectrum;
- procedure DrawWaterfall;
- procedure DrawRuler;
+ procedure DrawSpectrum; virtual;
+ procedure DrawWaterfall; virtual;
+ procedure DrawRuler; virtual;
// ── Управление размером bitmap ────────────────────────────────────────────
- procedure SetSpectrumBitmapSize(W, H: Integer);
- procedure SetWaterfallBitmapSize(W, H: Integer);
- procedure SetRulerSize(W, H: Integer);
- function SpectrumBitmapWidth: Integer;
+ procedure SetSpectrumBitmapSize(W, H: Integer); virtual;
+ procedure SetWaterfallBitmapSize(W, H: Integer); virtual;
+ procedure SetRulerSize(W, H: Integer); virtual;
+ function SpectrumBitmapWidth: Integer; virtual;
// ── Paint-обработчики ────────────────────────────────────────────────────
- procedure PaintSpectrum(Sender: TObject);
- procedure PaintWaterfall(Sender: TObject);
- procedure PaintRuler(Sender: TObject);
- procedure PaintSMeterRight(Sender: TObject);
+ procedure PaintSpectrum(Sender: TObject); virtual;
+ procedure PaintWaterfall(Sender: TObject); virtual;
+ procedure PaintRuler(Sender: TObject); virtual;
+ procedure PaintSMeterRight(Sender: TObject); virtual;
// ── Утилиты ───────────────────────────────────────────────────────────────
- procedure InvalidateGridCache;
- procedure SetTheme(const T: TAppTheme);
- procedure InvalidateRulerCache;
- procedure ResetSpectrumBuf;
- procedure ResetWfAvgBuf;
- procedure FillDemoSpectrum;
- function NeedsRulerRedraw: Boolean;
+ procedure InvalidateGridCache; virtual;
+ procedure InvalidateOverlayCache; virtual;
+ procedure SetTheme(const T: TAppTheme); virtual;
+ procedure InvalidateRulerCache; virtual;
+ procedure ResetSpectrumBuf; virtual;
+ procedure ResetWfAvgBuf; virtual;
+ procedure FillDemoSpectrum; virtual;
+ function NeedsRulerRedraw: Boolean; virtual;
end;
implementation
@@ -640,6 +641,11 @@ begin
FSpectrumDirty := True;
end;
+procedure TSpectrumView.InvalidateOverlayCache;
+begin
+ FSpectrumDirty := True;
+end;
+
procedure TSpectrumView.SetTheme(const T: TAppTheme);
begin
FTheme := T;
diff --git a/SpectrumViewOpengl.pas b/SpectrumViewOpengl.pas
new file mode 100644
index 0000000..1a3504a
--- /dev/null
+++ b/SpectrumViewOpengl.pas
@@ -0,0 +1,772 @@
+unit SpectrumViewOpengl;
+
+{
+ OpenGL renderer for the spectrum pane.
+
+ The class keeps the public TSpectrumView contract so MainForm can switch it
+ with --opengl without changing DSP/web data flow. Waterfall, ruler and S-meter
+ remain delegated to the base sub-views; only the spectrum paint path uses GL.
+}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, SysUtils, Graphics, Controls, Math, Types,
+ OpenGLContext, GL,
+ AppTheme, SpectrumView;
+
+type
+ TGLTextureCache = record
+ Tex: GLuint;
+ W: Integer;
+ H: Integer;
+ Dirty: Boolean;
+ end;
+
+ TSpectrumViewOpenGL = class(TSpectrumView)
+ private
+ FGLControl: TOpenGLControl;
+ FGridDirty: Boolean;
+ FOverlayDirty: Boolean;
+ FSampleOverlayDirty: Boolean;
+ FVfoOverlayDirty: Boolean;
+ FGridLabelTex: TGLTextureCache;
+ FAGCLabelTex: TGLTextureCache;
+ FAGCHangLabelTex: TGLTextureCache;
+ FMarkerLabelTex: TGLTextureCache;
+ FADCOverlayTex: TGLTextureCache;
+ FSampleOverlayTex: TGLTextureCache;
+ FVfoOverlayTex: TGLTextureCache;
+ FLastAGCText: string;
+ FLastAGCY: Integer;
+ FLastAGCHangY: Integer;
+ FLastMarkerText: string;
+ FLastMarkerX: Integer;
+ FLastADCVisible: Boolean;
+ FLastSampleX: Integer;
+ FLastSampleY: Integer;
+ FLastSampleW: Integer;
+ FLastSampleH: Integer;
+ FLastVfoX: Integer;
+ FLastVfoY: Integer;
+ FLastVfoW: Integer;
+ FLastVfoH: Integer;
+ FGLSpectrumW: Integer;
+ FGLSpectrumH: Integer;
+ FSpY: array of Integer;
+
+ procedure DeleteTexture(var T: TGLTextureCache);
+ procedure UploadBitmap(var T: TGLTextureCache; B: TBitmap; Keyed: Boolean;
+ FixedAlpha: Byte);
+ procedure UploadAlphaMask(var T: TGLTextureCache; B: TBitmap; AColor: TColor);
+ procedure UploadText(var T: TGLTextureCache; const S: string; AColor: TColor;
+ FontSize: Integer; Bold: Boolean);
+ procedure DrawTexture(const T: TGLTextureCache; X, Y: Integer);
+ procedure DrawRect(X1, Y1, X2, Y2: Integer; C: TColor; Alpha: Single);
+ procedure DrawLine(X1, Y1, X2, Y2: Integer; C: TColor; Width: Single;
+ Stipple: Boolean);
+ procedure DrawVerticalGradient(W, H: Integer);
+ procedure DrawGrid(W, H: Integer; DBmax, DBmin, InvRange: Double);
+ procedure DrawFilterAndCursors(W, H: Integer);
+ procedure DrawAGCLines(W, H: Integer; DBmax, InvRange: Double);
+ procedure DrawSpectrumCurve(W, H: Integer; DBmax, InvRange: Double);
+ procedure DrawMarker(W, H: Integer);
+ procedure DrawADCOverlay(W, H: Integer);
+ procedure DrawCachedOverlays(W, H: Integer);
+ function FormatFreqGL(Hz: Double): string;
+ function ActiveVfoFrequency: Double;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure AttachControl(C: TOpenGLControl);
+ procedure SetSpectrumBitmapSize(W, H: Integer); override;
+ function SpectrumBitmapWidth: Integer; override;
+ procedure DrawSpectrum; override;
+ procedure PaintSpectrum(Sender: TObject); override;
+ procedure InvalidateGridCache; override;
+ procedure InvalidateOverlayCache; override;
+ procedure SetTheme(const T: TAppTheme); override;
+ end;
+
+implementation
+
+const
+ KEY_COLOR = TColor($00FF00FF);
+
+function ClampI(V, Lo, Hi: Integer): Integer;
+begin
+ if V < Lo then Result := Lo
+ else if V > Hi then Result := Hi
+ else Result := V;
+end;
+
+procedure ColorToRGB(C: TColor; out R, G, B: GLFloat);
+begin
+ R := (C and $FF) / 255.0;
+ G := ((C shr 8) and $FF) / 255.0;
+ B := ((C shr 16) and $FF) / 255.0;
+end;
+
+constructor TSpectrumViewOpenGL.Create;
+begin
+ inherited Create;
+ FGridDirty := True;
+ FOverlayDirty := True;
+ FSampleOverlayDirty := True;
+ FVfoOverlayDirty := True;
+ FLastAGCY := -MaxInt;
+ FLastAGCHangY := -MaxInt;
+ FLastMarkerX := -MaxInt;
+ FLastADCVisible := False;
+end;
+
+destructor TSpectrumViewOpenGL.Destroy;
+begin
+ if Assigned(FGLControl) and FGLControl.MakeCurrent then
+ begin
+ DeleteTexture(FGridLabelTex);
+ DeleteTexture(FAGCLabelTex);
+ DeleteTexture(FAGCHangLabelTex);
+ DeleteTexture(FMarkerLabelTex);
+ DeleteTexture(FADCOverlayTex);
+ DeleteTexture(FSampleOverlayTex);
+ DeleteTexture(FVfoOverlayTex);
+ end;
+ inherited Destroy;
+end;
+
+procedure TSpectrumViewOpenGL.AttachControl(C: TOpenGLControl);
+begin
+ FGLControl := C;
+end;
+
+procedure TSpectrumViewOpenGL.DeleteTexture(var T: TGLTextureCache);
+begin
+ if T.Tex <> 0 then
+ glDeleteTextures(1, @T.Tex);
+ T.Tex := 0;
+ T.W := 0;
+ T.H := 0;
+ T.Dirty := True;
+end;
+
+procedure TSpectrumViewOpenGL.UploadBitmap(var T: TGLTextureCache; B: TBitmap;
+ Keyed: Boolean; FixedAlpha: Byte);
+var
+ X, Y, I: Integer;
+ Src: PByte;
+ Buf: array of Byte;
+ IsKey: Boolean;
+begin
+ if (B = nil) or (B.Width <= 0) or (B.Height <= 0) then Exit;
+ if T.Tex = 0 then glGenTextures(1, @T.Tex);
+ T.W := B.Width;
+ T.H := B.Height;
+ SetLength(Buf, T.W * T.H * 4);
+ B.BeginUpdate(False);
+ try
+ I := 0;
+ for Y := 0 to T.H - 1 do
+ begin
+ Src := PByte(B.ScanLine[Y]);
+ for X := 0 to T.W - 1 do
+ begin
+ IsKey := Keyed and (Src[0] = $FF) and (Src[1] = $00) and (Src[2] = $FF);
+ Buf[I] := Src[2];
+ Buf[I + 1] := Src[1];
+ Buf[I + 2] := Src[0];
+ if IsKey then Buf[I + 3] := 0 else Buf[I + 3] := FixedAlpha;
+ Inc(Src, 4);
+ Inc(I, 4);
+ end;
+ end;
+ finally
+ B.EndUpdate(False);
+ end;
+ glBindTexture(GL_TEXTURE_2D, T.Tex);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, T.W, T.H, 0, GL_RGBA,
+ GL_UNSIGNED_BYTE, @Buf[0]);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ T.Dirty := False;
+end;
+
+procedure TSpectrumViewOpenGL.UploadAlphaMask(var T: TGLTextureCache; B: TBitmap;
+ AColor: TColor);
+var
+ X, Y, I: Integer;
+ Src: PByte;
+ Buf: array of Byte;
+ R, G, BB, A: Byte;
+begin
+ if (B = nil) or (B.Width <= 0) or (B.Height <= 0) then Exit;
+ if T.Tex = 0 then glGenTextures(1, @T.Tex);
+ T.W := B.Width;
+ T.H := B.Height;
+ R := AColor and $FF;
+ G := (AColor shr 8) and $FF;
+ BB := (AColor shr 16) and $FF;
+ SetLength(Buf, T.W * T.H * 4);
+ B.BeginUpdate(False);
+ try
+ I := 0;
+ for Y := 0 to T.H - 1 do
+ begin
+ Src := PByte(B.ScanLine[Y]);
+ for X := 0 to T.W - 1 do
+ begin
+ A := Max(Src[0], Max(Src[1], Src[2]));
+ Buf[I] := R;
+ Buf[I + 1] := G;
+ Buf[I + 2] := BB;
+ Buf[I + 3] := A;
+ Inc(Src, 4);
+ Inc(I, 4);
+ end;
+ end;
+ finally
+ B.EndUpdate(False);
+ end;
+ glBindTexture(GL_TEXTURE_2D, T.Tex);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, T.W, T.H, 0, GL_RGBA,
+ GL_UNSIGNED_BYTE, @Buf[0]);
+ glBindTexture(GL_TEXTURE_2D, 0);
+ T.Dirty := False;
+end;
+
+procedure TSpectrumViewOpenGL.UploadText(var T: TGLTextureCache; const S: string;
+ AColor: TColor; FontSize: Integer; Bold: Boolean);
+var
+ B: TBitmap;
+ TW, TH: Integer;
+begin
+ if S = '' then
+ begin
+ DeleteTexture(T);
+ Exit;
+ end;
+ B := TBitmap.Create;
+ try
+ B.PixelFormat := pf32bit;
+ B.SetSize(8, 8);
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := FontSize;
+ if Bold then B.Canvas.Font.Style := [fsBold] else B.Canvas.Font.Style := [];
+ TW := Max(1, B.Canvas.TextWidth(S) + 4);
+ TH := Max(1, B.Canvas.TextHeight(S) + 2);
+ B.SetSize(TW, TH);
+ B.Canvas.Brush.Color := clBlack;
+ B.Canvas.Brush.Style := bsSolid;
+ B.Canvas.Pen.Style := psClear;
+ B.Canvas.FillRect(Rect(0, 0, TW, TH));
+ B.Canvas.Brush.Style := bsClear;
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := FontSize;
+ if Bold then B.Canvas.Font.Style := [fsBold] else B.Canvas.Font.Style := [];
+ B.Canvas.Font.Color := clWhite;
+ B.Canvas.TextOut(2, 1, S);
+ UploadAlphaMask(T, B, AColor);
+ finally
+ B.Free;
+ end;
+end;
+
+procedure TSpectrumViewOpenGL.DrawTexture(const T: TGLTextureCache; X, Y: Integer);
+begin
+ if (T.Tex = 0) or (T.W <= 0) or (T.H <= 0) then Exit;
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, T.Tex);
+ glColor4f(1, 1, 1, 1);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(1, 0); glVertex2f(X + T.W, Y);
+ glTexCoord2f(1, 1); glVertex2f(X + T.W, Y + T.H);
+ glTexCoord2f(0, 1); glVertex2f(X, Y + T.H);
+ glEnd;
+ glBindTexture(GL_TEXTURE_2D, 0);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+procedure TSpectrumViewOpenGL.DrawRect(X1, Y1, X2, Y2: Integer; C: TColor;
+ Alpha: Single);
+var R, G, B: GLFloat;
+begin
+ ColorToRGB(C, R, G, B);
+ glColor4f(R, G, B, Alpha);
+ glBegin(GL_QUADS);
+ glVertex2f(X1, Y1); glVertex2f(X2, Y1);
+ glVertex2f(X2, Y2); glVertex2f(X1, Y2);
+ glEnd;
+end;
+
+procedure TSpectrumViewOpenGL.DrawLine(X1, Y1, X2, Y2: Integer; C: TColor;
+ Width: Single; Stipple: Boolean);
+var R, G, B: GLFloat;
+begin
+ ColorToRGB(C, R, G, B);
+ glColor4f(R, G, B, 1);
+ glLineWidth(Width);
+ if Stipple then
+ begin
+ glEnable(GL_LINE_STIPPLE);
+ glLineStipple(1, $0F0F);
+ end;
+ glBegin(GL_LINES);
+ glVertex2f(X1 + 0.5, Y1 + 0.5);
+ glVertex2f(X2 + 0.5, Y2 + 0.5);
+ glEnd;
+ if Stipple then glDisable(GL_LINE_STIPPLE);
+ glLineWidth(1);
+end;
+
+procedure TSpectrumViewOpenGL.SetSpectrumBitmapSize(W, H: Integer);
+begin
+ if (W <= 0) or (H <= 0) then Exit;
+ FGLSpectrumW := W;
+ FGLSpectrumH := H;
+ FGridDirty := True;
+ FOverlayDirty := True;
+ FSpectrumDirty := True;
+ if Assigned(FGLControl) then FGLControl.Invalidate;
+end;
+
+function TSpectrumViewOpenGL.SpectrumBitmapWidth: Integer;
+begin
+ Result := FGLSpectrumW;
+end;
+
+procedure TSpectrumViewOpenGL.DrawSpectrum;
+begin
+ FSpectrumDirty := False;
+ if Assigned(FGLControl) then FGLControl.Invalidate;
+end;
+
+procedure TSpectrumViewOpenGL.InvalidateGridCache;
+begin
+ inherited InvalidateGridCache;
+ FGridDirty := True;
+ FOverlayDirty := True;
+end;
+
+procedure TSpectrumViewOpenGL.InvalidateOverlayCache;
+begin
+ inherited InvalidateOverlayCache;
+ FOverlayDirty := True;
+ FSampleOverlayDirty := True;
+ FVfoOverlayDirty := True;
+end;
+
+procedure TSpectrumViewOpenGL.SetTheme(const T: TAppTheme);
+begin
+ inherited SetTheme(T);
+ FGridDirty := True;
+ FOverlayDirty := True;
+end;
+
+function TSpectrumViewOpenGL.FormatFreqGL(Hz: Double): string;
+var Mhz: Int64; KHz, Rest: Integer;
+begin
+ Mhz := Trunc(Hz / 1000000);
+ KHz := Trunc((Hz - Mhz * 1000000) / 1000);
+ Rest := Trunc(Hz) mod 1000;
+ Result := Format('%d.%3.3d.%3.3d', [Mhz, KHz, Rest]);
+end;
+
+function TSpectrumViewOpenGL.ActiveVfoFrequency: Double;
+begin
+ if FActiveVfo = 0 then Result := FVfoA else Result := FVfoB;
+end;
+
+procedure TSpectrumViewOpenGL.DrawVerticalGradient(W, H: Integer);
+var
+ R1, G1, B1, R2, G2, B2: GLFloat;
+begin
+ ColorToRGB(FTheme.SpecGradTop, R1, G1, B1);
+ ColorToRGB(FTheme.SpecGradBot, R2, G2, B2);
+ glBegin(GL_QUADS);
+ glColor4f(R1, G1, B1, 1); glVertex2f(0, 0); glVertex2f(W, 0);
+ glColor4f(R2, G2, B2, 1); glVertex2f(W, H); glVertex2f(0, H);
+ glEnd;
+ DrawRect(0, 0, 28, H, FTheme.SpecLabelBand, 1);
+end;
+
+procedure TSpectrumViewOpenGL.DrawGrid(W, H: Integer; DBmax, DBmin,
+ InvRange: Double);
+var
+ I, Yp, GX, N, GridMult: Integer;
+ DB, GridFreqS, GridLine, PixPerStep: Double;
+ B: TBitmap;
+begin
+ DB := DBmax - FSpecGridStep;
+ while DB >= DBmin do
+ begin
+ Yp := Round((DBmax - DB) * InvRange * H);
+ DrawLine(0, Yp, W - 1, Yp, FTheme.SpecGrid, 1, False);
+ DB := DB - FSpecGridStep;
+ end;
+
+ if FFMGridStepHz > 0 then
+ begin
+ GridFreqS := FCenterFreq - FSpanHz / 2;
+ PixPerStep := W * FFMGridStepHz / FSpanHz;
+ if PixPerStep >= 1.0 then GridMult := Max(1, Ceil(4.0 / PixPerStep))
+ else GridMult := 0;
+ if GridMult > 0 then
+ begin
+ N := Ceil(GridFreqS / FFMGridStepHz);
+ GridLine := N * FFMGridStepHz;
+ while GridLine <= FCenterFreq + FSpanHz / 2 + 0.5 do
+ begin
+ if (N mod GridMult) = 0 then
+ begin
+ GX := Round((GridLine - GridFreqS) / FSpanHz * W);
+ if (GX >= 0) and (GX < W) then DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False);
+ end;
+ Inc(N);
+ GridLine := GridLine + FFMGridStepHz;
+ end;
+ end;
+ end
+ else
+ for I := 0 to 8 do
+ begin
+ GX := Round(I / 8 * W);
+ DrawLine(GX, 0, GX, H, FTheme.SpecGrid, 1, False);
+ end;
+
+ if FGridDirty or FGridLabelTex.Dirty or (FGridLabelTex.H <> H) then
+ begin
+ B := TBitmap.Create;
+ try
+ B.PixelFormat := pf32bit;
+ B.SetSize(28, H);
+ B.Canvas.Brush.Color := clBlack;
+ B.Canvas.Brush.Style := bsSolid;
+ B.Canvas.Pen.Style := psClear;
+ B.Canvas.FillRect(Rect(0, 0, 28, H));
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := 7;
+ B.Canvas.Font.Color := clWhite;
+ B.Canvas.Brush.Style := bsClear;
+ DB := DBmax - FSpecGridStep;
+ while DB >= DBmin do
+ begin
+ Yp := Round((DBmax - DB) * InvRange * H);
+ B.Canvas.TextOut(1, Yp - 9, Format('%4.0f', [DB]));
+ DB := DB - FSpecGridStep;
+ end;
+ UploadAlphaMask(FGridLabelTex, B, FTheme.SpecLabelText);
+ finally
+ B.Free;
+ end;
+ FGridDirty := False;
+ end;
+ DrawTexture(FGridLabelTex, 0, 0);
+end;
+
+procedure TSpectrumViewOpenGL.DrawFilterAndCursors(W, H: Integer);
+var
+ X1, X2, VfoX, TXX1, TXX2, TXVfoX: Integer;
+begin
+ TXX1 := 0;
+ TXX2 := 0;
+ TXVfoX := 0;
+ if FActiveVfo = 0 then CalcFilterBandX(FVfoA, W, X1, X2, VfoX)
+ else CalcFilterBandX(FVfoB, W, X1, X2, VfoX);
+
+ if FTXOverlay then
+ begin
+ if FTXVfoIndex <> FActiveVfo then
+ begin
+ if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($0030C030), 100 / 255);
+ if FTXVfoIndex = 0 then CalcFilterBandX(FVfoA, W, TXX1, TXX2, TXVfoX)
+ else CalcFilterBandX(FVfoB, W, TXX1, TXX2, TXVfoX);
+ if TXX2 > TXX1 then DrawRect(TXX1, 0, TXX2, H, TColor($00E03030), 100 / 255);
+ end
+ else if X2 > X1 then DrawRect(X1, 0, X2, H, TColor($00E03030), 100 / 255);
+ end
+ else if X2 > X1 then
+ DrawRect(X1, 0, X2, H, FTheme.SpecFilter, 1);
+
+ DrawLine(X1, 0, X1, H, FTheme.SpecFilterEdge, 1, False);
+ DrawLine(X2, 0, X2, H, FTheme.SpecFilterEdge, 1, False);
+ DrawLine(VfoX, 0, VfoX, H - 12, FTheme.SpecVfoCursor, 2, False);
+ DrawRect(VfoX - 5, 0, VfoX + 5, 8, FTheme.SpecVfoCursor, 1);
+
+ if FTXOverlay and (FTXVfoIndex <> FActiveVfo) then
+ begin
+ DrawLine(TXX1, 0, TXX1, H, TColor($002030E0), 1, False);
+ DrawLine(TXX2, 0, TXX2, H, TColor($002030E0), 1, False);
+ DrawLine(TXVfoX, 0, TXVfoX, H - 12, TColor($002030E0), 2, False);
+ DrawRect(TXVfoX - 5, 0, TXVfoX + 5, 8, TColor($002030E0), 1);
+ end;
+end;
+
+procedure TSpectrumViewOpenGL.DrawAGCLines(W, H: Integer; DBmax,
+ InvRange: Double);
+var
+ AGCY, AGCHangY: Integer;
+ Text: string;
+begin
+ if FWDSPReady then
+ begin
+ AGCY := Round((DBmax - FAGCThresh) * InvRange * H);
+ Text := 'AGC T';
+ if (AGCY >= 0) and (AGCY < H) then
+ begin
+ DrawLine(0, AGCY, W, AGCY, FTheme.SpecAgcColor, 1, True);
+ if (Text <> FLastAGCText) or (AGCY <> FLastAGCY) or FAGCLabelTex.Dirty then
+ begin
+ UploadText(FAGCLabelTex, Text, FTheme.SpecAgcColor, 6, False);
+ FLastAGCText := Text;
+ FLastAGCY := AGCY;
+ end;
+ DrawTexture(FAGCLabelTex, 4, AGCY - 9);
+ end;
+ AGCHangY := Round((DBmax - FAGCHangLevel) * InvRange * H);
+ if (AGCHangY >= 0) and (AGCHangY < H) and (Abs(AGCHangY - AGCY) > 4) then
+ begin
+ DrawLine(0, AGCHangY, W, AGCHangY, FTheme.SpecAgcHangColor, 1, True);
+ if (AGCHangY <> FLastAGCHangY) or FAGCHangLabelTex.Dirty then
+ begin
+ UploadText(FAGCHangLabelTex, 'AGC H', FTheme.SpecAgcHangColor, 6, False);
+ FLastAGCHangY := AGCHangY;
+ end;
+ DrawTexture(FAGCHangLabelTex, 4, AGCHangY + 2);
+ end;
+ end
+ else
+ begin
+ AGCY := Round((DBmax - (-FAGCTop)) * InvRange * H);
+ Text := Format('AGC -%ddB', [FAGCTop]);
+ if (AGCY >= 0) and (AGCY < H) then
+ begin
+ DrawLine(0, AGCY, W, AGCY, FTheme.SpecAgcColor, 1, True);
+ if (Text <> FLastAGCText) or (AGCY <> FLastAGCY) or FAGCLabelTex.Dirty then
+ begin
+ UploadText(FAGCLabelTex, Text, FTheme.SpecAgcColor, 6, False);
+ FLastAGCText := Text;
+ FLastAGCY := AGCY;
+ end;
+ DrawTexture(FAGCLabelTex, 4, AGCY - 9);
+ end;
+ end;
+end;
+
+procedure TSpectrumViewOpenGL.DrawSpectrumCurve(W, H: Integer; DBmax,
+ InvRange: Double);
+var
+ I, SrcCount, S0, S1: Integer;
+ SrcF, Frac, DBV: Double;
+ R, G, B: GLFloat;
+begin
+ if Length(FSpY) <> W then SetLength(FSpY, W);
+ SrcCount := ClampI(FSpectrumBufCount, 2, 1024);
+ for I := 0 to W - 1 do
+ begin
+ if FTXMode and (FTXSpanHz > 0) and (FSpanHz > 0) then
+ begin
+ SrcF := FCenterFreq - FSpanHz * 0.5 + I * FSpanHz / Max(1, W - 1);
+ Frac := SrcF - FTXFreq;
+ if (Frac < -FTXSpanHz * 0.5) or (Frac > FTXSpanHz * 0.5) then DBV := -200.0
+ else
+ begin
+ SrcF := (Frac + FTXSpanHz * 0.5) / FTXSpanHz * (SrcCount - 1);
+ S0 := Min(Trunc(SrcF), SrcCount - 1);
+ S1 := Min(S0 + 1, SrcCount - 1);
+ Frac := SrcF - S0;
+ DBV := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
+ end;
+ end
+ else
+ begin
+ SrcF := I * (SrcCount - 1.0) / Max(1, W - 1);
+ S0 := Min(Trunc(SrcF), SrcCount - 1);
+ S1 := Min(S0 + 1, SrcCount - 1);
+ Frac := SrcF - S0;
+ DBV := FSpectrumBuf[S0] * (1.0 - Frac) + FSpectrumBuf[S1] * Frac;
+ end;
+ FSpY[I] := ClampI(Round((DBmax - DBV) * InvRange * H), 0, H - 1);
+ end;
+
+ ColorToRGB(TColor((FTheme.SpecGradB shl 16) or
+ (FTheme.SpecGradG shl 8) or FTheme.SpecGradR), R, G, B);
+ glBegin(GL_TRIANGLE_STRIP);
+ for I := 0 to W - 1 do
+ begin
+ glColor4f(R, G, B, 200 / 255);
+ glVertex2f(I + 0.5, FSpY[I] + 0.5);
+ glColor4f(R, G, B, 0);
+ glVertex2f(I + 0.5, H);
+ end;
+ glEnd;
+
+ ColorToRGB(FTheme.SpecLine, R, G, B);
+ glColor4f(R, G, B, 1);
+ glBegin(GL_LINE_STRIP);
+ for I := 0 to W - 1 do glVertex2f(I + 0.5, FSpY[I] + 0.5);
+ glEnd;
+end;
+
+procedure TSpectrumViewOpenGL.DrawMarker(W, H: Integer);
+var
+ MX: Integer;
+ MarkerFreq: Double;
+ MarkerText: string;
+begin
+ if not FMarkerActive then Exit;
+ MX := Round(FMarkerX / 1000.0 * W);
+ if (MX < 0) or (MX >= W) then Exit;
+ DrawLine(MX, 0, MX, H, TColor($004444FF), 1, False);
+ MarkerFreq := (FCenterFreq - FSpanHz / 2) + FMarkerX / 1000.0 * FSpanHz;
+ MarkerText := FormatFreqGL(Round(MarkerFreq));
+ if (MarkerText <> FLastMarkerText) or (MX <> FLastMarkerX) or FMarkerLabelTex.Dirty then
+ begin
+ UploadText(FMarkerLabelTex, MarkerText, TColor($004444FF), 7, False);
+ FLastMarkerText := MarkerText;
+ FLastMarkerX := MX;
+ end;
+ if MX + 4 + FMarkerLabelTex.W < W then DrawTexture(FMarkerLabelTex, MX + 4, 4)
+ else DrawTexture(FMarkerLabelTex, MX - 4 - FMarkerLabelTex.W, 4);
+end;
+
+procedure TSpectrumViewOpenGL.DrawADCOverlay(W, H: Integer);
+var
+ B: TBitmap;
+begin
+ if not FADCOverloadVisible then Exit;
+ if (not FLastADCVisible) or FADCOverlayTex.Dirty then
+ begin
+ B := TBitmap.Create;
+ try
+ B.PixelFormat := pf32bit;
+ B.SetSize(210, 38);
+ B.Canvas.Brush.Color := TColor($00202020);
+ B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height));
+ B.Canvas.Pen.Color := TColor($000030C0);
+ B.Canvas.Brush.Style := bsClear;
+ B.Canvas.Rectangle(0, 0, B.Width, B.Height);
+ B.Canvas.Font.Name := 'Courier New';
+ B.Canvas.Font.Size := 10;
+ 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);
+end;
+
+procedure TSpectrumViewOpenGL.DrawCachedOverlays(W, H: Integer);
+var
+ B: TBitmap;
+ OW, OH: Integer;
+begin
+ if Assigned(FSampleRateOverlay) then
+ begin
+ OW := Min(FSampleRateOverlay.Width, W - FSampleRateOverlay.Left);
+ OH := Min(FSampleRateOverlay.Height, H - FSampleRateOverlay.Top);
+ if (OW > 0) and (OH > 0) then
+ begin
+ if FOverlayDirty or FSampleOverlayDirty or FSampleOverlayTex.Dirty or
+ (FLastSampleX <> FSampleRateOverlay.Left) or
+ (FLastSampleY <> FSampleRateOverlay.Top) or
+ (FLastSampleH <> OH) then
+ begin
+ B := TBitmap.Create;
+ try
+ FSampleRateOverlay.DrawOverlayBitmap(B, OW, OH);
+ UploadBitmap(FSampleOverlayTex, B, False, 255);
+ finally
+ B.Free;
+ end;
+ FLastSampleX := FSampleRateOverlay.Left;
+ FLastSampleY := FSampleRateOverlay.Top;
+ FLastSampleW := FSampleOverlayTex.W;
+ FLastSampleH := OH;
+ FSampleOverlayDirty := False;
+ end;
+ DrawTexture(FSampleOverlayTex, FSampleRateOverlay.Left, FSampleRateOverlay.Top);
+ end;
+ end;
+
+ if Assigned(FVfoOverlay) and FVfoOverlay.Visible then
+ begin
+ if FOverlayDirty or FVfoOverlayDirty or FVfoOverlayTex.Dirty or
+ (FLastVfoX <> FVfoOverlay.Left) or (FLastVfoY <> FVfoOverlay.Top) or
+ (FLastVfoW <> FVfoOverlay.Width) or (FLastVfoH <> FVfoOverlay.Height) then
+ begin
+ B := TBitmap.Create;
+ try
+ FVfoOverlay.DrawOverlayBitmap(B);
+ UploadBitmap(FVfoOverlayTex, B, True, 218);
+ finally
+ B.Free;
+ end;
+ FLastVfoX := FVfoOverlay.Left;
+ FLastVfoY := FVfoOverlay.Top;
+ FLastVfoW := FVfoOverlay.Width;
+ FLastVfoH := FVfoOverlay.Height;
+ FVfoOverlayDirty := False;
+ end;
+ DrawTexture(FVfoOverlayTex, FVfoOverlay.Left, FVfoOverlay.Top);
+ end;
+ FOverlayDirty := False;
+end;
+
+procedure TSpectrumViewOpenGL.PaintSpectrum(Sender: TObject);
+var
+ W, H: Integer;
+ DBmax, DBmin, InvRange: Double;
+begin
+ if Sender is TOpenGLControl then
+ FGLControl := TOpenGLControl(Sender);
+ if (FGLControl = nil) or (not FGLControl.MakeCurrent) then Exit;
+ W := FGLControl.Width;
+ H := FGLControl.Height;
+ if (W <= 0) or (H <= 0) then Exit;
+
+ glViewport(0, 0, W, H);
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, W, H, 0, -1, 1);
+ glMatrixMode(GL_MODELVIEW);
+ glLoadIdentity;
+ glDisable(GL_DEPTH_TEST);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glClearColor(0, 0, 0, 1);
+ glClear(GL_COLOR_BUFFER_BIT);
+
+ DBmax := FSpecRefLevel;
+ DBmin := FSpecRefLevel - FSpecRange;
+ InvRange := 1.0 / (DBmax - DBmin);
+
+ DrawVerticalGradient(W, H);
+ DrawGrid(W, H, DBmax, DBmin, InvRange);
+ DrawFilterAndCursors(W, H);
+ DrawAGCLines(W, H, DBmax, InvRange);
+ DrawSpectrumCurve(W, H, DBmax, InvRange);
+ DrawMarker(W, H);
+ DrawADCOverlay(W, H);
+ DrawCachedOverlays(W, H);
+
+ FLastADCVisible := FADCOverloadVisible;
+ FGLControl.SwapBuffers;
+end;
+
+end.
diff --git a/VfoOverlay.pas b/VfoOverlay.pas
index 84c66de..246bb20 100644
--- a/VfoOverlay.pas
+++ b/VfoOverlay.pas
@@ -63,6 +63,7 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawOverlay(Target: TBitmap; W, H: Integer);
+ procedure DrawOverlayBitmap(Target: TBitmap);
function HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
function HandleMouseMove(X, Y: Integer): Boolean;
function HandleMouseLeave: Boolean;
@@ -632,6 +633,19 @@ begin
BlendBitmapKey(Target, FCacheBitmap, Left, Top, 218);
end;
+procedure TVfoOverlay.DrawOverlayBitmap(Target: TBitmap);
+begin
+ if (Target = nil) or (Width <= 0) or (Height <= 0) then Exit;
+ Target.PixelFormat := pf32bit;
+ Target.SetSize(Width, Height);
+ Target.Canvas.Brush.Color := KEY_COLOR;
+ Target.Canvas.Brush.Style := bsSolid;
+ Target.Canvas.Pen.Style := psClear;
+ Target.Canvas.FillRect(Rect(0, 0, Width, Height));
+ DrawSelf(Target.Canvas, Width, Height);
+ FCacheDirty := False;
+end;
+
function TVfoOverlay.HandleMouseDown(Button: TMouseButton; X, Y: Integer): Boolean;
begin
Result := False;
diff --git a/ewsdr.lpi b/ewsdr.lpi
index 618a90c..a267581 100644
--- a/ewsdr.lpi
+++ b/ewsdr.lpi
@@ -55,6 +55,9 @@
+ -
+
+
-
@@ -207,6 +210,10 @@
+
+
+
+
diff --git a/ewsdr.lpr b/ewsdr.lpr
index f96552a..845b11e 100644
--- a/ewsdr.lpr
+++ b/ewsdr.lpr
@@ -15,7 +15,8 @@ uses
{$ENDIF}
Interfaces, // LCL platform
WindowsDPI,
- Forms, MainForm, AudioOutput, DeviceForm, FlatButton, FreqDisplay, VfoOverlay,
+ Forms, LazOpenGLContext,
+ MainForm, AudioOutput, DeviceForm, FlatButton, FreqDisplay, VfoOverlay,
WDSP, WDSPEngine, WebPageHtml, WebServer, WebUtils, WinFirewall, WsClient,
Settings;