0
0

I made several changes in the spectrum.pas file. ๐Ÿ˜ฎ

This new file shows the spectrum in 4 different ways:

  • ssPeak – Plot only the peak value
  • ssPeak2 – Plot only the peak value (decreasing from last value)
  • ssBlock – Sixteen values (leds) for every frequency (18 for default)
  • ssBlockP – ssBlock + ssPeak2

There are 16 colors, one for each led, indicating the instantaneous value of sound (in the file, in gradient, but can be easily modified ๐Ÿ˜€ ).

I think there are not bugs in the code, but I’m not perfect :wink:. Thus, if you find bugs, or make improvements in the code, please put the code here…

I didnt test this code in version 3.6, but I think this OK.

The code:

[code:1qq5tdhu]
unit spectrum;

interface

uses
Windows, Classes, Controls, Messages, Graphics;

type
TSpectrumStyle = (ssSmooth, ssBlock, ssBlockP, ssPeak, ssPeak2);
TMiniSpectrum = class(TGraphicControl)
private
FBuffer: TBitmap;
FDisplayLeds: TBitmap;
FScale: Single;
FStyle: TSpectrumStyle;
CurrValue: array[0..511] of Single;
PeakValue: array[0..511] of Integer;
LastValue: array[0..511] of Integer;
NumValues: Integer;
OffSetY: Integer;
ColValues: array[0..20] of TColor;
FEnabled: Boolean;
NumFreq: Integer;
BlockFreq: Single;
LedHeight: Integer;
LedWidth: Integer;
procedure SetStyle(const Value: TSpectrumStyle);
procedure SetScale(const Value: Single);
protected
procedure Paint; override;
procedure Resize; { override;}
procedure SetEnabled(Value: Boolean); { override;}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw;
published
property Align;
property Enabled: Boolean read FEnabled write SetEnabled;
property Scale: Single read FScale write SetScale;
property Style: TSpectrumStyle read FStyle write SetStyle;
property OnClick;
end;

implementation

uses
FMOD;

{ TMiniSpectrum }

constructor TMiniSpectrum.Create(AOwner: TComponent);
var
Y, R, G, B: Integer;
begin
inherited;
Color := clBlack;
Width := 199;
Height := 49;

FScale := 4.0;

FStyle := ssSmooth;
FEnabled := False;

NumValues := 16;
NumFreq := 18;
BlockFreq := 128 / NumFreq;
LedHeight := Trunc((Height – 1) / NumValues) – 1;
LedWidth := Trunc((Width – 1) / NumFreq) – 1;
FDisplayLeds := TBitmap.Create;
FDisplayLeds.PixelFormat := pf32bit;
FDisplayLeds.Width := LedWidth;
FDisplayLeds.Height := 1 + (LedHeight + 1) * NumValues;
OffSetY := Height – FDisplayLeds.Height;

R := 255;
G := 0;
B := 0;
FDisplayLeds.Canvas.Brush.Color := Color;
FDisplayLeds.Canvas.FillRect(BoundsRect);
for Y := 0 to NumValues – 1 do begin
if Y > NumValues / 2 then Dec(R, Trunc(256 / NumValues))
else Inc(G, Trunc(768 / NumValues));
if R < 0 then R := 0;
if G > 255 then G := 255;
ColValues[Y] := TColor(RGB(R, G, B));
FDisplayLeds.Canvas.Brush.Color := ColValues[Y];
FDisplayLeds.Canvas.FillRect(Rect(0, 1 + Y * (1 + LedHeight), LedWidth, 1 + Y * (1 + LedHeight) + LedHeight));
end;

for Y := 0 to 511 do begin
LastValue[Y] := 0;
CurrValue[Y] := 0;
PeakValue[Y] := 0;
end;

ZeroMemory(@CurrValue, SizeOf(CurrValue));
ZeroMemory(@PeakValue, SizeOf(PeakValue));
ZeroMemory(@LastValue, SizeOf(LastValue));

FBuffer := TBitmap.Create;
FBuffer.PixelFormat := pf32bit;
FBuffer.Width := Width;
FBuffer.Height := Height;
end;

