Программа записи с микрофона+воспроизведение записанного

[Фанат_Муравьева]

Здравствуйте Уважаемые форумчане.
Меня не забанили в гугле, я еще помню, как выглядит яндекс, я посмотрел здесь много тем, но не смог найти то что мне нужно. Хотя с этой проблемой, наверно, многие сталкивались.
А именно как записывать звук с микрофона? и как его потом воспроизвести?.

Поясню что мне нужно. Я хочу написать (громко сказано) для себя программу, чтобы по нажатию на левую кнопку мыши, она записывала звук, по нажатию на правую кнопку - воспроизводила записанный файл(с многократным повторением подряд). И всё!

Приму с благодарностью любой совет/ссылку/код относительно реализации данной идеи.

Заранее спасибо.

[DIgorevich]

Посмотри тут
Для себя подберешь нужный вариант

[Фанат_Муравьева]

Сообщение от DIgorevich

Посмотри тут
Для себя подберешь нужный вариант

Спасибо! иду смотреть.

[Фанат_Муравьева]

Спасибо, нашел то что нужно, вот мой кусок.
Музыка играет в одном случае (нажали).
как сделать, чтобы после еще одного нажатия, музыка прекращала играть?
Вот код

procedure TForm1.FormClick(Sender: TObject);
begin
inc(a); //a==1;
if (a mod 2<>0) then
begin ///Здесь не должна играть.
OpenMedia;
RecordMedia;
end
else
begin // а здесь играет как надо.
StopMedia;
SaveMedia;
CloseMedia;
PlaySound('c:\message.wav', 0, SND_ASYNC or SND_LOOP); //многократное повторение критично.
end;
end;

Команда PlaySound('c:\message.wav', 0, SND_PURGE); привела к зависанию. (Или у меня что-то 3 раза подряд заглючило).

Заранее спасибо!

[DIgorevich]

Желательно, конечно, полный код посмотреть... А команда SaveMedia куда сохраняет?

[Фанат_Муравьева]

Собственно я пошел туда, куда Вы меня послали ()
http://delphiworld.narod.ru/base/cre...wave_file.html

Код был тупо скопирован. Потом в угоду своим желаниям, я снёс 2 батонки, и сделал всё по одному клику (этот кусок приведен выше).

Всё отлично работает, да только вот музыка играет без остановки, даже когда я хочу записать новый кусок. то есть по then'y желательно сперва отключить воспроизведение, а потом уже включать запись нового сигнала.

[DIgorevich]

А что проигрывать обязательно с помощью PlaySound? Можно просто MediaPlayer использовать.

[Фанат_Муравьева]

Сообщение от DIgorevich

А что проигрывать обязательно с помощью PlaySound? Можно просто MediaPlayer использовать.

)) нет. Я просто как мог, что нагуглил, что могучим копи-пастом навставлял - то и сделал, и оно заработало, чем доставило мне непередаваемую радость.

Собственно я не против и как-то по-другому всё это дело сделать, главное чтобы оно работало Сможет ли
MediaPlayer пока не устанет повторять один и тот же трек? И если есть простая в этом отношении реализация - то совсем хорошо!

[DIgorevich]

Можно всё... приведи полностью код, со всеми переменными (объявлениями и т.д.), я тебе подправлю.

[Фанат_Муравьева]

О! Спасибо ) Выглядит здесь он ужасно.

unit  unit1;
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, MPlayer, MMSystem, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure AppException(Sender: TObject; E: Exception);
    procedure FormClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
    FDeviceID: Word;
    { Private declarations }
  public
    procedure OpenMedia;
    procedure RecordMedia;
    procedure StopMedia;
    procedure SaveMedia;
    procedure CloseMedia;
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.DFM}

var
  MyError, Flags: Longint;
  a:int64;

procedure TForm1.OpenMedia;
var
  MyOpenParms: TMCI_Open_Parms;
  MyPChar: PChar;
  TextLen: Longint;
begin
  Flags := mci_Wait or mci_Open_Element or mci_Open_Type;
  with MyOpenParms do
  begin
    dwCallback := Handle; // TForm1.Handle
    lpstrDeviceType := PChar('WaveAudio');
    lpstrElementName := PChar('');
  end;
  MyError := mciSendCommand(0, mci_Open, Flags,
    Longint(@MyOpenParms));
  if MyError = 0 then
    FDeviceID := MyOpenParms.wDeviceID;
end;

procedure TForm1.RecordMedia;
var
  MyRecordParms: TMCI_Record_Parms;
  TextLen: Longint;
begin
  Flags := mci_Notify;
  with MyRecordParms do
  begin
    dwCallback := Handle; // TForm1.Handle
    dwFrom := 0;
    dwTo := 10000;
  end;
  MyError := mciSendCommand(FDeviceID, mci_Record, Flags,
    Longint(@MyRecordParms));
end;

procedure TForm1.StopMedia;
var
  MyGenParms: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    Flags := mci_Wait;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Stop, Flags,
      Longint(@MyGenParms));
  end;
end;

procedure TForm1.SaveMedia;
type // не реализовано в Delphi
  PMCI_Save_Parms = ^TMCI_Save_Parms;
  TMCI_Save_Parms = record
    dwCallback: DWord;
    lpstrFileName: PAnsiChar; // имя файла, который нужно сохранить
  end;
var
  MySaveParms: TMCI_Save_Parms;
begin
  if FDeviceID <> 0 then
  begin
    // сохраняем файл...
    Flags := mci_Save_File or mci_Wait;
    with MySaveParms do
    begin
      dwCallback := Handle;
      lpstrFileName := PChar('c:\message.wav');
    end;
    MyError := mciSendCommand(FDeviceID, mci_Save, Flags,
      Longint(@MySaveParms));
  end;
end;

procedure TForm1.CloseMedia;
var
  MyGenParms: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    Flags := 0;
    MyGenParms.dwCallback := Handle; // TForm1.Handle
    MyError := mciSendCommand(FDeviceID, mci_Close, Flags,
      Longint(@MyGenParms));
    if MyError = 0 then
      FDeviceID := 0;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  OpenMedia;
  RecordMedia;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  StopMedia;
  SaveMedia;
  CloseMedia;
  PlaySound('c:\message.wav', 0, SND_ASYNC or SND_LOOP);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := AppException;
a:=0;
end;

procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  CloseMedia;
end;
                     
procedure TForm1.FormClick(Sender: TObject); // Основной фрагмент\\
begin
inc(a);
 if (a mod 2<>0) then  
                      begin
                      Label1.Caption:='Запись пошла!';
                      OpenMedia;
                      RecordMedia;
                      end
                 else
                      begin
                      Label1.Caption:='Воспроизведение';
                      StopMedia;
                      SaveMedia;
                      CloseMedia;
           PlaySound('c:\message.wav', 0, SND_ASYNC or SND_LOOP);
                       end;
end;

//дальше уже к мейн меню идет.
procedure TForm1.N2Click(Sender: TObject);
begin
ExitProcess(0);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
close;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
Form2.Visible:=True;
end;

end.