На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Снятие звука с микрофона , отображение звуковые данных в виде графика
    Guru Rouse_
    Сообщ. #1 ,

      Moderator
      *******
      Профиль · PM
      Поощрения: 4 Dgm
      Рейтинг (т): 320
      ExpandedWrap disabled
        unit Unit1;
         
        interface
         
        uses
          Windows, Messages, SysUtils, Classes, Graphics, Forms,
          Dialogs, MMSystem;
         
        type
          TWavArrayBuf = array[0..1023]of byte;
          PWavArrayBuf = ^TWavArrayBuf;
         
          TForm1 = class(TForm)
            procedure FormCreate(Sender: TObject);
            procedure FormClose(Sender: TObject; var Action: TCloseAction);
          private
            WaveFormat: TWaveFormatEx;
            WaveIn: PHWaveIn;
            procedure WndProc(var Msg: TMessage); override;
            function InitWaveIn: Boolean;
            procedure CloseWaveIn;
          end;
         
        var
          Form1: TForm1;
         
        implementation
         
        uses Math;
         
        {$R *.dfm}
         
        function TForm1.InitWaveIn: Boolean;
        var
          I, Err: Integer;
          WaveHdr: PWaveHdr;
          WavBuff: PWavArrayBuf;
         
          procedure FreeData;
          begin
            if WavBuff <> nil then Dispose(WavBuff);
            if WaveHdr <> nil then Dispose(WaveHdr);
            if WaveIn <> nil then Dispose(WaveIn);
          end;
         
        begin
          Result := False;
          WaveFormat.wFormatTag := WAVE_FORMAT_PCM;
          WaveFormat.nChannels := 1;
          WaveFormat.nSamplesPerSec := 44100;
          WaveFormat.nAvgBytesPerSec := 44100;
          WaveFormat.nBlockAlign := 4;
          WaveFormat.wBitsPerSample := 8;
          WaveIn := New(PHWaveIn);
          Err := WaveInOpen(WaveIn, 0, @WaveFormat, Handle, 0, CALLBACK_WINDOW);
          if Err <> 0 then Exit;
          for i:=1 to 8 do
          begin
            WavBuff := New(PWavArrayBuf);
            WaveHdr := New(PWaveHdr);
            with WaveHdr^ do
            begin
              lpData := Pointer(WavBuff);
              dwBufferLength := SizeOf(WavBuff);
              dwBytesRecorded := 0;
              dwUser := 0;
              dwFlags := 0;
              dwLoops := 0;
            end;
            Err := WaveInPrepareHeader(WaveIn^, WaveHdr, SizeOf(TWaveHdr));
            if Err <> 0 then
            begin
              FreeData;
              Exit;
            end;
            Err := WaveInAddBuffer(WaveIn^, WaveHdr, Sizeof(TWaveHdr));
            if Err <> 0 then
            begin
              FreeData;
              Exit;
            end;
          end;
          Err := WaveInStart(WaveIn^);
          if Err <> 0 then
          begin
            FreeData;
            Exit;
          end;
          Result := True;
        end;
         
        Procedure Tform1.WndProc(var Msg: TMessage);
        var
          Hdr: PWaveHdr;
          I: Integer;
          R: Real;
        begin
          inherited;
          case Msg.Msg of
            MM_WIM_DATA:
            begin
              Hdr := PWaveHdr(Msg.LParam);
              if Hdr^.dwBytesRecorded = 0 then Exit;
              R := IfThen(Hdr^.dwBytesRecorded > 0,
                ClientWidth / Hdr^.dwBytesRecorded, 0);
              PatBlt(Canvas.Handle, 0, 0, ClientWidth,  ClientHeight, PATCOPY);
              Canvas.Pen.Color:=clRed;
              Canvas.MoveTo(0, 127);
              Canvas.LineTo(ClientWidth, 127);
              Canvas.Pen.Color := clMaroon;
              for I := 1 to 12 do
              begin
                Canvas.MoveTo(Round(R * (I * 100)), 0);
                Canvas.LineTo(Round(R * (I * 100)), 255);
              end;
              Canvas.Pen.Color:=clLime;
              Canvas.MoveTo(0, PWavArrayBuf(Hdr.lpData)^[0]);
              for I := 0 to Hdr^.dwBytesRecorded - 1 do
                Canvas.LineTo(Round(R * I), PWavArrayBuf(Hdr.lpData)^[I]);
         
              WaveInUnprepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));
              Dispose(hdr.lpData);
              DisPose(hdr);
         
              Hdr := New(PWaveHdr);
              Hdr^.lpData := Pointer(New(PWavArrayBuf));
              Hdr^.dwBufferLength := 1024;
              Hdr^.dwBytesRecorded := 0;
              Hdr^.dwUser := 0;
              Hdr^.dwFlags := 0;
              Hdr^.dwLoops := 0;
         
              WaveInPrepareHeader(WaveIn^, Hdr, Sizeof(TWaveHdr));
              WaveInAddBuffer(WaveIn^, Hdr, Sizeof(TWaveHdr));
            end;
          end;
        end;
         
        procedure TForm1.CloseWaveIn;
        begin
          WaveInStop(WaveIn^);
          if WaveIn <> nil then
          begin
            WaveInReset(WaveIn^);
            WaveInClose(WaveIn^);
          end;
          Dispose(WaveIn);
        end;
         
        procedure TForm1.FormCreate(Sender: TObject);
        begin
          DoubleBuffered := True;
          Height := 282;
          Width := 1000;
          Color := clBlack;
          if not InitWaveIn then ShowMessage(SysErrorMessage(GetLastError));
        end;
         
        procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
        begin
          CloseWaveIn;
        end;
         
        end.


      Автор: Rouse_
      1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0162 ]   [ 15 queries used ]   [ Generated: 15.05.24, 02:30 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.