mmwave.pas

P2P即时通讯源码(DELPHI编写)

         if (Length > 0) then
         begin
            Region.dwStartPos      := Start;
            Region.dwLength        := Length;
            Region.dwStartPosBytes := SamplesToBytes(Start);
            Region.dwLengthBytes   := SamplesToBytes(Length);
            FRegions.AddRegion(Region);
         end;
         if (i < FCutList.Count) then
            Start := FCutList[i].dwStartPos+FCutList[i].dwLength;

         inc(i);
      end;

      if (FRegions.Count = 0) then
      begin
         Region.dwStartPos      := Start;
         Region.dwLength        := 0;
         Region.dwStartPosBytes := SamplesToBytes(Start);
         Region.dwLengthBytes   := 0;
         FRegions.AddRegion(Region);
      end;
   end
   else
   begin
      Region.dwStartPos      := SPos;
      Region.dwLength        := EPos-SPos;
      Region.dwStartPosBytes := SamplesToBytes(Region.dwStartPos);
      Region.dwLengthBytes   := SamplesToBytes(Region.dwLength);
      FRegions.AddRegion(Region);
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.InitPlayFadeList(Playing: Boolean);
begin
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.SetIgnoreFades(aValue: Boolean);
begin
   if (aValue <> FIgnoreFades) then
   begin
      if FOpen then
         raise EMMWaveError.Create('Change to property while file was open');
      FIgnoreFades := aValue;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.Progress(CurByte, NumBytes: Longint; Var Cancel: Boolean);
begin
   if assigned(FOnProgress) then
      FOnProgress(Self,CurByte, NumBytes, Cancel);
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.SamplesToBytes(Samples: Longint): Longint;
begin
   Result := 0;
   if (PWaveFormat <> Nil) then
   begin
      Result := wioSamplesToBytes(PWaveFormat,Samples);
   end;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.BytesToSamples(Bytes: Longint): Longint;
begin
   Result := 0;
   if (PWaveFormat <> Nil) then
   begin
      Result := wioBytesToSamples(PWaveFormat,Bytes);
   end;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.RealSamplesToSamples(aValue: Longint): Longint;
begin
   Result := aValue;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.SamplesToRealSamples(aValue: Longint): Longint;
begin
   Result := aValue;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.SamplesToTimeFormat(Samples: Longint): Longint;
begin
   Result := 0;
   if (PWaveFormat <> Nil) then
   begin
      case FTimeFormat of
        tfMilliSecond: Result := wioSamplesToTime(PWaveFormat, Samples);
        tfByte       : Result := wioSamplesToBytes(PWaveFormat, Samples);
        tfSample     : Result := Samples;
      end;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.TimeFormatToSamples(aValue: Longint): Longint;
begin
   Result := 0;
   if (PWaveFormat <> Nil) then
   begin
      case FTimeFormat of
        tfMilliSecond: Result := wioTimeToSamples(PWaveFormat, aValue);
        tfByte       : Result := wioBytesToSamples(PWaveFormat, aValue);
        tfSample     : Result := aValue;
      end;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.FreeWave;
begin
   if (FFileName <> '') or (FPWaveIOCB <> nil) or
      ((FMemoryWave <> nil) and (FMemoryWave.Size > 0)) then
   begin
      ClearWave;
      Changed;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.ClearWave;
begin
   { if a Wave is actually Playing - stop it }
   StopSound;

   { if a Wave is open close it }
   CloseFile;

   { clear the filename }
   FFileName := '';

   { free the wave info }
   FreeWaveIOCB(FPWaveIOCB);

   FRegions.Clear;
   FStartPos := 0;
   FEndPos := 0;
   FPosition := 0;
   FBytesLeft := 0;
   FTotalBytes := 0;

   { clear a MemoryWave }
   if (FMemoryWave <> nil) then FMemoryWave.Clear;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.GetStreamWaveIOCB(Stream: TMemoryStream; Var lpwio: PWAVEIOCB): Word;
begin
   try
      Result := wioBuildFileInfoFromMem(lpwio,Stream.Memory,Stream.Size);
   except
      raise EMMWaveError.Create(LoadResStr(IDS_WFREADERROR));
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.FreeWaveIOCB(Var lpwio: PWAVEIOCB);
begin
   if (lpwio <> Nil) then wioFreeFileInfo(lpwio);
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.Changed;
begin
   if not FNoChange then
   begin
      FNeedChange := False;

      inherited Changed;

      { go trough the list and notify }
      FObservable.NotifyObservers(Self);
   end
   else FNeedChange := True;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.Assign(Source: TPersistent);
begin
   if (Source = Nil) or (Source is TMMWave) then
   begin
      if (Source <> Nil) then
      begin
         ClearWave;
         FileMustExist := TMMWave(Source).FileMustExist;

         {$IFDEF WIN32}
         {$IFDEF TRIAL}
         {$DEFINE _HACK1}
         {$I MMHACK.INC}
         {$ENDIF}
         {$ENDIF}

         FNoChange := True;
         try
            if (FMemoryWave <> nil) then
            begin
               if (TMMWave(Source).FMemoryWave = nil) then
               begin
                  if TMMWave(Source).FileName <> '' then
                     FileName := TMMWave(Source).FileName
                  else
                  begin
                     Changed;
                  end;
               end
               else if not TMMWave(Source).Empty then
                    LoadFromStream(TMMWave(Source).FMemoryWave);
            end
            else
            begin
               if (TMMWave(Source).FMemoryWave <> nil) then
                   inherited Assign(Source);

               if TMMWave(Source).FileName <> '' then
                  FileName := TMMWave(Source).FileName
               else if TMMWave(Source).PWaveFormat <> nil then
                  PWaveFormat := TMMWave(Source).PWaveFormat
               else
               begin
                  Changed;
               end;
            end;

            TimeFormat := TMMWave(Source).TimeFormat;
            FStartPos := TMMWave(Source).FStartPos;
            FEndPos := TMMWave(Source).FEndPos;
            FPosition := TMMWave(Source).FPosition;
            IOBufferSize := TMMWave(Source).IOBufferSize;
            CutList := TMMWave(Source).CutList;

         finally
            FNoChange := False;
            if FNeedChange then Changed;
         end;
      end
      else
      begin
         FreeWave;
         CutList := nil;
      end;
   end
   else inherited Assign(Source);
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.LoadFromStream(Stream: TStream);
var
  {$IFDEF WIN32}