destructor TMiniSpectrum.Destroy;
begin
FBuffer.Free;
FDisplayLeds.Free;
inherited;
end;

type
PSingleArray = ^TSingleArray;
TSingleArray = array[0..511] of Single;

procedure TMiniSpectrum.Draw;
var
Data: PSingleArray;
PeakData: Single;
W, Wa, X, Y, Ya, Yb: Integer;
ARect: TRect;
begin
if Enabled then begin
Data := PSingleArray(FSOUND_DSP_GetSpectrum);

for X := 0 to (NumFreq - 1) do begin
  CurrValue[X] := 0;
  Wa := NumValues - 1;
  Ya := Trunc(X * BlockFreq);
  for W := 0 to Trunc(BlockFreq) do begin
    if Data^[W + Ya] &gt; CurrValue[X] then CurrValue[X] := Data^[W + Ya];
  end;
  CurrValue[X] := Wa * CurrValue[X] * Scale; // peak between 0 and 15
  if CurrValue[X] &gt; Wa then CurrValue[X] := Wa;
  Ya := Wa - Trunc(CurrValue[X]);

  case Style of
    ssPeak: begin // Plot only the peak value
        if Ya &lt;&gt; LastValue[x] then begin
          Y := LastValue[X];
          LastValue[x] := Ya;
          FBuffer.Canvas.Brush.Color := Color;
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Y * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Y * (1 + LedHeight) + LedHeight + OffSetY));
          FBuffer.Canvas.Brush.Color := ColValues[Ya];
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Ya * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Ya * (1 + LedHeight) + LedHeight + OffSetY));
        end;
      end;
    ssPeak2: begin // Plot only the peak value (decreasing)
        if Ya &lt;&gt; PeakValue[x] then begin
          Y := PeakValue[X];
          if Ya &lt; PeakValue[x] then PeakValue[x] := Ya
          else PeakValue[x] := PeakValue[x] + 1;
          Ya := PeakValue[X];
          FBuffer.Canvas.Brush.Color := Color;
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Y * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Y * (1 + LedHeight) + LedHeight + OffSetY));
          FBuffer.Canvas.Brush.Color := ColValues[Ya];
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Ya * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Ya * (1 + LedHeight) + LedHeight + OffSetY));
        end;
      end;
    ssBlock: begin // Sixteen values for every column
        Yb := 1 + Ya * (1 + LedHeight);
        if Yb &lt;&gt; LastValue[x] then begin
          Y := LastValue[X];
          LastValue[x] := Yb;
          FBuffer.Canvas.Brush.Color := Color;
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), Y, 1 + X * (1 + LedWidth) + LedWidth, Height));
          FBuffer.Canvas.CopyRect(Rect(1 + X * (1 + LedWidth), Yb + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, OffSetY + FDisplayLeds.Height), FDisplayLeds.Canvas, Rect(0, Yb, LedWidth, FDisplayLeds.Height));
        end;
      end;
    ssBlockP: begin // Sixteen values for every column
        Yb := 1 + Ya * (1 + LedHeight);
        if Yb &lt;&gt; LastValue[x] then begin
          Y := LastValue[X];
          LastValue[x] := Yb;
          FBuffer.Canvas.Brush.Color := Color;
          FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), Y, 1 + X * (1 + LedWidth) + LedWidth, Height));
          FBuffer.Canvas.CopyRect(Rect(1 + X * (1 + LedWidth), Yb + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, OffSetY + FDisplayLeds.Height), FDisplayLeds.Canvas, Rect(0, Yb, LedWidth, FDisplayLeds.Height));
        end;
        if Ya &lt;&gt; PeakValue[x] then begin
          Y := PeakValue[X];
          if Ya &lt; PeakValue[x] then begin
            PeakValue[x] := Ya;
          end else begin
            PeakValue[x] := PeakValue[x] + 1;
            Ya := PeakValue[X];
            FBuffer.Canvas.Brush.Color := Color;
            FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Y * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Y * (1 + LedHeight) + LedHeight + OffSetY));
            FBuffer.Canvas.Brush.Color := ColValues[Ya];
            FBuffer.Canvas.FillRect(Rect(1 + X * (1 + LedWidth), 1 + Ya * (1 + LedHeight) + OffSetY, 1 + X * (1 + LedWidth) + LedWidth, 1 + Ya * (1 + LedHeight) + LedHeight + OffSetY));
          end;
        end;
      end;
  end;
