saya mo nanya lagi nih. bagaimana source code agar suara dari soundcard keluar melalui sisi left & right pada headset. d tunggu bantuannya, makasih. :D

Anda sudah sampai mana codingnya ..... ? tolong di cantumkan dunk .... !!!

Terimakasih sarannya. di bawah ini source code software ToneBurst. pada software ToneBurst terdapat 2 buah unit yang digunakan yaitu unit MainForm dan unit Beeper. Yang ingin saya modifikasi adalah dengan menambahkan output (suara) yang keluar berupa dua channel (kanan dan kiri), dengan menggunakan komponen radiobutton yang itemindex nya kanan dan kiri. adakah yang bisa membantu? dengan source code atau alamat situs-situs yang berkaitan. unit MainForm; { 2000 Apr 11 1.0.0 Simple sinewave generator 2000 Aug 11 1.1.0 Derived toneburst generator Make generator a separate unit, Beeper 2001 Jul 16 1.2.0 Version for Delphi 5 2002 Dec 07 1.4.0 Add Risetime/Falltime, and Amplitude properties Now needs Math unit Copyright © David J Taylor, Edinburgh Web site: www.satsignal.net E-mail: davidtaylor@writeme.com } interface uses SysUtils, Controls, Forms, Beeper, Classes, StdCtrls, ComCtrls; type TFormMain = class(TForm) ScrollBarFrequency: TScrollBar; Label1: TLabel; LabelFreq: TLabel; ButtonClose: TButton; ScrollBarDuration: TScrollBar; Label2: TLabel; LabelDuration: TLabel; ButtonGo: TButton; CheckBoxDeclick: TCheckBox; UpDownAmplitude: TUpDown; EditdB: TEdit; LabeldB: TLabel; LabelAmplitude: TLabel; procedure ButtonGoClick (Sender: TObject); procedure ButtonCloseClick (Sender: TObject); procedure FormCloseQuery (Sender: TObject; var CanClose: Boolean); procedure FormCreate (Sender: TObject); procedure FormShow (Sender: TObject); procedure ScrollBarDurationChange (Sender: TObject); procedure ScrollBarFrequencyChange (Sender: TObject); procedure UpDownAmplitudeClick (Sender: TObject; Button: TUDBtnType); private { Private declarations } toneburst: TToneBurst; duration: integer; frequency: integer; public { Public declarations } end; var FormMain: TFormMain; implementation uses Math; {$R .DFM} procedure TFormMain.ButtonCloseClick (Sender: TObject); begin Close; end; procedure TFormMain.ButtonGoClick (Sender: TObject); begin toneburst.Frequency := frequency; toneburst.Duration := duration; if CheckBoxDeclick.Checked then begin toneburst.Risetime := 10; // in milliseconds toneburst.Falltime := 10; end else begin toneburst.Risetime := 0; toneburst.Falltime := 0; end; toneburst.Sound; end; procedure TFormMain.FormCloseQuery (Sender: TObject; var CanClose: Boolean); begin toneburst.Shutdown; end; procedure TFormMain.FormCreate (Sender: TObject); begin DesktopFont := True; toneburst := TToneburst.Create (Self); toneburst.Parent := Self; end; procedure TFormMain.FormShow (Sender: TObject); begin ScrollBarFrequency.OnChange (Self); ScrollBarDuration.OnChange (Self); UpDownAmplitude.OnClick (Self, btNext); end; procedure TFormMain.ScrollBarDurationChange (Sender: TObject); begin duration := ScrollBarDuration.Position; LabelDuration.Caption := IntToStr (duration) + ' ms'; end; procedure TFormMain.ScrollBarFrequencyChange (Sender: TObject); begin frequency := ScrollBarFrequency.Position; LabelFreq.Caption := IntToStr (frequency) + ' Hz'; end; procedure TFormMain.UpDownAmplitudeClick (Sender: TObject; Button: TUDBtnType); var amplitude: single; begin amplitude := Power (10, UpDownAmplitude.Position / 20); toneburst.Amplitude := amplitude; end; end. unit Beeper; { 2000 Aug 11 Make generator a separate unit, Beeper 2001 Jul 16 Version for Delphi 5 (unchanged) 2002 Oct 25 Add Risetime and Falltime properties 2002 Oct 30 Add Amplitude property (must be less than 1) Currently written on the assumption that the amplitude .. .. will be set much less often than the frequency Copyright © David J Taylor, Edinburgh Web site: www.satsignal.net E-mail: davidtaylor@writeme.com } interface uses Windows, Controls, MMsystem, Classes, SysUtils, Messages; const SampleRate = 44100; // Sampling rate for audio, i.e. best CD quality. Note: 10 ms -> exactly 441 samples type PAudioSample = ^TAudioSample; // Pointer to TAudioSample, 16-bit signed audio value TAudioSample = -32767..32767; // For 16-bit signed audio PStereoArray = ^TStereoArray; // Output buffer type, points to mixed L-R audio samples TStereoArray = array of TAudioSample; // Array of audio samples, mixed L-R-L-R for 2-channels TStereoPair = array of TAudioSample; // L-R pair of samples, used to compute buffer size from number of stereo samples const MaxBufferSamples = SampleRate; sine_table_size = 2048; type TSineTable = array of TAudioSample; {$A-} const pcm16: TWaveFormatEx = ( // wave format descriptor wFormatTag: wave_Format_PCM; // it's PCM data nChannels: 2; // 2 channels nSamplesPerSec: SampleRate; // set the 44.1KHz rate nAvgBytesPerSec: 4 SampleRate; // two channels of two bytes per sample nBlockAlign: 4; // for 2-channel 16-bit audio wBitsPerSample: 16; // 16-bit audio cbSize: 0); {$A+} type TToneburst = class (TCustomControl) private pcm: TWaveFormatEx; sine_table: TSineTable; sine_table_valid: boolean; angle: integer; hWaveOutHeader: HGlobal; // wave out header handles WaveOutHeader: PWaveHdr; // wave out header pointers hStereoOutBuffer: HGlobal; // output buffer handles StereoOutBuffer: PStereoArray; // output buffer pointers hWave_out: hWaveOut; status: integer; samples: integer; FFrequency: integer; FDuration: integer; FBusy: boolean; FRisetime: integer; FFalltime: integer; FAmplitude: single; procedure declick_buffer (bfr: PStereoArray); procedure fill_buffer (bfr: PStereoArray; new_freq: integer); procedure mm_wom_open (var msg: TMessage); message mm_wom_open; procedure mm_wom_done (var msg: TMessage); message mm_wom_done; procedure mm_wom_close (var msg: TMessage); message mm_wom_close; procedure write_next_buffer (header: pWaveHdr); procedure SetAmplitude(const Value: single); public property Amplitude: single read FAmplitude write SetAmplitude; property Busy: boolean read FBusy; property Duration: integer read FDuration write FDuration; property Falltime: integer read FFalltime write FFalltime; property Frequency: integer read FFrequency write FFrequency; property Risetime: integer read FRisetime write FRisetime; constructor Create (AOwner: TComponent); override; destructor Destroy; override; procedure Shutdown; procedure Sound; end; implementation { TToneburst } constructor TToneburst.Create (AOwner: TComponent); begin Inherited; pcm := pcm16; // Get the memory required for wave output headers // Lock the buffers in memory hWaveOutHeader := GlobalAlloc (gHnd or gMem_Share, SizeOf (TWaveHdr)); WaveOutHeader := pWaveHdr (GlobalLock (hWaveOutHeader)); // Get the memory required for output buffers hStereoOutBuffer := GlobalAlloc (gHnd or gMem_Share, MaxBufferSamples SizeOf (TStereoPair)); StereoOutBuffer := PStereoArray (GlobalLock (hStereoOutBuffer)); // Populate the first wave header with WaveOutHeader^ do begin lpData := pChar (StereoOutBuffer); // pointer to the data dwBufferLength := MaxBufferSamples pcm.nBlockAlign; dwBytesRecorded := 0; dwUser := 0; dwFlags := 0; dwLoops := 1; // normally, just a single loop lpNext := nil; reserved := 0; end; Amplitude := 0.3; angle := 0; FBusy := False; end; destructor TToneburst.Destroy; begin // in case the header is still "prepared", unPrepare it waveOutUnprepareHeader (hWave_out, WaveOutHeader, SizeOf (TWaveHdr)); // Return allocated memory for the output buffers GlobalUnlock (hWaveOutHeader); GlobalFree (hWaveOutHeader); GlobalUnlock (hStereoOutBuffer); GlobalFree (hStereoOutBuffer); Inherited; end; procedure TToneburst.mm_wom_open (var msg: TMessage); begin fill_buffer (StereoOutBuffer, FFrequency); WaveOutHeader^.dwBufferLength := samples pcm.nBlockAlign; waveOutPrepareHeader (hWave_out, WaveOutHeader, SizeOf (TWaveHdr)); write_next_buffer (WaveOutHeader); end; procedure TToneburst.mm_wom_close (var msg: TMessage); begin waveOutReset (hWave_out); hWave_out := 0; FBusy := False; end; procedure TToneburst.mm_wom_done (var msg: TMessage); begin waveOutReset (hWave_out); waveOutClose (hWave_out); end; procedure TToneburst.Sound; var err_text: array of char; begin if not FBusy then begin FFrequency := frequency; samples := duration SampleRate div 1000; if samples > MaxBufferSamples then samples := MaxBufferSamples; status := waveOutOpen (@hWave_out, wave_mapper, @pcm, Handle, 0, callback_window); if status = MMSYSERR_NOERROR then FBusy := True else begin FBusy := False; hWave_out := 0; waveOutGetErrorText (status, err_text, SizeOf (err_text)); Raise Exception.CreateFmt ('Error %d opening wave output - %s', [status, err_text]); end; end; end; procedure TToneburst.declick_buffer (bfr: PStereoArray); var rise_samples, fall_samples: integer; sample: integer; gain: single; i: integer; begin // Point to left sample at start of final roll-off rise_samples := FRisetime SampleRate div 1000; if rise_samples < samples - 1 then begin sample := 0; for i := 0 to rise_samples - 1 do begin gain := i / rise_samples; bfr^ [sample] := round (bfr^ [sample] gain); Inc (sample); bfr^ [sample] := round (bfr^ [sample] gain); Inc (sample); end; end; fall_samples := FFalltime SampleRate div 1000; if fall_samples < samples - 1 then begin sample := 2 samples - 1; for i := 0 to fall_samples - 1 do begin gain := i / fall_samples; bfr^ [sample] := round (bfr^ [sample] gain); Dec (sample); bfr^ [sample] := round (bfr^ [sample] gain); Dec (sample); end; end; end; procedure TToneburst.fill_buffer (bfr: PStereoArray; new_freq: integer); var i: integer; d_angle: integer; max_angle: integer; begin if not sine_table_valid then begin for i := 0 to sine_table_size - 1 do sine_table [i] := round (FAmplitude 32767.0 sin (i 2.0 pi / sine_table_size)); sine_table_valid := True; end; d_angle := round (256.0 sine_table_size new_freq / SampleRate); max_angle := 256 sine_table_size - 1; // Fill the channels for i := 0 to samples - 1 do begin // Left channel PStereoArray (bfr)^ [2 i] := sine_table [angle shr 8]; // Right channel PStereoArray (bfr)^ [2 i + 1] := sine_table [angle shr 8]; Inc (angle, d_angle); angle := angle and max_angle; end; if (FRisetime > 0) or (FFalltime > 0) then declick_buffer (bfr); end; procedure TToneburst.write_next_buffer (header: pWaveHdr); var err_text: array of char; begin // Write the buffer, will result in a mm_wom_done message status := waveOutWrite (hWave_out, header, SizeOf (TWaveHdr)); if status <> MMSYSERR_NOERROR then begin waveOutGetErrorText (status, err_text, SizeOf (err_text)); Raise Exception.CreateFmt ('Error %d writing wave output - %s', [status, err_text]); end; end; procedure TToneburst.Shutdown; begin if FBusy then waveOutReset (hWave_out); end; procedure TToneburst.SetAmplitude (const Value: single); begin FAmplitude := Value; if Famplitude < 0 then FAmplitude := 0.0; if FAmplitude > 1.0 then FAmplitude := 1.0; sine_table_valid := False; end; end.

