mmpload.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: 12.09.98 - 12:22:16 $                                        =}
{========================================================================}
unit MMPLoad;

interface

uses
    Windows,
    SysUtils,
    Classes,
    Messages,
    Forms,
    MMSystem,
    MMObj,
    MMDSPObj,
    MMUtils,
    MMRegs;

const
    {$IFDEF CBUILDER3} {$EXTERNALSYM defPreload} {$ENDIF}
    defPreload = 25*4096;

type
   EMMPreloadError   = class(Exception);

   {-- TMMPreloadThread -------------------------------------------------------}
   TMMPreloadThread  = class(TMMDSPThread)
   private
     procedure Execute; override;
   end;

   TMMPreloadMode    = (plSync, pmAsync);

   {-- TMMPreloader -----------------------------------------------------------}
   TMMPreloader      = class(TMMDSPComponent)
   private
      FHandle        : THandle;
      FPreloadSize   : Longint;
      FPreloadMode   : TMMPreloadMode;
      FOpen          : Boolean;
      FStarted       : Boolean;
      FTempBuffer    : PChar;
      FBytesPreloaded: Longint;
      FBytesRead     : Longint;
      FCloseAll      : Boolean;
      FDone          : Boolean;
      Ftwh           : TMMWaveHdr;
      FPreloadThread : TMMPreloadThread;

      FOnPreloaded   : TNotifyEvent;
      FOnClose       : TNotifyEvent;

      procedure SetPreloadSize(aValue: Longint);
      procedure SetPreloadMode(aValue: TMMPreloadMode);
      procedure PreloadHandler(var Msg: TMessage);
      procedure PreloadData;

   protected
      procedure Opened; override;
      procedure Closed; override;
      procedure Started; override;
      procedure Paused; override;
      procedure Restarted; override;
      procedure Stopped; override;
      procedure Reseting; override;
      procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

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

      procedure Preload;
      procedure Close;

   published
      property OnPreloaded: TNotifyEvent read FOnPreloaded write FOnPreloaded;
      property OnClose: TNotifyEvent read FOnClose write FOnClose;

      property Input;
      property Output;
      property PreloadSize: Longint read FPreloadSize write SetPreloadSize default defPreload;
      property PreloadMode: TMMPreloadMode read FPreloadMode write SetPreloadMode default plSync;
   end;

implementation

const
     MM_PRELOADED = MM_USER+1;

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

   FHandle         := 0;
   FOpen           := False;
   FStarted        := False;
   FTempBuffer     := nil;
   FPreloadSize    := defPreload;
   FPreloadMode    := plSync;
   FBytesPreloaded := 0;
   FBytesRead      := 0;
   FDone           := False;
   FCloseAll       := False;

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

{-- TMMPreloader --------------------------------------------------------------}
destructor TMMPreloader.Destroy;
begin
   Close;

   { Destroy the window for notification }
   if (FHandle <> 0) then DeallocateHwnd(FHandle);

   inherited Destroy;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.SetPreloadSize(aValue: Longint);
begin
   if (aValue <> FPreloadSize) and (aValue >= 0) then
   begin
      if FOpen then
         raise EMMPreloadError.Create(LoadResStr(IDS_PROPERTYOPEN));

      FPreloadSize:= aValue;
   end;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.SetPreloadMode(aValue: TMMPreloadMode);
begin
   if aValue <> FPreloadMode then
   begin
      if FOpen then
         raise EMMPreloadError.Create(LoadResStr(IDS_PROPERTYOPEN));

      FPreloadMode := aValue;
   end;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.PreloadData;
var
   MoreBuffers: Boolean;
   nBytes,nRead: Longint;

begin
   GlobalFillMem(Ftwh,sizeOf(Ftwh),0);

   FDone := False;
   nBytes:= FPreloadSize;
   while (FBytesPreloaded < FPreloadSize) and not FDone do
   begin
      Ftwh.wh.lpData := FTempBuffer+FBytesPreloaded;
      Ftwh.wh.dwBufferLength := Min(QUEUE_READ_SIZE,nBytes);
      Ftwh.wh.dwBytesRecorded:= 0;

      MoreBuffers := False;
      inherited BufferLoad(@Ftwh,MoreBuffers);

      nRead := Max(Ftwh.wh.dwBytesRecorded,0);

      inc(FBytesPreloaded,nRead);
      dec(nBytes,nRead);

      if not MoreBuffers or (nRead <= 0) then FDone := True;
   end;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Preload;
