Rabu, 05 Juni 2013

[Delphi] Sound Record


Berikut saya share source code untuk merekam suara dengan Delphi (versi Delphi yang saya pakai adalah versi 7). Program ini merekam suara menggunakan microphone yang biasanya terdapat pada notebook, menggunakan fungsi mciSendString yang mengirim pesan ke mic device untuk merekam dan menyimpan suara.

Format ekstensi rekaman suara adalah *.wav, bagi yang mau mencoba dan mengembangkan,silahkan simak source code berikut atau bisa download projectnya dan sample hasil rekaman (via sendspace)

Link Download
Google Drive

Pada project ini menggunakan 4 TButton, 5 TLabel, 1 TTimer dan 1 TSaveDialog,
Source Code:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, mmSystem, ExtCtrls, StdCtrls;

type 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    Label3: TLabel;
    Label4: TLabel;
    Button4: TButton;
    SaveDialog1: TSaveDialog;
    Label5: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

    // Record
procedure TForm1.Button1Click(Sender: TObject);
    begin

    Label2.Caption:='0';                     //Sets label2 to 0 duh


    Timer1.Enabled:=true;                    //Turns timer1 on so you know
                                             //how long you'v been recording


    Label1.Caption:='Rocording started';    //Changes label1 so you know
                                            //its recording ;)
                                            

    mciSendString('OPEN NEW TYPE WAVEAUDIO ALIAS MicSound', nil, 0, Handle);

    // MicSound is what the WaveAudio is asigned to.
    // It is used in all the mciSendString so if you
    // rename it to a diffrent name then you need to
    // make sure you change it on all of them.
    // If you dont know what I just said..
    // hell I dont think I know what i just said
    // then leave it the way it is, it will work ether way.
    
    // The Following is pritty much self explanatory but I put
    // the Notes out for those who dont follow.
    mciSendString('SET MicSound TIME FORMAT MS ' +      // set the time format
        'BITSPERSAMPLE 8 ' +                            // 8 Bit
        'CHANNELS 1 ' +                                 // MONO
        'SAMPLESPERSEC 8000 ' +                         // 8 KHz
        'BYTESPERSEC 8000',                             // 8000 Bytes/s
        nil, 0, Handle);
    mciSendString('RECORD MicSound', nil, 0, Handle);
    end;

    // Stop Record
 procedure TForm1.Button2Click(Sender: TObject);
    begin
    Timer1.Enabled:=false;   //Stops the timer
    mciSendString('STOP MicSound', nil, 0, Handle);
    end;

    // Save Wave File
procedure TForm1.Button3Click(Sender: TObject);
    begin
    mciSendString(PChar('SAVE MicSound ' + 'C:\sample.wav'), nil, 0, Handle);
    mciSendString('CLOSE MicSound', nil, 0, Handle);
    Label1.Caption:='Wave file saved to C:\sample.wav'; //Lets you know its saved :P
    end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var
p1 : integer;

begin
p1:=strtoint(label2.caption);  
label2.Caption:= inttostr(p1 + 1); 
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
 if SaveDialog1.Execute then
    mciSendString(PChar('SAVE MicSound ' + SaveDialog1.filename), nil, 0, Handle);
    mciSendString('CLOSE MicSound', nil, 0, Handle);
    Label1.Caption:='Wave file saved to ' + SaveDialog1.filename; 

end;

end.

referensi :
http://msdn.microsoft.com/en-us/library/windows/desktop/dd757161(v=vs.85).aspx

Oia berhubung bukan saya yang membuatnya,maka saya tidak bisa menjelaskan lebih lanjutt..hehe

Semoga Bermanfaat

Artikel ini dibuat oleh Yudha Tri Putra sebagai penulis artikel, diperbolehkan menyalin artikel ini secara utuh tanpa mengubah atau menambah isi artikel.

1 komentar:

(C) 2018. Diberdayakan oleh Blogger.

Categories

Followers