ada kah yang bisa bantu? :?: bagaimna agar suara yang di generate dari sound card di keluar kan, dengan pilihan Left & Right?? dan bisa juga Left saja atau Right saja. trima kasih... :D

Coba perhatikan cuplikan skrip berikut :

procedure TToneburst.fill_buffer (bfr: PStereoArray; new_freq: integer);
var
  i: integer;
  d_angle: integer;
  max_angle: integer;
begin
  if not sine_table_valid then
  begin
    for i := 0 to sine_table_size - 1 do
      sine_table [i] := round
        (FAmplitude  32767.0   sin (i  2.0   pi / sine_table_size));
    sine_table_valid := True;
  end;
  d_angle := round (256.0  sine_table_size   new_freq / SampleRate);
  max_angle := 256  sine_table_size - 1;
  // Fill the channels
  for i := 0 to samples - 1 do
  begin
    // Left channel
    PStereoArray (bfr)^ [2   i] := sine_table [angle shr 8];
    // Right channel
    PStereoArray (bfr)^ [2  i + 1] := sine_table [angle shr 8];
    Inc (angle, d_angle);
    angle := angle and max_angle;
  end;
  if (FRisetime > 0) or (FFalltime > 0) then declick_buffer (bfr);
end;

saya potong sedikit sehingga menjadi :