begin
   if not FOpen then
   begin
      FPreloaded := True;

      Opened;
      Started;

      { adjust the Preloadsize }
      FPreloadSize    := (FPreloadSize div BufferSize) * BufferSize;
      FBytesPreloaded := 0;
      FBytesRead      := 0;

      if (FPreloadSize > 0) then
      begin
         FTempBuffer := GlobalAllocMem(FPreloadSize);

         if (FPreloadMode = plSync) then
         begin
            PreloadData;
            if assigned(FOnPreloaded) then FOnPreloaded(Self);
         end
         else
         begin
            FPreloadThread := TMMPreloadThread.CreateSuspended(Self);
            if (FPreloadThread = nil) then
                raise EMMPreloadError.Create(LoadResStr(IDS_THREADERROR));

            { Create the window for notification }
            if (FHandle = 0) then FHandle := AllocateHwnd(PreloadHandler);

            FPreloadThread.FreeOnTerminate := True;
            FPreloadThread.Resume;
         end;
      end;
   end;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Close;
begin
   if FOpen then
   begin
      FCloseAll := True;

      Stopped;
      Closed;
   end;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Opened;
var
   Current: TMMDSPComponent;

begin
   if not FOpen then
   begin
      if FPreloaded then
      begin
         { search the output component }
         Current := Self;
         while (Current.Output <> nil) do
         begin
            Current := Current.Output;
            if (Current is TMMCustomSoundComponent) then
            begin
               BufferSize := Current.BufferSize;
               break;
            end;
         end;

         if (Current = nil) then
             raise EMMPreloadError.Create('No Output component found');

         { search the first valid component }
         Current := Self;
         while (Current.Input <> nil) do
         begin
            Current := Current.Input;
         end;

         { no go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) and (Current <> Self) then
            begin
               Current.BufferSize := BufferSize;
               Current.Opened;
            end;
            Current := Current.Output;
         until (Current = nil) or (Current = Self);
      end;

      FOpen := True;
   end;

   inherited Opened;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Closed;
var
   Current: TMMDSPComponent;

begin
   if FOpen then
   begin
      FPreloaded := False;

      FBytesPreloaded := 0;
      GlobalFreeMem(Pointer(FTempBuffer));

      if FCloseAll then
      begin
         { search the first component }
         Current := Self;
         while (Current.Input <> nil) do
         begin
            Current := Current.Input;
         end;

         { no go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) and (Current <> Self) then
            begin
               Current.Closed;
            end;
            Current := Current.Output;
         until (Current = nil) or (Current = Self);
      end;

      FCloseAll  := False;
      FOpen      := False;

      if assigned(FOnClose) then FOnClose(Self);
   end;

   inherited Closed;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Started;
var
   Current: TMMDSPComponent;

begin
   if not FStarted then
   begin
      if FPreloaded then
      begin
         { search the first component }
         Current := Self;
         while (Current.Input <> nil) do
         begin
            Current := Current.Input;
         end;

         { no go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) and (Current <> Self) then
            begin
               Current.Started;
            end;
            Current := Current.Output;
         until (Current = nil) or (Current = Self);
      end;

      FBytesPreloaded := 0;
      FDone           := False;
      FStarted        := True;
   end;

   inherited Started;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Paused;
begin
   inherited Paused;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Restarted;
begin
   inherited Restarted;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Stopped;
var
   Current: TMMDSPComponent;

begin
   if FStarted then
   begin
      FStarted   := False;
      FPreloaded := False;
      FBytesPreloaded := 0;

      if FCloseAll then
      begin
         { search the first component }
         Current := Self;
         while (Current.Input <> nil) do
         begin
            Current := Current.Input;
         end;

         { no go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) and (Current <> Self) then
            begin
               Current.Stopped;
            end;
            Current := Current.Output;
         until (Current = nil) or (Current = Self);
      end;
   end;

   inherited Stopped;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.Reseting;
begin
   FBytesPreloaded := 0;

   inherited Reseting;
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
var
   nBytes: Longint;
begin
   if FOpen and (FBytesPreloaded > 0) then
   begin
      nBytes := Min(lpwh^.dwBufferLength,FBytesPreloaded);
      GlobalMoveMem((FTempBuffer+FBytesRead)^,lpwh^.lpData^,nBytes);
      dec(FBytesPreloaded,nBytes);
      inc(FBytesRead,nBytes);
      lpwh^.dwBytesRecorded := nBytes;
      MoreBuffers := not FDone or (FBytesPreloaded > 0);
   end
   else inherited BufferLoad(lpwh, MoreBuffers);
end;

{-- TMMPreloader --------------------------------------------------------------}
procedure TMMPreloader.PreloadHandler(var Msg: TMessage);
begin
  with Msg do
  try
     if (wParam = FHandle) and (FPreloadThread <> nil) then
     begin
        FPreloadThread := nil;
        if assigned(FOnPreloaded) then FOnPreloaded(Self);
     end
     else Result := DefWindowProc(FHandle, Msg, wParam, lParam);

  except
     Application.HandleException(Self);
  end;
end;

{==============================================================================}
procedure TMMPreloadThread.Execute;
begin
   with TMMPreloader(Owner) do
   try
      PreloadData;

      PostMessage(FHandle,MM_PRELOADED,FHandle,0);
   except
      Application.HandleException(nil);
      exit;
   end;
end;

end.