home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 23 / IOPROG_23.ISO / SOFT / DELPHIX.ZIP / Samples / Sound / HDRecorder / Main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-10-06  |  3.4 KB  |  134 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Wave, StdCtrls, ExtCtrls, DXClass, DXSounds;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     StartButton: TButton;
  12.     StopButton: TButton;
  13.     FileNameEdit: TEdit;
  14.     SizeLabel: TLabel;
  15.     FormatBox: TComboBox;
  16.     DriverBox: TComboBox;
  17.     SaveDialog: TSaveDialog;
  18.     BrowseButton: TButton;
  19.     CloseButton: TButton;
  20.     procedure StartButtonClick(Sender: TObject);
  21.     procedure StopButtonClick(Sender: TObject);
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure DriverBoxChange(Sender: TObject);
  24.     procedure BrowseButtonClick(Sender: TObject);
  25.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  26.     procedure CloseButtonClick(Sender: TObject);
  27.   private
  28.     FCapture: TSoundCaptureStream;
  29.     FWaveStream: TWaveStream;
  30.     procedure CaptureFilledBuffer(Sender: TObject);
  31.   end;
  32.  
  33. var
  34.   MainForm: TMainForm;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. procedure TMainForm.FormCreate(Sender: TObject);
  41. var
  42.   i: Integer;
  43. begin
  44.   for i:=0 to TSoundCaptureStream.Drivers.Count-1 do
  45.     DriverBox.Items.Add(TSoundCaptureStream.Drivers[i].Description);
  46.   DriverBox.ItemIndex := 0;
  47.   DriverBoxChange(nil);
  48. end;
  49.  
  50. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  51. begin
  52.   StopButtonClick(nil);
  53.   FCapture.Free; FCapture := nil;
  54. end;
  55.  
  56. procedure TMainForm.CloseButtonClick(Sender: TObject);
  57. begin
  58.   Close;
  59. end;
  60.  
  61. procedure TMainForm.DriverBoxChange(Sender: TObject);
  62. const
  63.   ChannelText: array[1..2] of string = ('Mono', 'Stereo');
  64. var
  65.   i: Integer;
  66. begin
  67.   FCapture.Free;
  68.   FCapture := TSoundCaptureStream.Create(nil);
  69.  
  70.   FormatBox.Items.Clear;
  71.   for i:=0 to FCapture.SupportedFormats.Count-1 do
  72.     with FCapture.SupportedFormats[i] do
  73.       FormatBox.Items.Add(Format('%dHz %dbit %s', [SamplesPerSec, BitsPerSample, ChannelText[Channels]]));
  74.  
  75.   FormatBox.ItemIndex := FormatBox.Items.Count-1;
  76. end;
  77.  
  78. procedure TMainForm.StartButtonClick(Sender: TObject);
  79. begin
  80.   StopButtonClick(nil);
  81.   try
  82.     FWaveStream := TWaveFileStream.Create(FileNameEdit.Text, fmCreate);
  83.     with FCapture.SupportedFormats[FormatBox.ItemIndex] do
  84.       FWaveStream.SetPCMFormat(SamplesPerSec, BitsPerSample, Channels);
  85.     FWaveStream.Open(True);
  86.  
  87.     StartButton.Enabled := False;
  88.     DriverBox.Enabled := False;
  89.     FormatBox.Enabled := False;
  90.     StopButton.Enabled := True;
  91.     BrowseButton.Enabled := False;
  92.  
  93.     FileNameEdit.Color := clBtnFace;
  94.     FileNameEdit.ReadOnly := True;
  95.  
  96.     FCapture.OnFilledBuffer := CaptureFilledBuffer;
  97.  
  98.     FCapture.CaptureFormat := FormatBox.ItemIndex;
  99.     FCapture.Start;
  100.   except
  101.     StopButtonClick(nil);
  102.     raise;
  103.   end;
  104. end;
  105.  
  106. procedure TMainForm.StopButtonClick(Sender: TObject);
  107. begin
  108.   if FCapture<>nil then FCapture.Stop;
  109.   FWaveStream.Free; FWaveStream := nil;
  110.  
  111.   StartButton.Enabled := True;
  112.   DriverBox.Enabled := True;
  113.   FormatBox.Enabled := True;
  114.   StopButton.Enabled := False;
  115.   BrowseButton.Enabled := True;
  116.  
  117.   FileNameEdit.Color := clWindow;
  118.   FileNameEdit.ReadOnly := False;
  119. end;
  120.  
  121. procedure TMainForm.BrowseButtonClick(Sender: TObject);
  122. begin
  123.   if SaveDialog.Execute then
  124.     FileNameEdit.Text := SaveDialog.FileName;
  125. end;
  126.  
  127. procedure TMainForm.CaptureFilledBuffer(Sender: TObject);
  128. begin
  129.   FWaveStream.CopyFrom(FCapture, FCapture.FilledSize);
  130.   SizeLabel.Caption := Format('%d byte', [FWaveStream.Size]);
  131. end;
  132.  
  133. end.
  134.