.....
  // Fill the channels
  for i := 0 to samples - 1 do
  begin
    // Left channel
    PStereoArray (bfr)^ [2   i] := sine_table [angle shr 8];
    // Right channel
    PStereoArray (bfr)^ [2  i + 1] := sine_table [angle shr 8];
    Inc (angle, d_angle);
    angle := angle and max_angle;
  end;
.....

Untuk mengeluarkan Left / Right saja coba di comment salah satu PStereoArray. Klo yang Left channel di comment berarti yang keluar cuman Right channel saja. Nah tinggal di kasih RadioGroup untuk menentukan Left / Right, buat case dari RadioGroup yang dipilih. Bisa di modif jadi berikut :

.....
  case RadioGroup.ItemIndex of
    0: // Stereo
    // Fill the channels
    for i := 0 to samples - 1 do
    begin
      // Left channel
      PStereoArray (bfr)^ [2   i] := sine_table [angle shr 8];
      // Right channel
      PStereoArray (bfr)^ [2  i + 1] := sine_table [angle shr 8];
      Inc (angle, d_angle);
      angle := angle and max_angle;
    end;
    1: // Mono Left channel
    // Fill the channels
    for i := 0 to samples - 1 do
    begin
      // Left channel
      PStereoArray (bfr)^ [2   i] := sine_table [angle shr 8];
      Inc (angle, d_angle);
      angle := angle and max_angle;
    end;
    2: // Mono Right channel
    // Fill the channels
    for i := 0 to samples - 1 do
    begin
      // Right channel
      PStereoArray (bfr)^ [2 * i + 1] := sine_table [angle shr 8];
      Inc (angle, d_angle);
      angle := angle and max_angle;
    end;
  end; // End Case
.....

Moga bisa membantu .... CMIIW Tetep Semangat !!!

Emang buat aplikasi apaan sich klo boleh tau ... ?

Terima kasih, Kaka-delphi... :D akan saya coba codingnya. buat Tugas Akhir nih, membuat audiometer(pendeteksi kepekaan telinga) berbasis komputer.

setelah saya coba ternyata bisa keluar melalui left & right. cara yang saya coba adalah secara manual (ketika output yang diinginkan MonoLeft channel, maka Right channel saya nonaktifkan, dan sebaliknya). namun, ketika saya menambahkan radiobutton dengan itemindex kanan dan kiri, saya kesulitan... karena unit MainForm(form tempat saya memasang komponen radiobutton) berpisah dengan unit Beeper. bagaimana ya??

Walah .... gitu aja kok repod .... kamu tinggal bikin variable global aja di Unit Beeper.pas misal :

var
  iBalance : byte; // Variable ini harus global

Nah pas OnClick Radio Group nya :

  iBalance:= RadioGroup.ItemIndex;

trus yang case nya jadi :

case iBalance of
  0: ... ;
  1: ... ;
  2: ... ;
end;

gitu dech .... :P

thx again, trima kasih... :D ntar saya coba..