mmfxgen.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMFXGen;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Controls,
    Forms,
    MMSystem,
    MMObj,
    MMDSPObj,
    MMUtils,
    MMString,
    MMRegs,
    MMPCMSup,
    MMMulDiv;

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM TabLen} {$ENDIF}
    TabLen = 100000;                { precalc table length                 }

type
  EMMGeneratorError = class(Exception);
  TMMWaveForm       = (wfSine,wfSquare,wfTriangle,wfSawtoothPos,
                       wfSawtoothNeg,wfNoise);
  TMMModulation     = (moAM,moFM,moPM);

  {-- TMMGenerator ------------------------------------------------------}
  TMMGenerator = class(TMMDSPComponent)
  private
    FOpen        : Boolean;
    FEnabled     : Boolean;
    FSilence     : SmallInt;      { silence value 0 or 128               }
    FBits        : TMMBits;       { bit8 or bit16                        }
    FChannel     : TMMChannel;    { chBoth, chLeft or chRigth            }
    FMode        : TMMMode;       { mMono or mStereo                     }
    FSampleRate  : Longint;       { samplerate 8000..88200               }
    FBytesDone   : Longint;       { how many bytes created ?             }
    FWaveForm    : TMMWaveForm;   { type of waveform to generate         }
    FModulation  : TMMModulation; { Modulation: moAM,moFM,mpPM           }
    FFrequency   : Double;        { test frequency (1..44100.00)         }
    FAmplitude   : TMMVolumeRange;{ generator/modulator amplitude        }
    FDryAmplitude: TMMVolumeRange;{ mix of original data mixed to output }
    FWaveFormat  : TWaveFormatEx; { internal WaveFormatEx                }

    FTable       : PSmallArray;
    FOffset      : Double;        { internal table offset                }

    procedure SetWaveForm(aValue: TMMWaveForm);
    procedure SetModulation(aValue: TMMModulation);
    procedure SetFrequency(aValue: Double);
    procedure SetAmplitudes(index: integer; aValue: TMMVolumeRange);
    procedure SetSampleRate(Rate: Longint);
    procedure SetBits(aValue: TMMBits);
    procedure SetChannel(aValue: TMMChannel);
    procedure SetMode(aValue: TMMMode);
    procedure SetWaveParams;

    procedure FillWaveTable(Len: Longint);

  protected
    procedure ChangeDesigning(aValue: Boolean); override;
    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
    procedure Opened; override;
    procedure Started; override;
    procedure Closed; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

  public
    constructor Create(AOwner:TComponent); override;
    destructor  Destroy; override;

    procedure Open;
    procedure Start;
    procedure Stop;
    procedure Close;
    procedure GenerateData(Buffer: PChar; NumBytes: Cardinal);
    procedure ModulateDataAM(Buffer: PChar; NumBytes: Cardinal);
    procedure ModulateDataFM(Buffer: PChar; NumBytes: Cardinal);
    procedure ModulateDataPM(Buffer: PChar; NumBytes: Cardinal);

  published
    property Input;
    property Output;
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property SampleRate: Longint read FSampleRate write SetSampleRate default 11025;
    property BitLength: TMMBits read FBits write setBits default b8bit;
    property Channel: TMMChannel read FChannel write setChannel default chBoth;
    property Mode: TMMMode read FMode write SetMode default mMono;
    property WaveForm: TMMWaveForm read FWaveForm write SetWaveForm default wfSine;
    property Modulation: TMMModulation read FModulation write SetModulation default moAM;
    property Frequency: Double read FFrequency write SetFrequency;
    property Amplitude: TMMVolumeRange index 0 read FAmplitude write SetAmplitudes default 16384;
    property DryAmplitude: TMMVolumeRange index 1 read FDryAmplitude write SetAmplitudes default 0;
  end;

implementation

uses MMMath;

{-- Sine ----------------------------------------------------------------}
function Sine(t: Float): Float; Far;
begin
   Result := Sin(t);
end;

{-- Square ----------------------------------------------------------------}
function Square(t: Float): FLoat; Far;
begin
   { Compute values of t normalized to 2*pi }
   t := ModR(t,2*M_PI);
   { The actual square wave computation }
   Result := 2*ModR(ord(t>M_PI)+1,2)-1;
end;

{-- SawtoothPos -----------------------------------------------------------}
function SawtoothPos(t: Float): Float; Far;
begin
   Result := 2*(ModR(t,2*M_PI)/2/M_PI - 0.5);
end;

{-- SawtoothNeg -----------------------------------------------------------}
function SawtoothNeg(t: Float): Float; Far;
begin
   Result := 2*(1-ModR(t,2*M_PI)/2/M_PI - 0.5);
end;

{-- Triangle --------------------------------------------------------------}
function Triangle(t: Float): Float; Far;
var
   rt: Float;

begin
   rt := ModR(t+M_PI/2,2*M_PI)/2/M_PI;
   if (rt < 0.5) then Result := 4*(rt-0.25)
   else Result := 4*(-rt+0.75);
end;

{-- Noise ----------------------------------------------------------------}
function Noise(t: Float): Float; Far;
begin
   Result := 2*(Random-0.5);
end;

{-- VCO ------------------------------------------------------------------}
function vco(x: Float; Fc, Fs: Longint; t: Float): FLoat;
var
   kf: Float;

begin
   kf := (Fc/Fs)*2*M_PI;
   Result := cos(2*M_PI*Fc*t + kf*x);
end;