//  ms: TMemoryStatus;
  {$ENDIF}
  OldCursor: TCursor;
  WaveStream: TMemoryStream;
  lpwio: PWAVEIOCB;

begin
    lpwio := Nil;
    if (FMemoryWave <> nil) then
    begin
       WaveStream := TMemoryStream.Create;
       try
          OldCursor := Screen.Cursor;
          if (Stream.Size > 500000) then Screen.Cursor := crHourGlass;
          try
           (*  {$IFDEF WIN32}
             ms.dwLength:=SizeOf(TMemoryStatus);
             GlobalMemoryStatus(MS);
             if (ms.dwAvailPhys < Stream.Size) then
             {$ELSE}
             if (GetFreeSpace(0) < Stream.Size) then
             {$ENDIF}
                OutOfMemoryError;
             *)

             WaveStream.SetSize(Stream.Size);
             Stream.Position := 0;
             Stream.ReadBuffer(WaveStream.Memory^, Stream.Size);
             if GetStreamWaveIOCB(WaveStream, lpwio) <> 0 then
                raise EMMWaveError.Create(LoadResStr(IDS_WFREADERROR));

             ClearWave;
             FMemoryWave.Free;
             FMemoryWave:= WaveStream;
             FPWaveIOCB := lpwIO;
             FStartPos  := lpwIO^.dwFirstSample;
             FEndPos    := lpwIO^.dwLastSample;
             FBytesLeft := lpwIO^.dwBytesLeft;
             FPosition   := 0;
             InitRegionList;
             Changed;

          finally
             Screen.Cursor := OldCursor;
          end;

       except
          FreeWaveIOCB(lpwio);
          WaveStream.Free;
          raise;
       end;
    end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.SaveToStream(Stream: TStream);
begin
   if (FMemoryWave <> nil) and (FMemoryWave.Size > 0) then
   begin
      Screen.Cursor := crHourGlass;
      try
         Stream.WriteBuffer(FMemoryWave.Memory^, FMemoryWave.Size);
      finally
         Screen.Cursor := crDefault;
      end;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.ReadData(Stream: TStream);
begin
   LoadFromStream(Stream);
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.WriteData(Stream: TStream);
begin
   SaveToStream(Stream);
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.DefineProperties(Filer: TFiler);
begin
   Filer.DefineBinaryProperty('Data', ReadData, WriteData, (FMemoryWave <> nil) and not Empty);
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.IsMemWave: Boolean;
begin
   Result := (FMemoryWave <> nil);
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.GetPWaveData: Pointer;
begin
   Result := nil;
   if (FMemoryWave <> nil) then
   begin
      if (FMemoryWave.Memory <> nil) and (FPWaveIOCB <> nil) then
          Result := (PChar(FMemoryWave.Memory) + FPWaveIOCB^.dwDataOffset);
   end
   else raise EMMWaveError.Create(LoadResStr(IDS_NOMEMWAVE));
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.GetEmpty: Boolean;
begin
   Result := DataSize = 0;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.GetPWaveFormat: PWaveFormatEx;
begin
     Result := Nil;
     if (FPWAVEIOCB <> Nil) then
     begin
        Result := @FPWAVEIOCB^.wfx;
     end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.SetPWaveFormat(lpwfx: PWaveFormatEx);
var
   lpWaveIO: PWaveIOCB;

begin
   if (lpwfx <> Nil) then
   begin
      if wioCreateFileInfo(lpWaveIO, lpwfx) = 0 then
      try
         PWaveIOInfo := lpWaveIO;
      except
         FreeWaveIOCB(lpWaveIO);
         raise;
      end;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
procedure TMMWave.SetPWaveIOCB(lpWaveIO: PWaveIOCB);
begin
   if (FMemoryWave <> nil) then
      raise EMMWaveError.Create(LoadResStr(IDS_WFMEMFILEERROR));

   if (lpWaveIO <> FPWaveIOCB) then
   begin
      ClearWave;

      FPWaveIOCB := lpWaveIO;
      FStartPos  := lpWaveIO^.dwFirstSample;
      FEndPos    := lpWaveIO^.dwLastSample;
      FBytesLeft := lpWaveIO^.dwBytesLeft;
      FPosition  := lpWaveIO^.dwPosition;
      if (lpWaveIO^.dwFlags = RAW_FILE) then FFileName := StrPas(lpWaveIO^.lpFilePath);
      InitRegionList;

      Changed;
   end;
end;

{-- TMMWave --------------------------------------------------------------}
function TMMWave.GetInfoChunk(fcc: String): String;
var
   pi: PInfoData;
   aBuf: array[0..4] of Char;
   lpStr: PChar;

begin
   Result := '';
   if (FPWAVEIOCB <> Nil) then
   with FPWaveIOCB^ do
   begin
      { first search the Chunk to modify }
      pi := RiffFindPIINFO(lpInfo, mmioStringToFOURCC(StrPCopy(aBuf,fcc),0));