mmwrec.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [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: 10.09.98 - 15:54:27 $                                        =}
{========================================================================}
unit MMWRec;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
  Windows,
{$ELSE}
  WinTypes,
  WinProcs,
{$ENDIF}
  SysUtils,
  Classes,
  Controls,
  Dialogs,
  MMSystem,
  MMRegs,
  MMObj,
  MMDSPobj,
  MMUtils,
  MMWave,
  MMWavIn,
  MMWaveIO,
  MMPCMSup,
  MMACMDlg;

type
    EMMWaveRecorderError = class(Exception);

    {-- TMMWaveRecorer --------------------------------------------------------}
    TMMWaveRecorder = class(TMMDSPComponent)
    private
       FChanging   : Boolean;
       FStartPos   : Longint;
       FOnStart    : TNotifyEvent;
       FOnStop     : TNotifyEvent;
       FOnPause    : TNotifyEvent;
       FOnRestart  : TNotifyEvent;
       FOnChange   : TNotifyEvent;
       FOnData     : TMMBufferEvent;

       procedure SetWave(aValue: TMMWave);
       function  GetWave: TMMWave;
       procedure SetNumBuffers(aValue: integer);
       function  GetNumBuffers: integer;
       procedure SetDeviceID(aValue: TMMDeviceID);
       function  GetDeviceID: TMMDeviceID;
       procedure SetDummyString(aValue: string);
       function  GetProductName: string;
       function  GetInputFormat: string;
       procedure SetInputFormat(aValue: string);
       procedure SetTimeFormat(aValue: TMMTimeFormats);
       function  GetTimeFormat: TMMTimeFormats;
       procedure SetCallBackMode(aValue: TMMCBMode);
       function  GetCallBackMode: TMMCBMode;
       procedure SetPosition(aValue: Longint);
       function  GetPosition: Longint;
       procedure SetMaxRecTime(aValue: Longint);
       function  GetMaxRecTime: Longint;

       procedure SetMode(aValue: TMMMode);
       function  GetMode: TMMMode;
       procedure SetBits(aValue: TMMBits);
       function  GetBits: TMMBits;
       procedure SetRate(aValue: Longint);
       function  GetRate: Longint;

       procedure SetFileName(aValue: TFileName);
       function  GetFileName: TFileName;

       procedure SetOverwrite(aValue: Boolean);
       function  GetOverwrite: Boolean;

       function  GetState: TMMWaveInState;

       procedure DoChange(Sender: TObject);
       procedure DoChanged(Sender: TObject);
       procedure DoClose(Sender: TObject);
       procedure DoStart(Sender: TObject);
       procedure DoStop(Sender: TObject);
       procedure DoPause(Sender: TObject);
       procedure DoRestart(Sender: TObject);
       procedure DoData(Sender: TObject; lpwh: PWaveHdr);

    protected
       FWaveIn   : TMMWaveIn;
       FWaveFile : TMMWaveFile;
       procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
       function  GetBufferSize: Longint; override;
       procedure SetBufferSize(aValue: Longint); override;
       procedure DefineProperties(Filer: TFiler); override;
       procedure ReadData(Stream: TStream); virtual;
       procedure WriteData(Stream: TStream); virtual;

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

       procedure Recording;
       procedure Stop;
       procedure Pause;
       procedure Restart;

       function  SelectFile: Boolean;
       function  SelectFormat: Boolean;
       procedure SetPCMFormat(Mode: TMMMode; Bits: TMMBits; SampleRate: Longint);

       procedure SaveFormatInRegistry(RootKey: HKEY; Localkey, Field: string);
       procedure LoadFormatFromRegistry(RootKey: HKEY; Localkey, Field: string);

       property  FileName: TFileName read GetFileName write SetFileName stored False;
       property  PWaveFormat;
       property  State: TMMWaveInState read GetState;
       property  Position: Longint read GetPosition write SetPosition;

    published
       property OnStart: TNotifyEvent read FOnStart write FOnStart;
       property OnStop: TNotifyEvent read FOnStop write FOnStop;
       property OnPause: TNotifyEvent read FOnPause write FOnPause;
       property OnRestart: TNotifyEvent read FOnRestart write FOnRestart;
       property OnChange: TNotifyEvent read FOnChange write FOnChange;
       property OnData: TMMBufferEvent read FOnData write FOnData;

       property Output;
       property Wave: TMMWave read GetWave write SetWave;
       property BufferSize: Longint read GetBufferSize write SetBufferSize;
       property NumBuffers: integer read GetNumBuffers write SetNumBuffers;
       property DeviceID: TMMDeviceID read GetDeviceID write SetDeviceID;
       property ProductName: string read GetProductName write SetDummyString stored False;
       property TimeFormat: TMMTimeFormats read GetTimeFormat write SetTimeFormat;
       property CallBackMode: TMMCBMode read GetCallBackMode write SetCallBackMode;
       property MaxRecordTime: Longint read GetMaxRecTime write SetMaxRecTime;
       property Mode: TMMMode read GetMode write SetMode;
       property BitLength: TMMBits read GetBits write SetBits;
       property SampleRate: Longint read GetRate write SetRate;
       property InputFormat: string read GetInputFormat write SetInputFormat stored False;
       property OverwriteExisting: Boolean read GetOverwrite write SetOverwrite;
    end;