{== TMMGenerator =========================================================}
constructor TMMGenerator.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FTable := nil;
   FEnabled := True;
   FSampleRate := 11025;
   FBits := b8Bit;
   FChannel := chBoth;
   FMode := mMono;
   FWaveForm:= wfSine;
   FModulation := moAM;
   FFrequency := 1000.0;
   FAmplitude := 16384;
   FDryAmplitude := 0;
   FBytesDone := 0;
   FSilence := 128;
   FOpen := False;
   Randomize;
   SetWaveParams;

   if not (csDesigning in ComponentState) then
   begin
      FTable := GlobalAllocMem(TabLen*sizeOf(Smallint));
   end;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMGenerator --------------------------------------------------------}
destructor TMMGenerator.Destroy;
begin
   GlobalFreeMem(Pointer(FTable));

   inherited Destroy;
end;

{-- TMMGenerator --------------------------------------------------------}
procedure TMMGenerator.ChangeDesigning(aValue: Boolean);
begin
   inherited ChangeDesigning(aValue);

   if not (csDesigning in ComponentState) then
   begin
      FTable := GlobalAllocMem(TabLen*sizeOf(Smallint));
   end;
end;

{-- TMMGenerator --------------------------------------------------------}
procedure TMMGenerator.FillWaveTable(Len: Longint);
var
   i: Longint;
   amp: integer;
   pt: PSmallint;

begin
   { TODO: Wenn Table > 140k dann laufen die Multiplikationen 黚er }
   { TODO: Table Gr鰏se als power of 2 und mit AND wrappen         }
   if not FOpen then exit;

   if FBits = b8Bit then
      amp := 127
   else
      amp := 32767;

   pt := PSmallint(FTable);

   case FWaveForm of
     wfSine:
     for i := 0 to Len-1 do
     begin
        pt^ := Round(amp*sin(i*2*M_PI/Len));
        incHuge(pt,sizeOf(pt^));
     end;
     wfSquare:
     for i := 0 to Len-1 do
     begin
        if i > Len div 2 then
           pt^ := amp
        else
           pt^ := -amp;
        incHuge(pt,sizeOf(pt^));
     end;
     wfTriangle:
     for i := 0 to Len-1 do
     begin
        if i <= Len div 4 then
           pt^ := i*amp div (Len div 4)
        else if i > 3*(Len div 4) then
           pt^ := (i-3*(Len div 4))*amp div (Len div 4) - amp
        else
           pt^ := (Len div 2-i)*amp div (Len div 4);
        incHuge(pt,sizeOf(pt^));
     end;
     wfSawtoothPos:
     for i := 0 to Len-1 do
     begin
        if i <= Len div 2 then
           pt^ := (i*amp) div (Len div 2)
        else
           pt^ := (i-Len div 2)*amp div (Len div 2) - amp;
        incHuge(pt,sizeOf(pt^));
     end;
     wfSawtoothNeg:
     for i := 0 to Len-1 do
     begin
        if i <= Len div 2 then
           pt^ := -(i*amp) div (Len div 2)
        else
           pt^ := -((i-Len div 2)*amp div (Len div 2) - amp);
        incHuge(pt,sizeOf(pt^));
     end;
     wfNoise:
     for i := 0 to Len-1 do
     begin
        pt^ := Random(2*amp)-amp;
        incHuge(pt,sizeOf(pt^));
     end;
   end;
end;

{-- TMMGenerator --------------------------------------------------------}
Procedure TMMGenerator.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMGeneratorError.Create(LoadResStr(IDS_INVALIDFORMAT));

      SampleRate := aValue^.nSamplesPerSec;
      BitLength := TMMBits(aValue^.wBitsPerSample div 8 - 1);
      Mode := TMMMode(aValue^.nChannels-1);

      FillWaveTable(TabLen);
   end;

   inherited SetPWaveFormat(aValue);
end;

{-- TMMGenerator --------------------------------------------------------}
procedure TMMGenerator.SetWaveParams;
begin
   pcmBuildWaveHeader(@FWaveFormat,(Ord(FBits)+1)*8,Ord(FMode)+1,FSampleRate);
   PWaveFormat := @FWaveFormat;
end;

{-- TMMGenerator --------------------------------------------------------}
Procedure TMMGenerator.SetSampleRate(Rate: Longint);
begin
     if (Rate <> SampleRate) then
     begin
        FSampleRate := MinMax(Rate,8000,88200);
        SetWaveParams;
     end;
end;

{-- TMMGenerator --------------------------------------------------------}
Procedure TMMGenerator.SetBits(aValue: TMMBits);
begin
   if (aValue <> FBits) then
   begin
      FBits := aValue;
      if (FBits = b8Bit) then
          FSilence := 128
      else
          FSilence := 0;
      SetWaveParams;
   end;
end;

{-- TMMGenerator --------------------------------------------------------}
Procedure TMMGenerator.SetChannel(aValue: TMMChannel);
begin
   if (aValue <> FChannel) then
   begin
      FChannel := aValue;
   end;
end;

{-- TMMGenerator --------------------------------------------------------}
Procedure TMMGenerator.SetMode(aValue: TMMMode);
begin
   if (aValue <> FMode) and (aValue in [mMono,mStereo]) then
   begin
      FMode := aValue;
      SetWaveParams;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMGenerator --------------------------------------------------------}
procedure TMMGenerator.SetWaveForm(aValue: TMMWaveForm);
begin
   if (aValue <> FWaveForm) then
   begin