home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / Delphi / SampleVis / spectrum_vis.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2003-10-19  |  4.8 KB  |  132 lines
  1. unit spectrum_vis;
  2. { Spectrum Visualyzation by Alessandro Cappellozza
  3.   version 0.8 05/2002
  4.   http://digilander.iol.it/Kappe/audioobject
  5. }
  6.  
  7. interface
  8.   uses Windows, Dialogs, Graphics, SysUtils, CommonTypes, Classes;
  9.  
  10.  type TSpectrum = Class(TObject)
  11.     private
  12.       VisBuff : TBitmap;
  13.       BackBmp : TBitmap;
  14.  
  15.       BkgColor : TColor;
  16.       SpecHeight : Integer;
  17.       PenColor : TColor;
  18.       PeakColor: TColor;
  19.       DrawType : Integer;
  20.       DrawRes  : Integer;
  21.       FrmClear : Boolean;
  22.       UseBkg   : Boolean;
  23.       PeakFall : Integer;
  24.       LineFall : Integer;
  25.       ColWidth : Integer;
  26.       ShowPeak : Boolean;
  27.  
  28.        FFTPeacks  : array [0..128] of Integer;
  29.        FFTFallOff : array [0..128] of Integer;
  30.  
  31.     public
  32.      Constructor Create (Width, Height : Integer);
  33.      procedure Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
  34.      procedure SetBackGround (Active : Boolean; BkgCanvas : TGraphic);
  35.  
  36.      property BackColor : TColor read BkgColor write BkgColor;
  37.      property Height : Integer read SpecHeight write SpecHeight;
  38.      property Width  : Integer read ColWidth write ColWidth;
  39.      property Pen  : TColor read PenColor write PenColor;
  40.      property Peak : TColor read PeakColor write PeakColor;
  41.      property Mode : Integer read DrawType write DrawType;
  42.      property Res  : Integer read DrawRes write DrawRes;
  43.      property FrameClear : Boolean read FrmClear write FrmClear;
  44.      property PeakFallOff: Integer read PeakFall write PeakFall;
  45.      property LineFallOff: Integer read LineFall write LineFall;
  46.      property DrawPeak   : Boolean read ShowPeak write ShowPeak;
  47.   end;
  48.  
  49.  var Spectrum : TSpectrum;
  50.  
  51. implementation
  52.  
  53.      Constructor TSpectrum.Create(Width, Height : Integer);
  54.       begin
  55.         VisBuff := TBitmap.Create;
  56.         BackBmp := TBitmap.Create;
  57.  
  58.           VisBuff.Width := Width;
  59.           VisBuff.Height := Height;
  60.           BackBmp.Width := Width;
  61.           BackBmp.Height := Height;
  62.  
  63.           BkgColor := clBlack;
  64.           SpecHeight := 100;
  65.           PenColor := clWhite;
  66.           PeakColor := clYellow;
  67.           DrawType := 0;
  68.           DrawRes  := 1;
  69.           FrmClear := True;
  70.           UseBkg := False;
  71.           PeakFall := 1;
  72.           LineFall := 3;
  73.           ColWidth := 5;
  74.           ShowPeak := True; 
  75.       end;
  76.  
  77.      procedure TSpectrum.SetBackGround (Active : Boolean; BkgCanvas : TGraphic);
  78.       begin
  79.         UseBkg := Active;
  80.         BackBmp.Canvas.Draw(0, 0, BkgCanvas);
  81.       end;
  82.  
  83.      procedure TSpectrum.Draw(HWND : THandle; FFTData : TFFTData; X, Y : Integer);
  84.         var i, YPos : LongInt; YVal : Single;
  85.        begin
  86.  
  87.        if FrmClear then begin
  88.           VisBuff.Canvas.Pen.Color := BkgColor;
  89.           VisBuff.Canvas.Brush.Color := BkgColor;
  90.           VisBuff.Canvas.Rectangle(0, 0, VisBuff.Width, VisBuff.Height);
  91.            if UseBkg then VisBuff.Canvas.CopyRect(Rect(0, 0, BackBmp.Width, BackBmp.Height), BackBmp.Canvas, Rect(0, 0, BackBmp.Width, BackBmp.Height));
  92.        end;
  93.  
  94.         VisBuff.Canvas.Pen.Color := PenColor;
  95.          for i := 0 to 128 do begin
  96.            YVal := Abs(FFTData[(i * DrawRes) + 5]);
  97.            YPos := Trunc((YVal) * 500);
  98.            if YPos > Height then YPos := SpecHeight;
  99.  
  100.            if YPos >= FFTPeacks[i] then FFTPeacks[i] := YPos
  101.               else FFTPeacks[i] := FFTPeacks[i] - PeakFall;
  102.  
  103.            if YPos >= FFTFallOff[i] then FFTFallOff[i] := YPos
  104.               else FFTFallOff[i] := FFTFallOff[i] - LineFall;
  105.  
  106.               if (VisBuff.Height - FFTPeacks[i]) > VisBuff.Height then FFTPeacks[i] := 0;
  107.               if (VisBuff.Height - FFTFallOff[i]) > VisBuff.Height then FFTFallOff[i] := 0;
  108.  
  109.               case DrawType of
  110.                 0 : begin
  111.                        VisBuff.Canvas.MoveTo(X + i, Y + VisBuff.Height);
  112.                        VisBuff.Canvas.LineTo(X + i, Y + VisBuff.Height - FFTFallOff[i]);
  113.                        if ShowPeak then VisBuff.Canvas.Pixels[X + i, Y + VisBuff.Height - FFTPeacks[i]] := Pen;
  114.                     end;
  115.  
  116.                 1 : begin
  117.                      if ShowPeak then VisBuff.Canvas.Pen.Color := PeakColor;
  118.                      if ShowPeak then VisBuff.Canvas.MoveTo(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTPeacks[i]);
  119.                      if ShowPeak then VisBuff.Canvas.LineTo(X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height - FFTPeacks[i]);
  120.  
  121.                      VisBuff.Canvas.Pen.Color := PenColor;
  122.                      VisBuff.Canvas.Brush.Color := PenColor;
  123.                      VisBuff.Canvas.Rectangle(X + i * (ColWidth + 1), Y + VisBuff.Height - FFTFallOff[i], X + i * (ColWidth + 1) + ColWidth, Y + VisBuff.Height);
  124.                     end;
  125.               end;
  126.          end;
  127.  
  128.           BitBlt(HWND, 0, 0, VisBuff.Width, VisBuff.Height, VisBuff.Canvas.Handle, 0, 0, srccopy)
  129.        end;
  130. end.
  131.  
  132.