لتسريع وابطاء ملفات الوايف

[jeanjamil]

                               السلام عليكم

uses MMSystem;

type

 TBytes = array of Byte;

                                              

function GetWaveFmtData(path: string; var fmt: TWaveFormatEx; var buf: TBytes): 

Boolean;

var

  hFile: HMMIO;

  ckiRIFF,ckiFmt,ckiData: TMMCKInfo;

begin

  Result := False;

  hFile := mmioOpen(PChar(path), nil, MMIO_READ);

  if hFile = 0 then Exit;

  ZeroMemory(@ckiRIFF, SizeOf(TMMCKInfo));

  ZeroMemory(@ckiFmt, SizeOf(TMMCKInfo));

  ZeroMemory(@ckiData, SizeOf(TMMCKInfo));

  ckiRIFF.fccType := mmioStringToFOURCC('WAVE', 0);

  ckiFmt.ckid := mmioStringToFOURCC('fmt', 0);

  ckiData.ckid := mmioStringToFOURCC('data', 0);

  ZeroMemory(@fmt, SizeOf(TWaveFormatEx));

  mmioDescend(hFile, @ckiRIFF, nil, MMIO_FINDRIFF);

  if (ckiRIFF.ckid = FOURCC_RIFF) and (ckiRIFF.fccType = mmioStringToFOURCC('WAVE',0)) and

     (mmioDescend(hFile, @ckiFmt, @ckiRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) and

     (mmioRead(hFile, @fmt, ckiFmt.cksize) = ckiFmt.cksize) and

     (mmioAscend(hFile, @ckiFmt, 0) = MMSYSERR_NOERROR) and

     (mmioDescend(hFile, @ckiData, @ckiRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) then

  begin

    SetLength(buf, ckiData.cksize);

    Result := (mmioRead(hFile, PAnsiChar(buf), ckiData.cksize) = ckiData.cksize);

  end;

  mmioClose(hFile, 0);

end;

//------------------------------------------------------------------------------

var

  wh: TWaveHdr;

  hWaveOut: HWAVE;

  fmt: TWaveFormatEx;

  buf: TBytes;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

waveoutpause(hwaveout);

 waveOutclose(hWaveOut);

Application.Terminate;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  Button1.Caption := 'Open and play';

  Button2.Caption := 'time out';

  Button3.Caption := 'carry on';

end;

procedure WaveProc(hWave: HWAVE; uMsg, dwInstance, dwParam1, dwParam2: DWORD); stdcall;

begin

  case uMsg of

    MM_WOM_DONE: waveOutUnprepareHeader(hWave, PWaveHdr(dwParam1), SizeOf(TWaveHdr));

  end;

end;

procedure TForm1.Button1Click(Sender: TObject);

const

  path = 'welcome.wav';

var

  volume: DWORD;

  n:integer;

begin

   TrackBar1.Position:=65565;

  GetWaveFmtData(path, fmt, buf);

  wh.lpData := PAnsiChar(buf);

  wh.dwBufferLength := Length(buf);

  wh.dwBytesRecorded := 0;

  wh.dwUser := 0;

  wh.dwFlags := WHDR_BEGINLOOP or WHDR_ENDLOOP;

  wh.dwLoops := n;  //loop forever set time to loop  1=loop one time

  wh.lpNext := nil;

  wh.reserved := 0;

  waveOutOpen(@hWaveOut, WAVE_MAPPER, @fmt, DWORD(@WaveProc), 0, CALLBACK_FUNCTION);

  waveOutPrepareHeader(hWaveOut, @wh, SizeOf(TWaveHdr));

•   waveOutWrite(hWaveOut, @wh, SizeOf(TWaveHdr));
  
• هذا الكود هو لتسريع وابطاء ملفات الوايف
  
• لم يعمل معي الا على windows10
  
• السؤال:
  
• الكود يغير السرعة لكنه ايضا يؤثر على امتداد الصوت pitch
  
• كيف اسرع الملف مع الحفاظ على نفس مستوى النغم
  
• اي كايقاعات الالات الموسيقية
  
• لانني اعتقد انه ربما هناك دالة في الكود يجب ان لا
  
• تتاثر بالتغيير
  
• وان كان لا فما الحل