0
0

Hi

I did a small improvement on the “spectrum.pas” code that follows with FMOD v3.5

I hope that someone else can use it, or maybe improve it even further, and post it here in the forum. ๐Ÿ˜€

Its the spectrum from the original testbed example, which will grab 512 spectrum values, and display this. Looks more accurate, but eats a tiny bit more cpu. I added a copy of the original spectrum to do a peaktable, which is shown in the background of the original spectrum. Looks allrighty ๐Ÿ˜‰ Let me know what you think.

[img:1agoirsu]http://www.gif.com/ImageGallery/Animated/Miscellaneous/Drawing/firewrk3.gif[/img:1agoirsu]

Ideas or other stuff for spectrums are most welcome.

Replace all code in spectrum.pas with the following:
[code:1agoirsu]
unit spectrum;

interface

uses
Windows, Classes, Controls, Messages, Graphics;

Const
SpectrumFadeOut = 0.96; // Spectrum fade out speed

type
TSpectrumStyle = (ssSmooth, ssBlock);

TMiniSpectrum = class(TGraphicControl)
private
FGradient: TBitmap;
FGradient2: TBitmap;
FBuffer: TBitmap;
FScale: Single;
FStyle: TSpectrumStyle;
FValues: array [0..511] of Single;
PeakTable : array [0..511] of Single;
procedure SetStyle(const Value: TSpectrumStyle);
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 Scale: Single read FScale write FScale;
property Style: TSpectrumStyle read FStyle write SetStyle;
property OnClick;
end;

implementation

uses
FMOD;

{ TMiniSpectrum }

constructor TMiniSpectrum.Create(AOwner: TComponent);
var
X, Y: Integer;
R, G, B: Integer;
C: TColor;
begin
inherited;
Color := clBlack;
Width := 256;
Height := 128;
FScale := 4.0;
FStyle := ssSmooth;
Enabled := False;

// Create draw buffer
FBuffer := TBitmap.Create;
FBuffer.PixelFormat := pf32bit;
FBuffer.Width := Width;
FBuffer.Height := Height;

// Create gradient bitmap
FGradient := TBitmap.Create;
FGradient.PixelFormat := pf32bit;
FGradient.Width := 4;
FGradient.Height := 128;

FGradient2 := TBitmap.Create;
FGradient2.PixelFormat := pf32bit;
FGradient2.Width := 4;
FGradient2.Height := 128;

R := 255;
G := 0;
B := 0;

for Y := 0 to 127 do
begin
peaktable[y2]:=0;peaktable[1+y2]:=0;
if Y > 63 then
Dec(R, 2)
else
Inc(G, 6);
if R < 0 then
R := 0;
if G > 255 then
G := 255;
C := TColor(RGB(R, G, B));
for X := 0 to 2 do
FGradient.Canvas.Pixels[X, Y] := C;
FGradient.Canvas.Pixels[3, Y] := TColor(0);

// peak
b:=128;
C := TColor(RGB(round(R*0.5), round(G*0.5), round(B*0.5)));
for X := 0 to 2 do
  FGradient2.Canvas.Pixels[X, Y] := C;
FGradient2.Canvas.Pixels[3, Y] := TColor(0);

end;
end;

destructor TMiniSpectrum.Destroy;
begin
FGradient.Free;
FGradient2.Free;
FBuffer.Free;
inherited;
end;

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

procedure TMiniSpectrum.Draw;
var
Data: PSingleArray;
PeakData: Single;
W, X, Y: Integer;
ARect: TRect;
begin
FBuffer.Canvas.Brush.Color := Color;
FBuffer.Canvas.FillRect(BoundsRect);

if Enabled then
begin
Data := PSingleArray(FSOUND_DSP_GetSpectrum);

// Get the peak value of each block of four values
for X := 0 to 255 do
begin
  W := X * 1;
  FValues[X] := Data^[W];
    {
  if Data^[W + 1] &gt; FValues[X] then
    FValues[X] := Data^[W + 1];

  if Data^[W + 2] &gt; FValues[X] then
    FValues[X] := Data^[W + 2];
  if Data^[W + 3] &gt; FValues[X] then
    FValues[X] := Data^[W + 3];
                 }

  FValues[X] := FValues[X] * FScale;

  if FValues[X] &gt; 1.0 then
    FValues[X] := 1.0;
end;

W := Width;
if W &gt; 255 then
  W := 255;

case FStyle of
ssSmooth:
  begin
    X := 0;
    while X &lt; W do
    begin
      if FValues[X]&gt;peaktable[x] then peaktable[x]:=FValues[X] else
         peaktable[x]:=peaktable[x]*SpectrumFadeOut;

      if FValues[X] &gt; 0.0 then
      begin
        Y := Height - Trunc(Peaktable[X] * 1.0 * Height);
        FBuffer.Canvas.CopyRect(Rect(X, Y, X + 1, Height), FGradient2.Canvas, Rect(0, Y, 1, FGradient2.Height));

        Y := Height - Trunc(FValues[X] * 1.0 * Height);
        FBuffer.Canvas.CopyRect(Rect(X, Y, X + 1, Height), FGradient.Canvas, Rect(0, Y, 1, FGradient.Height));

      end;
      Inc(X);
    end;
  end;
ssBlock:
  begin
    // Sixteen values for every column
    PeakData := 0;
    X := 0;
    while X &lt; W do
    begin
      if PeakData &lt; FValues[X] then
        PeakData := FValues[X];
      if (X and 3 = 3) and (PeakData &gt; 0.0) then
      begin
        Y := Height - Trunc(PeakData * 1.0 * Height);
        PeakData := 0;
        FBuffer.Canvas.CopyRect(Rect(X, Y, X + 4, Height), FGradient.Canvas, Rect(0, Y, 4, FGradient.Height));
      end;
      Inc(X);
    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;

// Copy the buffer to the control
Canvas.Draw(0, 0, FBuffer);
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
inherited;
FSOUND_DSP_SetActive(FSOUND_DSP_GetFFTUnit, Value);
end;

procedure TMiniSpectrum.SetStyle(const Value: TSpectrumStyle);
begin
if FStyle <> Value then
begin
FStyle := Value;
ZeroMemory(@FValues, SizeOf(FValues));
end;
end;

end.
[/code:1agoirsu]

  • You must to post comments
0
0

When it comes time to update the distribution, I will add your changes into it.

  • You must to post comments
0
0

Well I use the spectrum but the problem is that it is extremelly slow! I call it the way it is called in the delphi testbed. An idea of what the problem might be?

  • You must to post comments
Showing 2 results
Your Answer

Please first to submit.