end;

end else begin
FBuffer.Canvas.Font.Color := clWhite;
ARect := BoundsRect;
DrawText(FBuffer.Canvas.Handle, ‘Click for Spectrum’, -1, ARect, DT_WORDBREAK or DT_NOPREFIX or DT_VCENTER or DT_CENTER);
end;
Canvas.Draw(0, 0, FBuffer); // Copy the buffer to the control
end;

procedure TMiniSpectrum.Paint;
begin
Draw;
end;

procedure TMiniSpectrum.Resize;
begin
inherited;
if Assigned(FBuffer) then begin
FBuffer.Width := Width;
FBuffer.Height := Height;
end;
end;

procedure TMiniSpectrum.SetEnabled(Value: Boolean);
begin
if FEnabled <> Value then begin
FEnabled := Value;
inherited;
FSOUND_DSP_SetActive(FSOUND_DSP_GetFFTUnit, Value);
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height));
Canvas.Draw(0, 0, FBuffer);
end;
end;

procedure TMiniSpectrum.SetStyle(const Value: TSpectrumStyle);
begin
if FStyle <> Value then begin
FStyle := Value;
ZeroMemory(@CurrValue, SizeOf(CurrValue));
ZeroMemory(@PeakValue, SizeOf(PeakValue));
ZeroMemory(@LastValue, SizeOf(LastValue));
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(Rect(0, 0, Width, Height));
Canvas.Draw(0, 0, FBuffer);
end;
end;

procedure TMiniSpectrum.SetScale(const Value: Single);
begin
if FScale <> Value then begin
FScale := Value;
end;
end;

end.

[/code:1qq5tdhu]

sorry for English mistakes…. ๐Ÿ˜‰

cmstein

  • You must to post comments
0
0

[quote="Jordi":28jjndko]Wow!!!!!!!

Really GREAT!!!

Congratulations!!!!!![/quote:28jjndko]

  • You must to post comments
0
0

Looks very cool.

  • You must to post comments
0
0

[quote="Sly":120o782y]Looks very cool.[/quote:120o782y]

Thanks ๐Ÿ˜‰

Some obs:

NumValues := 16; // Number of leds
NumFreq := 18; // Number of group of leds (frequencies shown)

BlockFreq := 128 / NumFreq; // only 128 of 512 – this can be setted with
// other value…

comments and sugestions are welcome…
and other peaces of codes also are welcome ๐Ÿ˜‰

cmstein

  • You must to post comments
0
0

[quote="cmstein":y9spuexz]comments and sugestions are welcome…
and other peaces of codes also are welcome ๐Ÿ˜‰
cmstein[/quote:y9spuexz]

No suggestion for improvements? :(

  • You must to post comments
0
0

Wow!!!!!!!

Really GREAT!!!

Congratulations!!!!!!

  • You must to post comments
0
0

Great work,

But can it be improved so that it is not dependant on the volume?
(The spectrum bars increases when I increase the volume).

Thanks

  • You must to post comments
0
0

[quote="Anonymous":3lbchejp]
(The spectrum bars increases when I increase the volume).
[/quote:3lbchejp]

This happens because the data passing through the FFT engine will decrease or increase depending on the volume, if there is no volume than how can any data pass through the FFT engine?? That is why it decreases.

  • You must to post comments
0
0

๐Ÿ˜€ Great, great work. Congratulation!!

  • You must to post comments
0
0

I have also made an alteration that uses OpenGL, but I don’t have the code with me right now. ๐Ÿ˜ฅ

  • You must to post comments
Showing 9 results
Your Answer

Please first to submit.