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.