src/editor/spectrum.pas

   1 unit spectrum;
   2
   3 {$MODE Delphi}
   4
   5 interface
   6
   7 uses
   8   LCLIntf, LCLType, LMessages, Classes, Controls, Graphics,
   9   fmod, fmodtypes;
  10
  11 const
  12   N_SPECTRUM_VALUES = 512;
  13
  14 type
  15   TSpectrumStyle = (ssSmooth, ssBlock);
  16
  17   TMiniSpectrum = class (TGraphicControl)
  18   private
  19     FGradient: TBitmap;
  20     FBuffer: TBitmap;
  21     FScale: Single;
  22     FStyle: TSpectrumStyle;
  23     FValues: array [0..N_SPECTRUM_VALUES-1] of Single;
  24     FGradientCount: Word;
  25     FChannel: FMOD_CHANNEL;
  26     FRawData: System.PSingle;
  27
  28     procedure SetStyle(const Value: TSpectrumStyle);
  29
  30   protected
  31     procedure Paint(); override;
  32     procedure Resize(); override;
  33     procedure SetEnabled(Value: Boolean); override;
  34
  35   public
  36     constructor Create(AOwner: TComponent); override;
  37     destructor Destroy; override;
  38     procedure Draw();
  39     procedure SetChannel(ch: FMOD_CHANNEL);
  40
  41   published
  42     property Align;
  43     property Scale: Single read FScale write FScale;
  44     property Style: TSpectrumStyle read FStyle write SetStyle;
  45     property OnClick;
  46   end;
  47
  48 implementation
  49
  50 uses
  51   BinEditor, g_language;
  52
  53 { TMiniSpectrum }
  54
  55 constructor TMiniSpectrum.Create(AOwner: TComponent);
  56 var
  57   X, Y: Integer;
  58   R, G, B: Integer;
  59   C: TColor;
  60
  61 begin
  62   inherited;
  63
  64   Color := clBlack;
  65   Parent := AOwner as TWinControl;
  66   Width := Parent.Width;
  67   Height := Parent.Height;
  68   FScale := 64.0;
  69   FStyle := ssSmooth;
  70   Enabled := False;
  71   FChannel := nil;
  72   GetMem(FRawData, N_SPECTRUM_VALUES * SizeOf(Single));
  73
  74 // Create draw buffer:
  75   FBuffer := TBitmap.Create();
  76   FBuffer.PixelFormat := pf32bit;
  77   FBuffer.Width := Width;
  78   FBuffer.Height := Height;
  79
  80 // Create gradient bitmap:
  81   FGradientCount := 40;
  82   FGradient := TBitmap.Create();
  83   FGradient.PixelFormat := pf32bit;
  84   FGradient.Width := Width div FGradientCount;
  85   FGradient.Height := Height;
  86
  87   R := 255;
  88   G := 0;
  89   B := 0;
  90
  91   for Y := 0 to Height-1 do
  92   begin
  93     if Y > (Height div 2)-1 then
  94       Dec(R, 16)
  95     else
  96       Inc(G, 16);
  97     if R < 0 then
  98       R := 0;
  99     if G > 255 then
 100       G := 255;
 101     C := TColor(RGB(R, G, B));
 102     for X := 0 to Width-2 do
 103       FGradient.Canvas.Pixels[X, Y] := C;
 104     FGradient.Canvas.Pixels[Width-1, Y] := TColor(0);
 105   end;
 106 end;
 107
 108 destructor TMiniSpectrum.Destroy;
 109 begin
 110   FreeMem(FRawData);
 111   FGradient.Free;
 112   FBuffer.Free;
 113
 114   inherited;
 115 end;
 116
 117 type
 118   PSingleArray = ^TSingleArray;
 119   TSingleArray = array [0..0] of Single;
 120
 121 procedure TMiniSpectrum.Draw();
 122 var
 123   Data: PSingleArray;
 124   PeakData: Single;
 125   X, Y, a, nGC: Integer;
 126   ARect: TRect;
 127   res: FMOD_RESULT;
 128
 129 begin
 130 {$R-}
 131   FBuffer.Canvas.Brush.Color := Color;
 132   FBuffer.Canvas.FillRect(BoundsRect);
 133
 134   if Enabled then
 135     begin
 136       if FChannel <> nil then
 137         begin
 138           res := FMOD_Channel_GetSpectrum(FChannel, FRawData,
 139                    N_SPECTRUM_VALUES, 0, FMOD_DSP_FFT_WINDOW_MAX);
 140           if res <> FMOD_OK then
 141             begin
 142               ZeroMemory(@FValues, SizeOf(FValues));
 143             end
 144           else
 145             begin
 146               Data := PSingleArray(FRawData);
 147               for X := 0 to High(FValues) do
 148               begin
 149                 FValues[X] := Data^[X] * FScale;
 150                 if FValues[X] > 1.0 then
 151                   FValues[X] := 1.0;
 152               end;
 153             end;
 154         end
 155       else
 156         begin
 157           ZeroMemory(@FValues, SizeOf(FValues));
 158         end;
 159
 160       case FStyle of
 161         ssSmooth,
 162         ssBlock:
 163           begin
 164             PeakData := 0.0;
 165             nGC := N_SPECTRUM_VALUES div FGradientCount;
 166
 167             for X := 0 to FGradientCount do
 168             begin
 169               for a := X*nGC to (X+1)*nGC-1 do
 170                 if PeakData < FValues[a] then
 171                   PeakData := FValues[a];
 172
 173               if PeakData > 0.0 then
 174               begin
 175                 Y := Height - Trunc(PeakData*Height);
 176                 PeakData := 0;
 177                 FBuffer.Canvas.CopyRect(Rect(X*FGradient.Width+1, Y, (X+1)*FGradient.Width, Height),
 178                                  FGradient.Canvas, Rect(0, Y, FGradient.Width, FGradient.Height));
 179               end;
 180             end;
 181           end;
 182       end;
 183     end
 184   else // if Enabled ...
 185     begin
 186       FBuffer.Canvas.Font.Color := clWhite;
 187       ARect := BoundsRect;
 188       DrawText(FBuffer.Canvas.Handle, PChar(_lc[I_LAB_SPECTRUM]), -1, ARect,
 189                DT_WORDBREAK or DT_NOPREFIX or DT_VCENTER or DT_CENTER);
 190     end;
 191
 192   Canvas.Draw(0, 0, FBuffer);
 193 {$R+}
 194 end;
 195
 196 procedure TMiniSpectrum.SetChannel(ch: FMOD_CHANNEL);
 197 begin
 198   FChannel := ch;
 199 end;
 200
 201 procedure TMiniSpectrum.Paint;
 202 begin
 203   Draw();
 204 end;
 205
 206 procedure TMiniSpectrum.Resize;
 207 begin
 208   inherited;
 209
 210   if Assigned(FBuffer) then
 211   begin
 212     FBuffer.Width := Width;
 213     FBuffer.Height := Height;
 214   end;
 215 end;
 216
 217 procedure TMiniSpectrum.SetEnabled(Value: Boolean);
 218 begin
 219   inherited;
 220
 221   //FSOUND_DSP_SetActive(FSOUND_DSP_GetFFTUnit, Value);
 222 end;
 223
 224 procedure TMiniSpectrum.SetStyle(const Value: TSpectrumStyle);
 225 begin
 226   if FStyle <> Value then
 227   begin
 228     FStyle := Value;
 229     ZeroMemory(@FValues, SizeOf(FValues));
 230   end;
 231 end;
 232
 233 end.