implementation

{== MMWaveRecorder ============================================================}
constructor TMMWaveRecorder.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FWaveFile             := TMMWaveFile.Create(Self);
   FWaveFile.Wave.FileMustExist := False;
   FWaveFile.OnChange    := DoChange;
   FWaveFile.OnChanged   := DoChanged;
   FWaveFile.OnClose     := DoClose;

   FWaveIn               := TMMWaveIn.Create(Self);
   FWaveIn.Output        := FWaveFile;
   FWaveIn.OnOpen        := DoStart;
   FWaveIn.OnStop        := DoStop;
   FWaveIn.OnPause       := DoPause;
   FWaveIn.OnRestart     := DoRestart;
   FWaveIn.OnBufferReady := DoData;

   FStartPos             := 0;

   FInputValid           := True;
   FWaveFile.Output      := Self;
   FInputValid           := False;
   FChanging             := False;

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

{-- TMMWaveRecorder -----------------------------------------------------------}
destructor TMMWaveRecorder.Destroy;
begin
   Stop;

   FWaveFile.Free;
   FWaveIn.Free;

   inherited Destroy;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.ReadData(Stream: TStream);
var
   Buf: PChar;
begin
   Buf := GlobalAllocMem(Stream.Size);
   try
      Stream.ReadBuffer(Buf^,Stream.Size);
      FWaveIn.PWaveFormat := Pointer(Buf);
   finally
      GlobalFreeMem(Pointer(Buf));
   end;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.WriteData(Stream: TStream);
begin
   Stream.WriteBuffer(FWaveIn.PWaveFormat^,wioSizeOfWaveFormat(FWaveIn.PWaveFormat));
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.DefineProperties(Filer: TFiler);
begin
   inherited DefineProperties(Filer);
   Filer.DefineBinaryProperty('WaveFormatEx', ReadData, WriteData, (PWaveFormat <> nil) and (PWaveFormat.wFormatTag <> WAVE_FORMAT_PCM));
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.SetPWaveFormat(aValue: PWaveFormatEx);
var
   Size,Size2: integer;
begin
   if not FChanging then
   begin
      if (aValue <> nil) then
      begin
         if (FWaveIn.PWaveFormat <> nil) then
         begin
            size := wioSizeOfWaveFormat(aValue);
            size2:= wioSizeOfWaveFormat(FWaveIn.PWaveFormat);
            if (Size <> Size2) or not GlobalCmpMem(aValue^,FWaveIn.PWaveFormat^,Size) then
            begin
               FWaveIn.PWaveFormat := aValue;
               exit;
            end;
         end
         else
         begin
            FWaveIn.PWaveFormat := aValue;
            exit;
         end;
      end;

      inherited SetPWaveFormat(aValue);
   end;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.SetMode(aValue: TMMMode);
begin
   FWaveIn.Mode := aValue;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
function TMMWaveRecorder.GetMode: TMMMode;
begin
   Result := FWaveIn.Mode;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.SetBits(aValue: TMMBits);
begin
   FWaveIn.BitLength := aValue;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
function TMMWaveRecorder.GetBits: TMMBits;
begin
   Result := FWaveIn.BitLength;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.SetRate(aValue: Longint);
begin
   FWaveIn.SampleRate:= aValue;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
function TMMWaveRecorder.GetRate: Longint;
begin
   Result := FWaveIn.SampleRate;
end;

{-- TMMWaveRecorder -----------------------------------------------------------}
procedure TMMWaveRecorder.SetWave(aValue: TMMWave);
begin
   FWaveFile.Wave := aValue;
end;