AudioACM.pas
上传用户:wanyu_2000
上传日期:2021-02-21
资源大小:527k
文件大小:35k
源码类别:

DVD

开发平台:

Delphi

  1. {-----------------------------------------------------------------------------
  2.  Unit Name: AudioACM
  3.  Author:    Dancemammal
  4.  Purpose:   Wave Utils and conversion functions
  5.  History:   First release
  6. -----------------------------------------------------------------------------}
  7. unit AudioACM;
  8. interface
  9. uses
  10.   Windows, Messages, Classes, SysUtils, mmSystem;
  11. const
  12. // addons for extra codecs
  13.   WAVE_FORMAT_MSG723 = 66;
  14.   WAVE_FORMAT_MPEGLAYER3 = 85;
  15.   MPEGLAYER3_WFX_EXTRA_BYTES = 12;
  16.   MPEGLAYER3_ID_UNKNOWN = 0;
  17.   MPEGLAYER3_ID_MPEG = 1;
  18.   MPEGLAYER3_ID_CONSTANTFRAMESIZE = 2;
  19.   MPEGLAYER3_FLAG_PADDING_ISO = $00000000;
  20.   MPEGLAYER3_FLAG_PADDING_ON = $00000001;
  21.   MPEGLAYER3_FLAG_PADDING_OFF = $00000002;
  22. type
  23.   // Milliseconds to string format specifiers
  24.   TMS2StrFormat = (
  25.     msHMSh, // Hour:Minute:Second.Hunderdth
  26.     msHMS,  // Hour:Minute:Second
  27.     msMSh,  // Minute:Second.Hunderdth
  28.     msMS,   // Minute:Second
  29.     msSh,   // Second.Hunderdth
  30.     msS,    // Second
  31.     msAh,   // Best format with hunderdth of second
  32.     msA);   // Best format without hunderdth of second
  33.   // Standard PCM Audio Format
  34.   TPCMChannel = (cMono, cStereo);
  35.   TPCMSamplesPerSec = (ss8000Hz, ss11025Hz, ss22050Hz, ss44100Hz, ss48000Hz);
  36.   TPCMBitsPerSample = (bs8Bit, bs16Bit);
  37.   TPCMFormat = (nonePCM, Mono8Bit8000Hz, Stereo8bit8000Hz, Mono16bit8000Hz,
  38.     Stereo16bit8000Hz, Mono8bit11025Hz, Stereo8bit11025Hz, Mono16bit11025Hz,
  39.     Stereo16bit11025Hz, Mono8bit22050Hz, Stereo8bit22050Hz, Mono16bit22050Hz,
  40.     Stereo16bit22050Hz, Mono8bit44100Hz, Stereo8bit44100Hz, Mono16bit44100Hz,
  41.     Stereo16bit44100Hz, Mono8bit48000Hz, Stereo8bit48000Hz, Mono16bit48000Hz,
  42.     Stereo16bit48000Hz);
  43.  // TMP3Bitrates = (96kBits,112kBits,128kBits,160kBits,192kBits,224kBits,256kBits,320kBits)
  44.   // Wave Device Supported PCM Formats
  45.   TWaveDeviceFormats = set of TPCMFormat;
  46.   // Wave Out Device Supported Features
  47.   TWaveOutDeviceSupport = (dsVolume, dsStereoVolume, dsPitch, dsPlaybackRate, dsPosition, dsAsynchronize, dsDirectSound);
  48.   TWaveOutDeviceSupports = set of TWaveOutDeviceSupport;
  49.   // Wave Out Options
  50.   TWaveOutOption = (woSetVolume, woSetPitch, woSetPlaybackRate);
  51.   TWaveOutOptions = set of TWaveOutOption;
  52.   // Wave Audio Exceptions
  53.   EWaveAudioError = class(Exception);
  54.   EWaveAudioSysError = class(EWaveAudioError);
  55.   EWaveAudioInvalidOperation = class(EWaveAudioError);
  56. function GetWaveAudioInfo(mmIO: HMMIO; out pWaveFormat: PWaveFormatEx;
  57.   out DataSize, DataOffset: DWORD): Boolean;
  58. function CreateWaveAudio(mmIO: HMMIO; const pWaveFormat: PWaveFormatEx;
  59.   out ckRIFF, ckData: TMMCKInfo): Boolean;
  60. procedure CloseWaveAudio(mmIO: HMMIO; var ckRIFF, ckData: TMMCKInfo);
  61. function GetStreamWaveAudioInfo(Stream: TStream; out pWaveFormat: PWaveFormatEx;
  62.   out DataSize, DataOffset: DWORD): Boolean;
  63. function CreateStreamWaveAudio(Stream: TStream; const pWaveFormat: PWaveFormatEx;
  64.   out ckRIFF, ckData: TMMCKInfo): HMMIO;
  65. function OpenStreamWaveAudio(Stream: TStream): HMMIO;
  66. function CalcWaveBufferSize(const pWaveFormat: PWaveFormatEx; Duration: DWORD): DWORD;
  67. function GetWaveAudioFormat(const pWaveFormat: PWaveFormatEx): String;
  68. function GetWaveAudioLength(const pWaveFormat: PWaveFormatEx; DataSize: DWORD): DWORD;
  69. function GetWaveAudioBitRate(const pWaveFormat: PWaveFormatEx): DWORD;
  70. function GetWaveAudioPeakLevel(const Data: Pointer; DataSize: DWORD;
  71.   BitsPerSample: WORD): Integer;
  72. procedure InvertWaveAudio(const Data: Pointer; DataSize: DWORD;
  73.   BitsPerSample: WORD);
  74. procedure SilenceWaveAudio(const Data: Pointer; DataSize: DWORD;
  75.   BitsPerSample: WORD);
  76. procedure ChangeWaveAudioVolume(const Data: Pointer; DataSize: DWORD;
  77.   BitsPerSample: WORD; Percent: Integer);
  78. function ConvertWaveFormat(const srcFormat: PWaveFormatEx; srcData: Pointer; srcDataSize: DWORD;
  79.   const dstFormat: PWaveFormatEx; out dstData: Pointer; out dstDataSize: DWORD): Boolean;
  80. procedure SetPCMAudioFormat(const pWaveFormat: PWaveFormatEx; Channels: TPCMChannel;
  81.   SamplesPerSec: TPCMSamplesPerSec; BitsPerSample: TPCMBitsPerSample);
  82. procedure SetPCMAudioFormatS(const pWaveFormat: PWaveFormatEx; PCMFormat: TPCMFormat);
  83. function GetPCMAudioFormat(const pWaveFormat: PWaveFormatEx): TPCMFormat;
  84. procedure SetMP3AudioFormatS(const pWaveFormat: PWaveFormatEx; PCMFormat: TPCMFormat);
  85. function GetMP3AudioFormat(const pWaveFormat: PWaveFormatEx): TPCMFormat;
  86. function MS2Str(Milliseconds: DWORD; Fmt: TMS2StrFormat): String;
  87. function WaitForSyncObject(SyncObject: THandle; Timeout: DWORD): DWORD;
  88. function mmioStreamProc(lpmmIOInfo: PMMIOInfo; uMsg, lParam1, lParam2: DWORD): LRESULT; stdcall;
  89. implementation
  90. const
  91.   // acmStreamConvert flags
  92.   ACM_STREAMCONVERTF_BLOCKALIGN = $00000004;
  93.   ACM_STREAMCONVERTF_START      = $00000010;
  94.   ACM_STREAMCONVERTF_END        = $00000020;
  95.   // acmStreamOpen flags
  96.   ACM_STREAMOPENF_QUERY         = $00000001;
  97.   ACM_STREAMOPENF_ASYNC         = $00000002;
  98.   ACM_STREAMOPENF_NONREALTIME   = $00000004;
  99.   // acmStreamSize flags
  100.   ACM_STREAMSIZEF_SOURCE        = $00000000;
  101.   ACM_STREAMSIZEF_DESTINATION   = $00000001;
  102. type
  103.   // ACM Driver Handle
  104.   HACMDRIVER = DWORD;
  105.   // ACM Stream Handle
  106.   HACMSTREAM = DWORD;
  107.   // ACM Stream Header
  108.   PACMSTREAMHEADER = ^TACMSTREAMHEADER;
  109.   TACMSTREAMHEADER = packed record
  110.     cbStruct: DWORD;
  111.     fdwStatus: DWORD;
  112.     dwUser: DWORD;
  113.     pbSrc: PBYTE;
  114.     cbSrcLength: DWORD;
  115.     cbSrcLengthUsed: DWORD;
  116.     dwSrcUser: DWORD;
  117.     pbDst: PBYTE;
  118.     cbDstLength: DWORD;
  119.     cbDstLengthUsed: DWORD;
  120.     dwDstUser: DWORD;
  121.     dwReservedDriver: array[0..9] of DWORD;
  122.   end;
  123.   // ACM Wave Filter
  124.   PWAVEFILTER = ^TWAVEFILTER;
  125.   TWAVEFILTER = packed record
  126.     cbStruct: DWORD;
  127.     dwFilterTag: DWORD;
  128.     fdwFilter: DWORD;
  129.     dwReserved: array[0..4] of DWORD;
  130.   end;
  131. function acmStreamOpen(var phas: HACMSTREAM; had: HACMDRIVER;
  132.   pwfxSrc: PWAVEFORMATEX; pwfxDst: PWAVEFORMATEX; pwfltr: PWAVEFILTER;
  133.   dwCallback: DWORD; dwInstance: DWORD; fdwOpen: DWORD): MMRESULT; stdcall;
  134.   external 'msacm32.dll';
  135. function acmStreamClose(has: HACMSTREAM; fdwClose: DWORD): MMRESULT; stdcall;
  136.   external 'msacm32.dll';
  137. function acmStreamPrepareHeader(has: HACMSTREAM; var pash: TACMSTREAMHEADER;
  138.   fdwPrepare: DWORD): MMRESULT; stdcall;
  139.   external 'msacm32.dll';
  140. function acmStreamUnprepareHeader(has: HACMSTREAM; var pash: TACMSTREAMHEADER;
  141.   fdwUnprepare: DWORD): MMRESULT; stdcall;
  142.   external 'msacm32.dll';
  143. function acmStreamConvert(has: HACMSTREAM; var pash: TACMSTREAMHEADER;
  144.   fdwConvert: DWORD): MMRESULT; stdcall;
  145.   external 'msacm32.dll';
  146. function acmStreamSize(has: HACMSTREAM; cbInput: DWORD;
  147.   var pdwOutputBytes: DWORD; fdwSize: DWORD): MMRESULT; stdcall;
  148.   external 'msacm32.dll';
  149. { Global Procedures }
  150. // To open a stream using mmIO API functions, use the following code sample:
  151. //
  152. //    FillChar(mmioInfo, SizeOf(mmioInfo), 0);
  153. //    mmioInfo.pIOProc := @mmioStreamProc;
  154. //    mmioInfo.adwInfo[0] := DWORD(your_stream_instance);
  155. //    mmIO := mmioOpen(nil, @mmioInfo, dwOpenFlags);
  156. //
  157. // The flags specified by the dwOpenFlags parameter of mmioOpen function can
  158. // be only one of MMIO_READ, MMIO_WRITE, and MMIO_READWRITE flags. If you use
  159. // another flags, simply they will be ignored by this user defined function.
  160. function mmIOStreamProc(lpmmIOInfo: PMMIOInfo; uMsg, lParam1, lParam2: DWORD): LRESULT; stdcall;
  161. var
  162.   Stream: TStream;
  163. begin
  164.   if Assigned(lpmmIOInfo) and (lpmmIOInfo^.adwInfo[0] <> 0) then
  165.   begin
  166.     Stream := TStream(lpmmIOInfo^.adwInfo[0]);
  167.     case uMsg of
  168.       MMIOM_OPEN:
  169.       begin
  170.         if TObject(lpmmIOInfo^.adwInfo[0]) is TStream then
  171.         begin
  172.           Stream.Seek(0, SEEK_SET);
  173.           lpmmIOInfo^.lDiskOffset := 0;
  174.           Result := MMSYSERR_NOERROR;
  175.         end
  176.         else
  177.           Result := -1;
  178.       end;
  179.       MMIOM_CLOSE:
  180.         Result := MMSYSERR_NOERROR;
  181.       MMIOM_SEEK:
  182.         try
  183.           if lParam2 = SEEK_CUR then
  184.             Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
  185.           Result := Stream.Seek(lParam1, lParam2);
  186.           lpmmIOInfo^.lDiskOffset := Result;
  187.         except
  188.           Result := -1;
  189.         end;
  190.       MMIOM_READ:
  191.         try
  192.           Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
  193.           Result := Stream.Read(Pointer(lParam1)^, lParam2);
  194.           lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
  195.         except
  196.           Result := -1;
  197.         end;
  198.       MMIOM_WRITE,
  199.       MMIOM_WRITEFLUSH:
  200.         try
  201.           Stream.Seek(lpmmIOInfo^.lDiskOffset, SEEK_SET);
  202.           Result := Stream.Write(Pointer(lParam1)^, lParam2);
  203.           lpmmIOInfo^.lDiskOffset := Stream.Seek(0, SEEK_CUR);
  204.         except
  205.           Result := -1;
  206.         end
  207.     else
  208.       Result := MMSYSERR_NOERROR;
  209.     end;
  210.   end
  211.   else
  212.     Result := -1;
  213. end;
  214. // Retrieves format, size, and offset of the wave audio for an open mmIO
  215. // handle. On success when the the function returns true, it is the caller
  216. // responsibility to free the memory allocated for the Wave Format structure.
  217. function GetWaveAudioInfo(mmIO: HMMIO; out pWaveFormat: PWaveFormatEx;
  218.   out DataSize, DataOffset: DWORD): Boolean;
  219.   function GetWaveFormat(const ckRIFF: TMMCKInfo): Boolean;
  220.   var
  221.     ckFormat: TMMCKInfo;
  222.   begin
  223.     Result := False;
  224.     ckFormat.ckid := mmioStringToFOURCC('fmt', 0);
  225.     if (mmioDescend(mmIO, @ckFormat, @ckRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) and
  226.        (ckFormat.cksize >= SizeOf(TWaveFormat)) then
  227.     begin
  228.       if ckFormat.cksize < SizeOf(TWaveFormatEx) then
  229.       begin
  230.         GetMem(pWaveFormat, SizeOf(TWaveFormatEx));
  231.         FillChar(pWaveFormat^, SizeOf(TWaveFormatEx), 0);
  232.       end
  233.       else
  234.         GetMem(pWaveFormat, ckFormat.cksize);
  235.       Result := (mmioRead(mmIO, PChar(pWaveFormat), ckFormat.cksize) = Integer(ckFormat.cksize));
  236.     end;
  237.   end;
  238.   function GetWaveData(const ckRIFF: TMMCKInfo): Boolean;
  239.   var
  240.     ckData: TMMCKInfo;
  241.   begin
  242.     Result := False;
  243.     ckData.ckid := mmioStringToFOURCC('data', 0);
  244.     if (mmioDescend(mmIO, @ckData, @ckRIFF, MMIO_FINDCHUNK) = MMSYSERR_NOERROR) then
  245.     begin
  246.       DataSize := ckData.cksize;
  247.       DataOffset := ckData.dwDataOffset;
  248.       Result := True;
  249.     end;
  250.   end;
  251. var
  252.   ckRIFF: TMMCKInfo;
  253.   OrgPos: Integer;
  254. begin
  255.   Result := False;
  256.   OrgPos := mmioSeek(mmIO, 0, SEEK_CUR);
  257.   try
  258.     mmioSeek(mmIO, 0, SEEK_SET);
  259.     ckRIFF.fccType := mmioStringToFOURCC('WAVE', 0);
  260.     if (mmioDescend(mmIO, @ckRIFF, nil, MMIO_FINDRIFF) = MMSYSERR_NOERROR) then
  261.     begin
  262.       pWaveFormat := nil;
  263.       if GetWaveFormat(ckRIFF) and GetWaveData(ckRIFF) then
  264.         Result := True
  265.       else if Assigned(pWaveFormat) then
  266.         ReallocMem(pWaveFormat, 0);
  267.     end
  268.   finally
  269.     mmioSeek(mmIO, OrgPos, SEEK_SET);
  270.   end;
  271. end;
  272. // Initializes a new wave RIFF format in an open mmIO handle. The previous
  273. // content of mmIO will be lost.
  274. function CreateWaveAudio(mmIO: HMMIO; const pWaveFormat: PWaveFormatEx;
  275.   out ckRIFF, ckData: TMMCKInfo): Boolean;
  276. var
  277.   ckFormat: TMMCKInfo;
  278.   FormatSize: Integer;
  279. begin
  280.   Result := False;
  281.   FormatSize := SizeOf(TWaveFormatEx) + pWaveFormat^.cbSize;
  282.   mmIOSeek(mmIO, 0, SEEK_SET);
  283.   FillChar(ckRIFF, SizeOf(TMMCKInfo), 0);
  284.   ckRIFF.fccType := mmioStringToFOURCC('WAVE', 0);
  285.   if mmioCreateChunk(mmIO, @ckRIFF, MMIO_CREATERIFF) = MMSYSERR_NOERROR then
  286.   begin
  287.     FillChar(ckFormat, SizeOf(TMMCKInfo), 0);
  288.     ckFormat.ckid := mmioStringToFOURCC('fmt', 0);
  289.     if (mmioCreateChunk(mmIO, @ckFormat, 0) = MMSYSERR_NOERROR) and
  290.        (mmioWrite(mmIO, PChar(pWaveFormat), FormatSize) = FormatSize) and
  291.        (mmioAscend(mmIO, @ckFormat, 0) = MMSYSERR_NOERROR) then
  292.     begin
  293.       FillChar(ckData, SizeOf(TMMCKInfo), 0);
  294.       ckData.ckid := mmioStringToFOURCC('data', 0);
  295.       Result := (mmioCreateChunk(mmIO, @ckData, 0) = MMSYSERR_NOERROR);
  296.     end;
  297.   end;
  298. end;
  299. // Updates the chunks and closes an mmIO handle.
  300. procedure CloseWaveAudio(mmIO: HMMIO; var ckRIFF, ckData: TMMCKInfo);
  301. begin
  302.   mmioAscend(mmIO, @ckData, 0);
  303.   mmioAscend(mmIO, @ckRIFF, 0);
  304.   mmioClose(mmIO, 0);
  305. end;
  306. // Retrieves format, size, and offset of the wave audio for a stream. On
  307. // success when the the function returns true, it is the caller responsibility
  308. // to free the memory allocated for the Wave Format structure.
  309. function GetStreamWaveAudioInfo(Stream: TStream; out pWaveFormat: PWaveFormatEx;
  310.   out DataSize, DataOffset: DWORD): Boolean;
  311. var
  312.   mmIO: HMMIO;
  313. begin
  314.   Result := False;
  315.   if Stream.Size <> 0 then
  316.   begin
  317.     mmIO := OpenStreamWaveAudio(Stream);
  318.     if mmIO <> 0 then
  319.       try
  320.         Result := GetWaveAudioInfo(mmIO, pWaveFormat, DataSize, DataOffset);
  321.       finally
  322.         mmioClose(mmIO, MMIO_FHOPEN);
  323.       end;
  324.   end;
  325. end;
  326. // Initializes wave RIFF format in a stream and returns the mmIO handle.
  327. // After calling this function, the previous content of the stream will be lost.
  328. function CreateStreamWaveAudio(Stream: TStream; const pWaveFormat: PWaveFormatEx;
  329.  out ckRIFF, ckData: TMMCKInfo): HMMIO;
  330. begin
  331.   Result := OpenStreamWaveAudio(Stream);
  332.   if Result <> 0 then
  333.   begin
  334.     Stream.Size := 0;
  335.     if not CreateWaveAudio(Result, pWaveFormat, ckRIFF, ckData) then
  336.     begin
  337.       mmioClose(Result, MMIO_FHOPEN);
  338.       Result := 0;
  339.     end;
  340.   end;
  341. end;
  342. // Opens wave RIFF format in a stream for read and write operations and returns
  343. // the mmIO handle.
  344. function OpenStreamWaveAudio(Stream: TStream): HMMIO;
  345. var
  346.   mmIOInfo: TMMIOINFO;
  347. begin
  348.   FillChar(mmIOInfo, SizeOf(mmIOInfo), 0);
  349.   mmIOInfo.pIOProc := @mmIOStreamProc;
  350.   mmIOInfo.adwInfo[0] := DWORD(Stream);
  351.   Result := mmioOpen(nil, @mmIOInfo, MMIO_READ or MMIO_WRITE);
  352. end;
  353. // Claculates the wave buffer size for the specified duration.
  354. function CalcWaveBufferSize(const pWaveFormat: PWaveFormatEx; Duration: DWORD): DWORD;
  355. var
  356.   Alignment: DWORD;
  357. begin
  358.   Result := MulDiv(Duration, pWaveFormat^.nAvgBytesPerSec, 1000);
  359.   if pWaveFormat^.nBlockAlign <> 0 then
  360.   begin
  361.     Alignment := Result mod pWaveFormat^.nBlockAlign;
  362.     if Alignment <> 0 then Inc(Result, pWaveFormat^.nBlockAlign - Alignment);
  363.   end;
  364. end;
  365. // Returns the string representation of a wave audio format.
  366. function GetWaveAudioFormat(const pWaveFormat: PWaveFormatEx): String;
  367. const
  368.   Channels: array[1..2] of String = ('Mono', 'Stereo');
  369. begin
  370.   with pWaveFormat^ do
  371.   begin
  372.     if nChannels in [1..2] then
  373.       Result := Format('%.3f kHz, %d Bit, %s', [nSamplesPerSec / 1000,
  374.         wBitsPerSample, Channels[nChannels]])
  375.     else
  376.       Result := Format('%.3f kHz, %d Bit, %d Ch', [nSamplesPerSec / 1000,
  377.         wBitsPerSample, nChannels]);
  378.     if wFormatTag = WAVE_FORMAT_PCM then
  379.       Result := 'PCM ' + Result;
  380.   end;
  381. end;
  382. // Returns the wave's length in milliseconds.
  383. function GetWaveAudioLength(const pWaveFormat: PWaveFormatEx; DataSize: DWORD): DWORD;
  384. begin
  385.   with pWaveFormat^ do
  386.     if nAvgBytesPerSec <> 0 then
  387.       Result := MulDiv(1000, DataSize, nAvgBytesPerSec)
  388.     else
  389.       Result := 0;
  390. end;
  391. // Returns the wave's bit rate in kbps (kilo bits per second).
  392. function GetWaveAudioBitRate(const pWaveFormat: PWaveFormatEx): DWORD;
  393. begin
  394.   with pWaveFormat^ do
  395.     Result := MulDiv(nSamplesPerSec, nChannels * wBitsPerSample, 1000);
  396. end;
  397. // Returns the wave data peak level in percent (PCM format only).
  398. function GetWaveAudioPeakLevel(const Data: Pointer; DataSize: DWORD;
  399.   BitsPerSample: WORD): Integer;
  400.   function GetAudioPeakLevel8Bit: Integer;
  401.   var
  402.     pSample: PByte;
  403.     Max: Byte;
  404.   begin
  405.     Max := 0;
  406.     pSample := Data;
  407.     while DataSize > 0 do
  408.     begin
  409.       if pSample^ > Max then
  410.         Max := pSample^;
  411.       Inc(pSample);
  412.       Dec(DataSize);
  413.     end;
  414.     if ByteBool(Max and $80) then
  415.       Max := Max and $7F
  416.     else
  417.       Max := 0;
  418.     Result := (100 * Max) div $7F;
  419.   end;
  420.   function GetAudioPeakLevel16Bit: Integer;
  421.   var
  422.     pSample: PSmallInt;
  423.     Max: SmallInt;
  424.   begin
  425.     Max := 0;
  426.     pSample := Data;
  427.     while DataSize > 0 do
  428.     begin
  429.       if pSample^ > Max then
  430.         Max := pSample^;
  431.       Inc(pSample);
  432.       Dec(DataSize, 2);
  433.     end;
  434.     Result := (100 * Max) div $7FFF;
  435.   end;
  436. begin
  437.   case BitsPerSample of
  438.     8: Result := GetAudioPeakLevel8Bit;
  439.     16: Result := GetAudioPeakLevel16Bit;
  440.   else
  441.     Result := -1;
  442.   end;
  443. end;
  444. // Inverts the wave data (PCM format only).
  445. procedure InvertWaveAudio(const Data: Pointer; DataSize: DWORD;
  446.   BitsPerSample: WORD);
  447.   procedure Invert8Bit;
  448.   var
  449.     pStart, pEnd: PByte;
  450.   begin
  451.     pStart := Data;
  452.     pEnd := PByte(DWORD(pStart) + DataSize - SizeOf(Byte));
  453.     while DWORD(pStart) < DWORD(pEnd) do
  454.     begin
  455.       pStart^ := pStart^ xor pEnd^;
  456.       pEnd^ := pStart^ xor pEnd^;
  457.       pStart^ := pStart^ xor pEnd^;
  458.       Inc(pStart);
  459.       Dec(pEnd);
  460.     end;
  461.   end;
  462.   procedure Invert16Bit;
  463.   var
  464.     pStart, pEnd: PSmallInt;
  465.   begin
  466.     pStart := Data;
  467.     pEnd := PSmallInt(DWORD(pStart) + DataSize - SizeOf(SmallInt));
  468.     while DWORD(pStart) < DWORD(pEnd) do
  469.     begin
  470.       pStart^ := pStart^ xor pEnd^;
  471.       pEnd^ := pStart^ xor pEnd^;
  472.       pStart^ := pStart^ xor pEnd^;
  473.       Inc(pStart);
  474.       Dec(pEnd);
  475.     end;
  476.   end;
  477. begin
  478.   case BitsPerSample of
  479.     8: Invert8Bit;
  480.     16: Invert16Bit;
  481.   end;
  482. end;
  483. // Fills the wave data with silence
  484. procedure SilenceWaveAudio(const Data: Pointer; DataSize: DWORD;
  485.   BitsPerSample: WORD);
  486. begin
  487.   case BitsPerSample of
  488.     8: FillChar(Data^, DataSize, $7F);
  489.     16: FillChar(Data^, DataSize, 0);
  490.   end;
  491. end;
  492. // Increases/Decreases the wave data volume by the specified percentage (PCM format only).
  493. procedure ChangeWaveAudioVolume(const Data: Pointer; DataSize: DWORD;
  494.   BitsPerSample: WORD; Percent: Integer);
  495.   procedure ChangeVolume8Bit;
  496.   var
  497.     pSample: PByte;
  498.     Value: Integer;
  499.   begin
  500.     pSample := Data;
  501.     while DataSize > 0 do
  502.     begin
  503.       Value := pSample^ + (pSample^ * Percent) div 100;
  504.       if Value > High(Byte) then
  505.         Value := High(Byte)
  506.       else if Value < 0 then
  507.         Value := 0;
  508.       pSample^ := Value;
  509.       Inc(pSample);
  510.       Dec(DataSize, SizeOf(Byte));
  511.     end;
  512.   end;
  513.   procedure ChangeVolume16Bit;
  514.   var
  515.     pSample: PSmallInt;
  516.     Value: Integer;
  517.   begin
  518.     pSample := Data;
  519.     while DataSize > 0 do
  520.     begin
  521.       Value := pSample^ + (pSample^ * Percent) div 100;
  522.       if Value > High(SmallInt) then
  523.         Value := High(SmallInt)
  524.       else if Value < -High(SmallInt) then
  525.         Value := -High(SmallInt);
  526.       pSample^ := Value;
  527.       Inc(pSample);
  528.       Dec(DataSize, SizeOf(SmallInt));
  529.     end;
  530.   end;
  531. begin
  532.   case BitsPerSample of
  533.     8: ChangeVolume8Bit;
  534.     16: ChangeVolume16Bit;
  535.   end;
  536. end;
  537. // Converts the wave data to the specified format. The caller is responsible to
  538. // release the memory allocated for the converted wave data buffer.
  539. function ConvertWaveFormat(const srcFormat: PWaveFormatEx; srcData: Pointer; srcDataSize: DWORD;
  540.   const dstFormat: PWaveFormatEx; out dstData: Pointer; out dstDataSize: DWORD): Boolean;
  541. var
  542.   hStream: HACMSTREAM;
  543.   Header: TACMSTREAMHEADER;
  544. begin
  545.   Result := False;
  546.   if acmStreamOpen(hStream, 0, srcFormat, dstFormat, nil, 0, 0, ACM_STREAMOPENF_NONREALTIME) = 0 then
  547.   begin
  548.     try
  549.       if acmStreamSize(hStream, srcDataSize, dstDataSize, ACM_STREAMSIZEF_SOURCE) = 0 then
  550.       begin
  551.         dstData := nil;
  552.         FillChar(Header, SizeOf(Header), 0);
  553.         ReallocMem(dstData, dstDataSize);
  554.         try
  555.           Header.cbStruct := SizeOf(Header);
  556.           Header.pbSrc := srcData;
  557.           Header.cbSrcLength := srcDataSize;
  558.           Header.pbDst := dstData;
  559.           Header.cbDstLength := dstDataSize;
  560.           if acmStreamPrepareHeader(hStream, Header, 0) = 0 then
  561.             try
  562.               Result := (acmStreamConvert(hStream, Header, ACM_STREAMCONVERTF_START or ACM_STREAMCONVERTF_END) = 0);
  563.             finally
  564.               acmStreamUnprepareHeader(hStream, Header, 0);
  565.             end;
  566.         finally
  567.           ReallocMem(dstData, Header.cbDstLengthUsed);
  568.           dstDataSize := Header.cbDstLengthUsed;
  569.         end;
  570.       end;
  571.     finally
  572.       acmStreamClose(hStream, 0);
  573.     end;
  574.   end;
  575. end;
  576. // Initializes a standard MP3 wave format header. The size of memory referenced
  577. // by the pWaveFormat parameter must not be less than the size of TWaveFormatEx
  578. // record.
  579. procedure SetMP3AudioFormat(const pWaveFormat: PWaveFormatEx;
  580.   Channels: TPCMChannel; SamplesPerSec: TPCMSamplesPerSec;
  581.   BitsPerSample: TPCMBitsPerSample);
  582. begin
  583. {
  584.         .nChannels = wfxIN.nChannels
  585.         .nSamplesPerSec = wfxIN.nSamplesPerSec
  586.         .wFormatTag = WAVE_FORMAT_MPEGLAYER3}
  587.   with pWaveFormat^ do
  588.   begin
  589.     wFormatTag := WAVE_FORMAT_MPEGLAYER3;
  590.     case Channels of
  591.       cMono: nChannels := 1;
  592.       cStereo: nChannels := 2;
  593.     end;
  594.     case SamplesPerSec of
  595.       ss8000Hz: nSamplesPerSec := 8000;
  596.       ss11025Hz: nSamplesPerSec := 11025;
  597.       ss22050Hz: nSamplesPerSec := 22050;
  598.       ss44100Hz: nSamplesPerSec := 44100;
  599.       ss48000Hz: nSamplesPerSec := 48000;
  600.     end;
  601.  {   case BitsPerSample of
  602.       bs8Bit: wBitsPerSample := 8;
  603.       bs16Bit: wBitsPerSample := 16;
  604.     end;
  605.     nBlockAlign := MulDiv(nChannels, wBitsPerSample, 8);
  606.     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  607.     cbSize := 0; }
  608.   end;
  609. end;
  610. // Initializes a standard MP3 wave format header (shorcut form). The size of
  611. // memory referenced by the pWaveFormat parameter must not be less than the
  612. // size of TWaveFormatEx record.
  613. procedure SetMP3AudioFormatS(const pWaveFormat: PWaveFormatEx; PCMFormat: TPCMFormat);
  614. begin
  615.   case PCMFormat of
  616.     Mono8Bit8000Hz:
  617.       SetMP3AudioFormat(pWaveFormat, cMono, ss8000Hz, bs8Bit);
  618.     Mono8Bit11025Hz:
  619.       SetMP3AudioFormat(pWaveFormat, cMono, ss11025Hz, bs8Bit);
  620.     Mono8Bit22050Hz:
  621.       SetMP3AudioFormat(pWaveFormat, cMono, ss22050Hz, bs8Bit);
  622.     Mono8Bit44100Hz:
  623.       SetMP3AudioFormat(pWaveFormat, cMono, ss44100Hz, bs8Bit);
  624.     Mono8Bit48000Hz:
  625.       SetMP3AudioFormat(pWaveFormat, cMono, ss48000Hz, bs8Bit);
  626.     Mono16Bit8000Hz:
  627.       SetMP3AudioFormat(pWaveFormat, cMono, ss8000Hz, bs16Bit);
  628.     Mono16Bit11025Hz:
  629.       SetMP3AudioFormat(pWaveFormat, cMono, ss11025Hz, bs16Bit);
  630.     Mono16Bit22050Hz:
  631.       SetMP3AudioFormat(pWaveFormat, cMono, ss22050Hz, bs16Bit);
  632.     Mono16Bit44100Hz:
  633.       SetMP3AudioFormat(pWaveFormat, cMono, ss44100Hz, bs16Bit);
  634.     Mono16Bit48000Hz:
  635.       SetMP3AudioFormat(pWaveFormat, cMono, ss48000Hz, bs16Bit);
  636.     Stereo8bit8000Hz:
  637.       SetMP3AudioFormat(pWaveFormat, cStereo, ss8000Hz, bs8Bit);
  638.     Stereo8bit11025Hz:
  639.       SetMP3AudioFormat(pWaveFormat, cStereo, ss11025Hz, bs8Bit);
  640.     Stereo8bit22050Hz:
  641.       SetMP3AudioFormat(pWaveFormat, cStereo, ss22050Hz, bs8Bit);
  642.     Stereo8bit44100Hz:
  643.       SetMP3AudioFormat(pWaveFormat, cStereo, ss44100Hz, bs8Bit);
  644.     Stereo8bit48000Hz:
  645.       SetMP3AudioFormat(pWaveFormat, cStereo, ss48000Hz, bs8Bit);
  646.     Stereo16bit8000Hz:
  647.       SetMP3AudioFormat(pWaveFormat, cStereo, ss8000Hz, bs16Bit);
  648.     Stereo16bit11025Hz:
  649.       SetMP3AudioFormat(pWaveFormat, cStereo, ss11025Hz, bs16Bit);
  650.     Stereo16bit22050Hz:
  651.       SetMP3AudioFormat(pWaveFormat, cStereo, ss22050Hz, bs16Bit);
  652.     Stereo16bit44100Hz:
  653.       SetMP3AudioFormat(pWaveFormat, cStereo, ss44100Hz, bs16Bit);
  654.     Stereo16bit48000Hz:
  655.       SetMP3AudioFormat(pWaveFormat, cStereo, ss48000Hz, bs16Bit);
  656.   end;
  657. end;
  658. // Returns the standard MP3 format specifier of a wave format.
  659. function GetMP3AudioFormat(const pWaveFormat: PWaveFormatEx): TPCMFormat;
  660. begin
  661.   Result := nonePCM;
  662.   with pWaveFormat^ do
  663.     if wFormatTag = WAVE_FORMAT_MPEGLAYER3 then
  664.     begin
  665.       if (nChannels = 1) and (nSamplesPerSec = 8000) and (wBitsPerSample = 8) then
  666.         Result := Mono8Bit8000Hz
  667.       else if (nChannels = 2) and (nSamplesPerSec = 8000) and (wBitsPerSample = 8) then
  668.         Result := Stereo8Bit8000Hz
  669.       else if (nChannels = 1) and (nSamplesPerSec = 8000) and (wBitsPerSample = 16) then
  670.         Result := Mono16bit8000Hz
  671.       else if (nChannels = 2) and (nSamplesPerSec = 8000) and (wBitsPerSample = 16) then
  672.         Result := Stereo16Bit8000Hz
  673.       else if (nChannels = 1) and (nSamplesPerSec = 11025) and (wBitsPerSample = 8) then
  674.         Result := Mono8Bit11025Hz
  675.       else if (nChannels = 2) and (nSamplesPerSec = 11025) and (wBitsPerSample = 8) then
  676.         Result := Stereo8Bit11025Hz
  677.       else if (nChannels = 1) and (nSamplesPerSec = 11025) and (wBitsPerSample = 16) then
  678.         Result := Mono16bit11025Hz
  679.       else if (nChannels = 2) and (nSamplesPerSec = 11025) and (wBitsPerSample = 16) then
  680.         Result := Stereo16Bit11025Hz
  681.       else if (nChannels = 1) and (nSamplesPerSec = 22050) and (wBitsPerSample = 8) then
  682.         Result := Mono8Bit22050Hz
  683.       else if (nChannels = 2) and (nSamplesPerSec = 22050) and (wBitsPerSample = 8) then
  684.         Result := Stereo8Bit22050Hz
  685.       else if (nChannels = 1) and (nSamplesPerSec = 22050) and (wBitsPerSample = 16) then
  686.         Result := Mono16bit22050Hz
  687.       else if (nChannels = 2) and (nSamplesPerSec = 22050) and (wBitsPerSample = 16) then
  688.         Result := Stereo16Bit22050Hz
  689.       else if (nChannels = 1) and (nSamplesPerSec = 44100) and (wBitsPerSample = 8) then
  690.         Result := Mono8Bit44100Hz
  691.       else if (nChannels = 2) and (nSamplesPerSec = 44100) and (wBitsPerSample = 8) then
  692.         Result := Stereo8Bit44100Hz
  693.       else if (nChannels = 1) and (nSamplesPerSec = 44100) and (wBitsPerSample = 16) then
  694.         Result := Mono16bit44100Hz
  695.       else if (nChannels = 2) and (nSamplesPerSec = 44100) and (wBitsPerSample = 16) then
  696.         Result := Stereo16Bit44100Hz
  697.       else if (nChannels = 1) and (nSamplesPerSec = 48000) and (wBitsPerSample = 8) then
  698.         Result := Mono8Bit48000Hz
  699.       else if (nChannels = 2) and (nSamplesPerSec = 48000) and (wBitsPerSample = 8) then
  700.         Result := Stereo8Bit48000Hz
  701.       else if (nChannels = 1) and (nSamplesPerSec = 48000) and (wBitsPerSample = 16) then
  702.         Result := Mono16bit48000Hz
  703.       else if (nChannels = 2) and (nSamplesPerSec = 48000) and (wBitsPerSample = 16) then
  704.         Result := Stereo16Bit48000Hz
  705.     end;
  706. end;
  707. // Initializes a standard PCM wave format header. The size of memory referenced
  708. // by the pWaveFormat parameter must not be less than the size of TWaveFormatEx
  709. // record.
  710. procedure SetPCMAudioFormat(const pWaveFormat: PWaveFormatEx;
  711.   Channels: TPCMChannel; SamplesPerSec: TPCMSamplesPerSec;
  712.   BitsPerSample: TPCMBitsPerSample);
  713. begin
  714.   with pWaveFormat^ do
  715.   begin
  716.     wFormatTag := WAVE_FORMAT_PCM;
  717.     case Channels of
  718.       cMono: nChannels := 1;
  719.       cStereo: nChannels := 2;
  720.     end;
  721.     case SamplesPerSec of
  722.       ss8000Hz: nSamplesPerSec := 8000;
  723.       ss11025Hz: nSamplesPerSec := 11025;
  724.       ss22050Hz: nSamplesPerSec := 22050;
  725.       ss44100Hz: nSamplesPerSec := 44100;
  726.       ss48000Hz: nSamplesPerSec := 48000;
  727.     end;
  728.     case BitsPerSample of
  729.       bs8Bit: wBitsPerSample := 8;
  730.       bs16Bit: wBitsPerSample := 16;
  731.     end;
  732.     nBlockAlign := MulDiv(nChannels, wBitsPerSample, 8);
  733.     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  734.     cbSize := 0;
  735.   end;
  736. end;
  737. // Initializes a standard PCM wave format header (shorcut form). The size of
  738. // memory referenced by the pWaveFormat parameter must not be less than the
  739. // size of TWaveFormatEx record.
  740. procedure SetPCMAudioFormatS(const pWaveFormat: PWaveFormatEx; PCMFormat: TPCMFormat);
  741. begin
  742.   case PCMFormat of
  743.     Mono8Bit8000Hz:
  744.       SetPCMAudioFormat(pWaveFormat, cMono, ss8000Hz, bs8Bit);
  745.     Mono8Bit11025Hz:
  746.       SetPCMAudioFormat(pWaveFormat, cMono, ss11025Hz, bs8Bit);
  747.     Mono8Bit22050Hz:
  748.       SetPCMAudioFormat(pWaveFormat, cMono, ss22050Hz, bs8Bit);
  749.     Mono8Bit44100Hz:
  750.       SetPCMAudioFormat(pWaveFormat, cMono, ss44100Hz, bs8Bit);
  751.     Mono8Bit48000Hz:
  752.       SetPCMAudioFormat(pWaveFormat, cMono, ss48000Hz, bs8Bit);
  753.     Mono16Bit8000Hz:
  754.       SetPCMAudioFormat(pWaveFormat, cMono, ss8000Hz, bs16Bit);
  755.     Mono16Bit11025Hz:
  756.       SetPCMAudioFormat(pWaveFormat, cMono, ss11025Hz, bs16Bit);
  757.     Mono16Bit22050Hz:
  758.       SetPCMAudioFormat(pWaveFormat, cMono, ss22050Hz, bs16Bit);
  759.     Mono16Bit44100Hz:
  760.       SetPCMAudioFormat(pWaveFormat, cMono, ss44100Hz, bs16Bit);
  761.     Mono16Bit48000Hz:
  762.       SetPCMAudioFormat(pWaveFormat, cMono, ss48000Hz, bs16Bit);
  763.     Stereo8bit8000Hz:
  764.       SetPCMAudioFormat(pWaveFormat, cStereo, ss8000Hz, bs8Bit);
  765.     Stereo8bit11025Hz:
  766.       SetPCMAudioFormat(pWaveFormat, cStereo, ss11025Hz, bs8Bit);
  767.     Stereo8bit22050Hz:
  768.       SetPCMAudioFormat(pWaveFormat, cStereo, ss22050Hz, bs8Bit);
  769.     Stereo8bit44100Hz:
  770.       SetPCMAudioFormat(pWaveFormat, cStereo, ss44100Hz, bs8Bit);
  771.     Stereo8bit48000Hz:
  772.       SetPCMAudioFormat(pWaveFormat, cStereo, ss48000Hz, bs8Bit);
  773.     Stereo16bit8000Hz:
  774.       SetPCMAudioFormat(pWaveFormat, cStereo, ss8000Hz, bs16Bit);
  775.     Stereo16bit11025Hz:
  776.       SetPCMAudioFormat(pWaveFormat, cStereo, ss11025Hz, bs16Bit);
  777.     Stereo16bit22050Hz:
  778.       SetPCMAudioFormat(pWaveFormat, cStereo, ss22050Hz, bs16Bit);
  779.     Stereo16bit44100Hz:
  780.       SetPCMAudioFormat(pWaveFormat, cStereo, ss44100Hz, bs16Bit);
  781.     Stereo16bit48000Hz:
  782.       SetPCMAudioFormat(pWaveFormat, cStereo, ss48000Hz, bs16Bit);
  783.   end;
  784. end;
  785. // Returns the standard PCM format specifier of a wave format.
  786. function GetPCMAudioFormat(const pWaveFormat: PWaveFormatEx): TPCMFormat;
  787. begin
  788.   Result := nonePCM;
  789.   with pWaveFormat^ do
  790.     if wFormatTag = WAVE_FORMAT_PCM then
  791.     begin
  792.       if (nChannels = 1) and (nSamplesPerSec = 8000) and (wBitsPerSample = 8) then
  793.         Result := Mono8Bit8000Hz
  794.       else if (nChannels = 2) and (nSamplesPerSec = 8000) and (wBitsPerSample = 8) then
  795.         Result := Stereo8Bit8000Hz
  796.       else if (nChannels = 1) and (nSamplesPerSec = 8000) and (wBitsPerSample = 16) then
  797.         Result := Mono16bit8000Hz
  798.       else if (nChannels = 2) and (nSamplesPerSec = 8000) and (wBitsPerSample = 16) then
  799.         Result := Stereo16Bit8000Hz
  800.       else if (nChannels = 1) and (nSamplesPerSec = 11025) and (wBitsPerSample = 8) then
  801.         Result := Mono8Bit11025Hz
  802.       else if (nChannels = 2) and (nSamplesPerSec = 11025) and (wBitsPerSample = 8) then
  803.         Result := Stereo8Bit11025Hz
  804.       else if (nChannels = 1) and (nSamplesPerSec = 11025) and (wBitsPerSample = 16) then
  805.         Result := Mono16bit11025Hz
  806.       else if (nChannels = 2) and (nSamplesPerSec = 11025) and (wBitsPerSample = 16) then
  807.         Result := Stereo16Bit11025Hz
  808.       else if (nChannels = 1) and (nSamplesPerSec = 22050) and (wBitsPerSample = 8) then
  809.         Result := Mono8Bit22050Hz
  810.       else if (nChannels = 2) and (nSamplesPerSec = 22050) and (wBitsPerSample = 8) then
  811.         Result := Stereo8Bit22050Hz
  812.       else if (nChannels = 1) and (nSamplesPerSec = 22050) and (wBitsPerSample = 16) then
  813.         Result := Mono16bit22050Hz
  814.       else if (nChannels = 2) and (nSamplesPerSec = 22050) and (wBitsPerSample = 16) then
  815.         Result := Stereo16Bit22050Hz
  816.       else if (nChannels = 1) and (nSamplesPerSec = 44100) and (wBitsPerSample = 8) then
  817.         Result := Mono8Bit44100Hz
  818.       else if (nChannels = 2) and (nSamplesPerSec = 44100) and (wBitsPerSample = 8) then
  819.         Result := Stereo8Bit44100Hz
  820.       else if (nChannels = 1) and (nSamplesPerSec = 44100) and (wBitsPerSample = 16) then
  821.         Result := Mono16bit44100Hz
  822.       else if (nChannels = 2) and (nSamplesPerSec = 44100) and (wBitsPerSample = 16) then
  823.         Result := Stereo16Bit44100Hz
  824.       else if (nChannels = 1) and (nSamplesPerSec = 48000) and (wBitsPerSample = 8) then
  825.         Result := Mono8Bit48000Hz
  826.       else if (nChannels = 2) and (nSamplesPerSec = 48000) and (wBitsPerSample = 8) then
  827.         Result := Stereo8Bit48000Hz
  828.       else if (nChannels = 1) and (nSamplesPerSec = 48000) and (wBitsPerSample = 16) then
  829.         Result := Mono16bit48000Hz
  830.       else if (nChannels = 2) and (nSamplesPerSec = 48000) and (wBitsPerSample = 16) then
  831.         Result := Stereo16Bit48000Hz
  832.     end;
  833. end;
  834. // Converts milliseconds to string
  835. function MS2Str(Milliseconds: DWORD; Fmt: TMS2StrFormat): String;
  836. var
  837.   HSecs, Secs, Mins, Hours: DWORD;
  838. begin
  839.   HSecs := Milliseconds div 10;
  840.   Secs := HSecs div 100;
  841.   Mins := Secs div 60;
  842.   Hours := Mins div 60;
  843.   if Fmt in [msAh, msA] then
  844.   begin
  845.     if Hours <> 0 then
  846.       if Fmt = msAh then Fmt := msHMSh  else Fmt := msHMS
  847.     else if Mins <> 0 then
  848.       if Fmt = msAh then Fmt := msMSh else Fmt := msMS
  849.     else
  850.       if Fmt = msAh then Fmt := msSh else Fmt := msS
  851.   end;
  852.   case Fmt of
  853.     msHMSh:
  854.       Result := Format('%u%s%2.2u%s%2.2u%s%2.2u',
  855.         [Hours, TimeSeparator, Mins mod 60, TimeSeparator, Secs mod 60, DecimalSeparator, HSecs mod 100]);
  856.     msHMS:
  857.       Result := Format('%u%s%2.2u%s%2.2u',
  858.         [Hours, TimeSeparator, Mins mod 60, TimeSeparator, Secs mod 60]);
  859.     msMSh:
  860.       Result := Format('%u%s%2.2u%s%2.2u',
  861.         [Mins, TimeSeparator, Secs mod 60, DecimalSeparator, HSecs mod 100]);
  862.     msMS:
  863.       Result := Format('%u%s%2.2u',
  864.         [Mins, TimeSeparator, Secs mod 60]);
  865.     msSh:
  866.       Result := Format('%u%s%2.2u',
  867.         [Secs, DecimalSeparator, HSecs mod 100]);
  868.     msS:
  869.       Result := Format('%u', [Secs]);
  870.   else
  871.     Result := IntToStr(Milliseconds);
  872.   end;
  873. end;
  874. // Waits for the scnchronize object while lets the caller thread processes
  875. // its messages.
  876. function WaitForSyncObject(SyncObject: THandle; Timeout: DWORD): DWORD;
  877. const
  878.   EVENTMASK = QS_PAINT or QS_TIMER or QS_SENDMESSAGE or QS_POSTMESSAGE;
  879. var
  880.   Msg: TMsg;
  881.   StartTime: DWORD;
  882.   EllapsedTime: DWORD;
  883.   Handle: THandle;
  884. begin
  885.   Handle := SyncObject;
  886.   if (SyncObject = GetCurrentThread) or (SyncObject = GetCurrentProcess) then
  887.     DuplicateHandle(GetCurrentProcess, SyncObject, GetCurrentProcess, @Handle, SYNCHRONIZE, False, 0);
  888.   try
  889.     repeat
  890.       StartTime := GetTickCount;
  891.       Result := MsgWaitForMultipleObjects(1, Handle, False, Timeout, EVENTMASK);
  892.       if Result = WAIT_OBJECT_0 + 1 then
  893.       begin
  894.         while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
  895.         begin
  896.           if ((Msg.message < WM_KEYFIRST) or (Msg.message > WM_KEYLAST)) and
  897.              ((Msg.message < WM_MOUSEFIRST) or (Msg.message > WM_MOUSELAST)) then
  898.           begin
  899.             TranslateMessage(Msg);
  900.             DispatchMessage(Msg);
  901.             if Msg.message = WM_QUIT then Exit;
  902.           end;
  903.         end;
  904.         if Timeout <> INFINITE then
  905.         begin
  906.           EllapsedTime := GetTickCount - StartTime;
  907.           if EllapsedTime < Timeout then
  908.             Dec(Timeout, EllapsedTime)
  909.           else
  910.             Timeout := 0;
  911.         end;
  912.       end;
  913.     until Result <> WAIT_OBJECT_0 + 1;
  914.   finally
  915.     if SyncObject <> Handle then
  916.       CloseHandle(Handle);
  917.   end;
  918. end;
  919. end.