Files
ewsdr/EqualizerControl.pas

687 lines
19 KiB
ObjectPascal

unit EqualizerControl;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Graphics, LCLType, Types, Math,
FlatButton, AppTheme;
type
TEqualizerControl = class(TCustomControl)
private
FEnabledEQ: Boolean;
FBandCount: Integer;
FPreampGain: Double;
FGains: array[1..10] of Double;
FFreqs: array[1..10] of Double;
FDragging: Integer; // -1=preamp, 1..10=band, 0=none
FHover: Integer;
FOnChange: TNotifyEvent;
FClrBG: TColor;
FClrPanel: TColor;
FClrBorder: TColor;
FClrGrid: TColor;
FClrText: TColor;
FClrTextDim: TColor;
FClrAccent: TColor;
FClrCurve: TColor;
FBtnEQ: TFlatButton;
FBtnBands3: TFlatButton;
FBtnBands10: TFlatButton;
FButtonTheme: TAppTheme;
function GetBandGain(Index: Integer): Double;
function GetBandFreq(Index: Integer): Double;
procedure SetEnabledEQ(V: Boolean);
procedure SetBandCount(V: Integer);
procedure SetPreampGain(V: Double);
procedure SetBandGain(Index: Integer; V: Double);
procedure SetBandFreq(Index: Integer; V: Double);
function TopRect: TRect;
function PreampRect: TRect;
function GraphRect: TRect;
function TilesRect: TRect;
function GainToY(G: Double; const R: TRect): Integer;
function YToGain(Y: Integer; const R: TRect): Double;
function BandX(Index: Integer; const R: TRect): Integer;
function XToFreq(X: Integer; const R: TRect): Double;
function BandColor(Index: Integer): TColor;
function InternalBandFreq(Index: Integer): Double;
function ResponseAtFreq(AFreq: Double): Double;
function FormatFreq(AFreq: Double): string;
function HitTestControl(X, Y: Integer): Integer;
procedure DrawTiles;
procedure LayoutButtons;
procedure StyleButton(B: TFlatButton; Active: Boolean);
procedure UpdateButtonStates;
procedure OnEQButtonClick(Sender: TObject);
procedure OnBands3Click(Sender: TObject);
procedure OnBands10Click(Sender: TObject);
procedure Changed;
protected
procedure Paint; override;
procedure Resize; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
public
constructor Create(AOwner: TComponent); override;
procedure SetThemeColors(ABG, APanel, ABorder, AGrid, AText, ATextDim,
AAccent, ACurve: TColor);
procedure SetAppTheme(const ATheme: TAppTheme);
procedure SetBand(Index: Integer; AFreq, AGain: Double);
property EQEnabled: Boolean read FEnabledEQ write SetEnabledEQ;
property BandCount: Integer read FBandCount write SetBandCount;
property PreampGain: Double read FPreampGain write SetPreampGain;
property BandGain[Index: Integer]: Double read GetBandGain write SetBandGain;
property BandFreq[Index: Integer]: Double read GetBandFreq write SetBandFreq;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
implementation
const
MIN_GAIN = -15.0;
MAX_GAIN = 15.0;
VIS_MIN_GAIN = -20.0;
VIS_MAX_GAIN = 20.0;
MIN_FREQ = 20.0;
MAX_FREQ = 20000.0;
TOP_H = 44;
BOTTOM_H = 82;
constructor TEqualizerControl.Create(AOwner: TComponent);
var
i: Integer;
begin
inherited Create(AOwner);
Width := 720;
Height := 300;
FEnabledEQ := False;
FBandCount := 10;
FPreampGain := 0.0;
FDragging := 0;
FHover := 0;
for i := 1 to 10 do
begin
FGains[i] := 0.0;
FFreqs[i] := 0.0;
end;
FClrBG := TColor($001A1A1A);
FClrPanel := TColor($00202020);
FClrBorder := TColor($00303030);
FClrGrid := TColor($00383838);
FClrText := TColor($00E0E0E0);
FClrTextDim := TColor($00888888);
FClrAccent := TColor($0040FF80);
FClrCurve := TColor($0055DDEE);
FButtonTheme := DarkTheme;
Cursor := crHandPoint;
FBtnEQ := TFlatButton.Create(Self);
FBtnEQ.Parent := Self;
FBtnEQ.Caption := 'Equalizer';
FBtnEQ.OnClick := @OnEQButtonClick;
FBtnBands3 := TFlatButton.Create(Self);
FBtnBands3.Parent := Self;
FBtnBands3.Caption := '3 Band';
FBtnBands3.OnClick := @OnBands3Click;
FBtnBands10 := TFlatButton.Create(Self);
FBtnBands10.Parent := Self;
FBtnBands10.Caption := '10 Band';
FBtnBands10.OnClick := @OnBands10Click;
LayoutButtons;
UpdateButtonStates;
end;
procedure TEqualizerControl.SetThemeColors(ABG, APanel, ABorder, AGrid,
AText, ATextDim, AAccent, ACurve: TColor);
begin
FClrBG := ABG;
FClrPanel := APanel;
FClrBorder := ABorder;
FClrGrid := AGrid;
FClrText := AText;
FClrTextDim := ATextDim;
FClrAccent := AAccent;
FClrCurve := ACurve;
UpdateButtonStates;
Invalidate;
end;
procedure TEqualizerControl.SetAppTheme(const ATheme: TAppTheme);
begin
FButtonTheme := ATheme;
UpdateButtonStates;
Invalidate;
end;
function TEqualizerControl.GetBandGain(Index: Integer): Double;
begin
if (Index >= 1) and (Index <= 10) then Result := FGains[Index]
else Result := 0.0;
end;
function TEqualizerControl.GetBandFreq(Index: Integer): Double;
begin
if (Index >= 1) and (Index <= 10) then Result := FFreqs[Index]
else Result := 0.0;
end;
procedure TEqualizerControl.Changed;
begin
UpdateButtonStates;
Invalidate;
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TEqualizerControl.SetEnabledEQ(V: Boolean);
begin
if FEnabledEQ = V then Exit;
FEnabledEQ := V;
Changed;
end;
procedure TEqualizerControl.SetBandCount(V: Integer);
begin
if V <= 3 then V := 3 else V := 10;
if FBandCount = V then Exit;
FBandCount := V;
Changed;
end;
procedure TEqualizerControl.SetPreampGain(V: Double);
begin
V := EnsureRange(V, MIN_GAIN, MAX_GAIN);
if Abs(FPreampGain - V) < 0.001 then Exit;
FPreampGain := V;
Changed;
end;
procedure TEqualizerControl.SetBandGain(Index: Integer; V: Double);
begin
if (Index < 1) or (Index > 10) then Exit;
V := EnsureRange(V, MIN_GAIN, MAX_GAIN);
if Abs(FGains[Index] - V) < 0.001 then Exit;
FGains[Index] := V;
Changed;
end;
procedure TEqualizerControl.SetBandFreq(Index: Integer; V: Double);
begin
if (Index < 1) or (Index > 10) then Exit;
V := EnsureRange(V, MIN_FREQ, MAX_FREQ);
if Abs(FFreqs[Index] - V) < 0.001 then Exit;
FFreqs[Index] := V;
Changed;
end;
procedure TEqualizerControl.SetBand(Index: Integer; AFreq, AGain: Double);
begin
if (Index < 1) or (Index > 10) then Exit;
if AFreq <= 0.0 then
FFreqs[Index] := MIN_FREQ * Power(MAX_FREQ / MIN_FREQ, (Index - 1) / 9)
else
FFreqs[Index] := EnsureRange(AFreq, MIN_FREQ, MAX_FREQ);
FGains[Index] := EnsureRange(AGain, MIN_GAIN, MAX_GAIN);
Invalidate;
end;
function TEqualizerControl.GraphRect: TRect;
var
R: TRect;
begin
R := TopRect;
Result := Rect(R.Left + 54, R.Top, R.Right, R.Bottom);
end;
function TEqualizerControl.TopRect: TRect;
begin
Result := Rect(40, TOP_H, Width - 26, Height - BOTTOM_H - 10);
end;
function TEqualizerControl.PreampRect: TRect;
var
R: TRect;
begin
R := TopRect;
Result := Rect(R.Left, R.Top, R.Left + 38, R.Bottom);
end;
function TEqualizerControl.TilesRect: TRect;
begin
Result := Rect(40, Height - BOTTOM_H + 12, Width - 26, Height - 6);
end;
function TEqualizerControl.GainToY(G: Double; const R: TRect): Integer;
begin
G := EnsureRange(G, VIS_MIN_GAIN, VIS_MAX_GAIN);
Result := R.Bottom - Round((G - VIS_MIN_GAIN) / (VIS_MAX_GAIN - VIS_MIN_GAIN) * (R.Bottom - R.Top));
end;
function TEqualizerControl.YToGain(Y: Integer; const R: TRect): Double;
begin
Result := VIS_MIN_GAIN + (R.Bottom - EnsureRange(Y, R.Top, R.Bottom)) /
Max(1, R.Bottom - R.Top) * (VIS_MAX_GAIN - VIS_MIN_GAIN);
Result := EnsureRange(Result, MIN_GAIN, MAX_GAIN);
end;
function TEqualizerControl.BandX(Index: Integer; const R: TRect): Integer;
var
F: Double;
begin
F := EnsureRange(InternalBandFreq(Index), MIN_FREQ, MAX_FREQ);
Result := R.Left + Round(Ln(F / MIN_FREQ) / Ln(MAX_FREQ / MIN_FREQ) * (R.Right - R.Left));
end;
function TEqualizerControl.XToFreq(X: Integer; const R: TRect): Double;
var
P: Double;
begin
P := EnsureRange((X - R.Left) / Max(1, R.Right - R.Left), 0.0, 1.0);
Result := MIN_FREQ * Power(MAX_FREQ / MIN_FREQ, P);
end;
function TEqualizerControl.BandColor(Index: Integer): TColor;
const
C: array[1..10] of TColor = (
TColor($00E05A2A), TColor($00D99028), TColor($00C9B72C), TColor($006FBF45),
TColor($003DBE70), TColor($0035B7C4), TColor($003B88E0), TColor($006456E8),
TColor($00A653D6), TColor($00D34F9D));
begin
if (Index >= 1) and (Index <= 10) then Result := C[Index]
else Result := FClrAccent;
end;
function TEqualizerControl.InternalBandFreq(Index: Integer): Double;
begin
if (Index >= 1) and (Index <= 10) and (FFreqs[Index] > 0.0) then
Result := FFreqs[Index]
else
Result := MIN_FREQ * Power(MAX_FREQ / MIN_FREQ, EnsureRange((Index - 1) / 9, 0.0, 1.0));
end;
function TEqualizerControl.ResponseAtFreq(AFreq: Double): Double;
var
i, N: Integer;
D, W, Sum, LF, LBand: Double;
begin
Result := FPreampGain;
LF := Ln(EnsureRange(AFreq, MIN_FREQ, MAX_FREQ));
Sum := 0.0;
N := FBandCount;
for i := 1 to N do
begin
LBand := Ln(InternalBandFreq(i));
D := (LF - LBand) / 0.30;
W := Exp(-0.5 * D * D);
Sum := Sum + FGains[i] * W;
end;
Result := Result + Sum;
Result := EnsureRange(Result, -24.0, 24.0);
end;
function TEqualizerControl.FormatFreq(AFreq: Double): string;
begin
if AFreq >= 1000.0 then
Result := FormatFloat('0.#', AFreq / 1000.0) + 'k'
else
Result := FormatFloat('0', AFreq);
end;
function TEqualizerControl.HitTestControl(X, Y: Integer): Integer;
var
R: TRect;
i, BX, BY, N: Integer;
begin
Result := 0;
R := PreampRect;
if PtInRect(R, Point(X, Y)) then Exit(-1);
R := GraphRect;
N := FBandCount;
for i := 1 to N do
begin
BX := BandX(i, R);
BY := GainToY(FGains[i], R);
if (Abs(X - BX) <= 12) and (Abs(Y - BY) <= 12) then
Exit(i);
end;
end;
procedure TEqualizerControl.DrawTiles;
var
R, TR: TRect;
i, TileW, X: Integer;
C: TColor;
S: string;
begin
R := TilesRect;
TileW := Max(1, (R.Right - R.Left) div 10);
Canvas.Font.Size := 8;
Canvas.Brush.Style := bsSolid;
for i := 1 to 10 do
begin
X := R.Left + (i - 1) * TileW;
TR := Rect(X, R.Top, X + TileW - 2, R.Bottom);
C := BandColor(i);
if i <= FBandCount then Canvas.Brush.Color := TColor($00262626)
else Canvas.Brush.Color := TColor($001F1F1F);
Canvas.Pen.Color := FClrBorder;
Canvas.Rectangle(TR);
Canvas.Pen.Color := C;
Canvas.Brush.Style := bsClear;
Canvas.Arc(TR.Left + 16, TR.Top + 6, TR.Left + 48, TR.Top + 30,
TR.Left + 18, TR.Top + 22, TR.Left + 46, TR.Top + 22);
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := C;
Canvas.Ellipse(TR.Left + 30, TR.Top + 13, TR.Left + 38, TR.Top + 21);
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FClrTextDim;
S := FormatFreq(InternalBandFreq(i));
Canvas.TextOut(TR.Left + 6, TR.Top + 34, S);
Canvas.Font.Color := C;
Canvas.TextOut(TR.Left + 6, TR.Top + 49, FormatFloat('0.0', FGains[i]));
Canvas.Brush.Style := bsSolid;
end;
Canvas.Font.Size := 9;
end;
procedure TEqualizerControl.LayoutButtons;
begin
if FBtnEQ <> nil then
FBtnEQ.SetBounds(18, 12, 94, 22);
if FBtnBands3 <> nil then
FBtnBands3.SetBounds(Width - 210, 12, 102, 24);
if FBtnBands10 <> nil then
FBtnBands10.SetBounds(Width - 100, 12, 82, 24);
end;
procedure TEqualizerControl.StyleButton(B: TFlatButton; Active: Boolean);
begin
if B = nil then Exit;
B.Active := Active;
B.ClrNorm := FButtonTheme.BtnNorm;
B.ClrActive := FButtonTheme.BtnActive;
B.ClrHot := FButtonTheme.BtnHot;
if Active then
B.ClrBorder := FButtonTheme.BtnBorderActive
else
B.ClrBorder := FButtonTheme.BtnBorderNorm;
B.ClrText := FButtonTheme.BtnText;
B.ClrTextAct := FButtonTheme.BtnTextActive;
B.Font.Name := 'Courier New';
B.Font.Size := 8;
B.Invalidate;
end;
procedure TEqualizerControl.UpdateButtonStates;
begin
StyleButton(FBtnEQ, FEnabledEQ);
StyleButton(FBtnBands3, FBandCount = 3);
StyleButton(FBtnBands10, FBandCount = 10);
end;
procedure TEqualizerControl.OnEQButtonClick(Sender: TObject);
begin
EQEnabled := not FEnabledEQ;
end;
procedure TEqualizerControl.OnBands3Click(Sender: TObject);
begin
BandCount := 3;
end;
procedure TEqualizerControl.OnBands10Click(Sender: TObject);
begin
BandCount := 10;
end;
procedure TEqualizerControl.Paint;
var
R, PR: TRect;
i, X, Y, PrevX, PrevY, N, ZeroY, AxisY, PreX, CurveL, CurveR: Integer;
GX, GY, LastFillY, FillBottom: Integer;
FreqMarks: array[0..9] of Double;
S: string;
G, F: Double;
begin
Canvas.Brush.Color := FClrBG;
Canvas.FillRect(ClientRect);
Canvas.Font.Name := Font.Name;
Canvas.Font.Size := 9;
Canvas.Brush.Style := bsClear;
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FClrTextDim;
Canvas.TextOut(126, 16, Format('Preamp %.1f dB', [FPreampGain]));
R := GraphRect;
PR := PreampRect;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FClrPanel;
Canvas.Pen.Color := FClrBorder;
Canvas.Rectangle(PR);
PreX := (PR.Left + PR.Right) div 2;
Canvas.Pen.Color := TColor($00424242);
Canvas.Pen.Width := 3;
Canvas.Line(PreX, PR.Top + 12, PreX, PR.Bottom - 22);
Canvas.Pen.Width := 1;
Y := GainToY(FPreampGain, PR);
Y := EnsureRange(Y, PR.Top + 12, PR.Bottom - 22);
Canvas.Brush.Color := TColor($00303030);
Canvas.Pen.Color := FClrAccent;
Canvas.Ellipse(PreX - 7, Y - 7, PreX + 8, Y + 8);
Canvas.Brush.Color := FClrAccent;
Canvas.Pen.Color := FClrAccent;
Canvas.Ellipse(PreX - 3, Y - 3, PreX + 4, Y + 4);
Canvas.Brush.Style := bsClear;
Canvas.Font.Size := 8;
Canvas.Font.Color := FClrTextDim;
Canvas.TextOut(PreX - Canvas.TextWidth('Pre') div 2, PR.Bottom - 16, 'Pre');
Canvas.Font.Size := 9;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FClrPanel;
Canvas.Pen.Color := FClrBorder;
Canvas.Rectangle(R);
FreqMarks[0] := 20; FreqMarks[1] := 50; FreqMarks[2] := 100;
FreqMarks[3] := 200; FreqMarks[4] := 500; FreqMarks[5] := 1000;
FreqMarks[6] := 2000; FreqMarks[7] := 5000; FreqMarks[8] := 10000;
FreqMarks[9] := 20000;
Canvas.Pen.Color := FClrGrid;
Canvas.Font.Size := 8;
for i := 0 to High(FreqMarks) do
begin
X := R.Left + Round(Ln(FreqMarks[i] / MIN_FREQ) / Ln(MAX_FREQ / MIN_FREQ) *
(R.Right - R.Left));
Canvas.Line(X, R.Top + 1, X, R.Bottom - 1);
end;
for i := -20 to 20 do
if (i mod 5) = 0 then
begin
Y := GainToY(i, R);
Canvas.Line(R.Left + 1, Y, R.Right - 1, Y);
Canvas.Brush.Style := bsClear;
Canvas.Font.Color := FClrTextDim;
if (i <> 0) and (Abs(i) <> 5) and (i >= -15) and (i <= 15) then
begin
if i > 0 then S := '+' + IntToStr(i) + 'dB'
else S := IntToStr(i) + 'dB';
Canvas.TextOut(R.Left + 4, Y - (Canvas.TextHeight(S) * 3 div 5), S);
end;
end;
ZeroY := GainToY(0, R);
Canvas.Pen.Color := FClrBorder;
Canvas.Line(R.Left + 1, ZeroY, R.Right - 1, ZeroY);
Canvas.Brush.Color := TColor($00304438);
Canvas.Pen.Color := TColor($00304438);
FillBottom := ZeroY;
LastFillY := ZeroY;
CurveL := R.Left + 2;
CurveR := R.Right - 2;
for GX := CurveL to CurveR do
begin
F := XToFreq(GX, R);
G := ResponseAtFreq(F);
GY := GainToY(EnsureRange(G, MIN_GAIN, MAX_GAIN), R);
if GX = R.Left then
LastFillY := GY
else
Canvas.Polygon([Point(GX - 1, LastFillY), Point(GX, GY),
Point(GX, FillBottom), Point(GX - 1, FillBottom)]);
LastFillY := GY;
end;
PrevX := CurveL;
PrevY := GainToY(EnsureRange(ResponseAtFreq(XToFreq(CurveL, R)), MIN_GAIN, MAX_GAIN), R);
Canvas.Pen.Color := FClrCurve;
Canvas.Pen.Width := 2;
for GX := CurveL + 1 to CurveR do
begin
F := XToFreq(GX, R);
GY := GainToY(EnsureRange(ResponseAtFreq(F), MIN_GAIN, MAX_GAIN), R);
Canvas.Line(PrevX, PrevY, GX, GY);
PrevX := GX;
PrevY := GY;
end;
Canvas.Pen.Width := 1;
N := FBandCount;
for i := 1 to N do
begin
X := BandX(i, R);
Y := GainToY(FGains[i], R);
Canvas.Brush.Color := BandColor(i);
Canvas.Pen.Color := FClrBG;
Canvas.Ellipse(X - 5, Y - 5, X + 6, Y + 6);
if i = FHover then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := clWhite;
Canvas.Ellipse(X - 9, Y - 9, X + 10, Y + 10);
Canvas.Brush.Style := bsSolid;
end;
end;
Canvas.Font.Color := FClrTextDim;
Canvas.Brush.Style := bsClear;
Canvas.Font.Size := 8;
AxisY := ZeroY + 4;
for i := 0 to High(FreqMarks) do
begin
X := R.Left + Round(Ln(FreqMarks[i] / MIN_FREQ) / Ln(MAX_FREQ / MIN_FREQ) *
(R.Right - R.Left));
S := FormatFreq(FreqMarks[i]);
if i = 0 then
Canvas.TextOut(X, AxisY, S)
else if i = High(FreqMarks) then
Canvas.TextOut(X - Canvas.TextWidth(S), AxisY, S)
else
Canvas.TextOut(X - Canvas.TextWidth(S) div 2, AxisY, S);
end;
Canvas.Font.Size := 9;
DrawTiles;
end;
procedure TEqualizerControl.Resize;
begin
inherited Resize;
LayoutButtons;
end;
procedure TEqualizerControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
H: Integer;
begin
inherited MouseDown(Button, Shift, X, Y);
if Button <> mbLeft then Exit;
H := HitTestControl(X, Y);
case H of
-1:
begin
FDragging := -1;
PreampGain := YToGain(Y, PreampRect);
end;
1..10:
begin
FDragging := H;
BandGain[H] := YToGain(Y, GraphRect);
BandFreq[H] := XToFreq(X, GraphRect);
end;
end;
end;
procedure TEqualizerControl.MouseMove(Shift: TShiftState; X, Y: Integer);
var
H: Integer;
begin
inherited MouseMove(Shift, X, Y);
if FDragging = -1 then
PreampGain := YToGain(Y, PreampRect)
else if FDragging > 0 then
begin
BandGain[FDragging] := YToGain(Y, GraphRect);
BandFreq[FDragging] := XToFreq(X, GraphRect);
end
else
begin
H := HitTestControl(X, Y);
if H < 0 then H := 0;
if FHover <> H then
begin
FHover := H;
Invalidate;
end;
end;
end;
procedure TEqualizerControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
FDragging := 0;
end;
procedure TEqualizerControl.MouseLeave;
begin
inherited MouseLeave;
FHover := 0;
Invalidate;
end;
function TEqualizerControl.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
var
H: Integer;
begin
H := HitTestControl(MousePos.X, MousePos.Y);
if H = -1 then PreampGain := FPreampGain + 0.5
else if H > 0 then BandGain[H] := FGains[H] + 0.5;
Result := H <> 0;
end;
function TEqualizerControl.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
var
H: Integer;
begin
H := HitTestControl(MousePos.X, MousePos.Y);
if H = -1 then PreampGain := FPreampGain - 0.5
else if H > 0 then BandGain[H] := FGains[H] - 0.5;
Result := H <> 0;
end;
end.