home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kompon / d56 / CMDXCAP.ZIP / FormMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-09-17  |  10.9 KB  |  345 lines
  1. unit FormMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, DXCapture, StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     lstOptionDialogs: TListBox;
  12.     lstAudioDevices: TComboBox;
  13.     lstVideoDevices: TComboBox;
  14.     lstResolution: TComboBox;
  15.     rbFrameRate15: TRadioButton;
  16.     rbFrameRate30: TRadioButton;
  17.     rbFrameRate10: TRadioButton;
  18.     rbFrameRate5: TRadioButton;
  19.     sbMain: TStatusBar;
  20.     lstAudioFormat: TComboBox;
  21.     cmdBitmap: TButton;
  22.     cmdStart: TButton;
  23.     cmdStop: TButton;
  24.     cmdJpeg: TButton;
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  27.     procedure lstOptionDialogsClick(Sender: TObject);
  28.     procedure lstVideoDevicesChange(Sender: TObject);
  29.     procedure lstAudioDevicesChange(Sender: TObject);
  30.     procedure lstResolutionChange(Sender: TObject);
  31.     procedure rbFrameRate5Click(Sender: TObject);
  32.     procedure rbFrameRate10Click(Sender: TObject);
  33.     procedure rbFrameRate15Click(Sender: TObject);
  34.     procedure rbFrameRate30Click(Sender: TObject);
  35.     procedure lstAudioFormatChange(Sender: TObject);
  36.     procedure cmdBitmapClick(Sender: TObject);
  37.     procedure cmdStartClick(Sender: TObject);
  38.     procedure cmdStopClick(Sender: TObject);
  39.     procedure cmdJpegClick(Sender: TObject);
  40.   public
  41.     Capture: TCapture;
  42.     VideoDevice : String;
  43.     AudioDevice : String;
  44.     procedure OnVideoFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );
  45.     procedure OnAudioFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );
  46.     procedure OnVideoFormat( Sender : TObject );
  47.     procedure OnAudioFormat( Sender : TObject );
  48.     procedure OnChangeDevice( Sender : TObject );
  49.     procedure OnCaptureProgress( Sender: TObject );
  50.   end;
  51.  
  52. var
  53.   MainForm: TMainForm;
  54.  
  55. implementation
  56.  
  57. {$R *.dfm}
  58.  
  59. // new video frame has been grabbed
  60. procedure TMainForm.OnVideoFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );
  61. begin
  62.   sbMain.Panels[0].Text := 'Video-Frame: ' + IntToStr( Frame );
  63. end;
  64.  
  65. // new audio frame has been grabbed
  66. procedure TMainForm.OnAudioFrame( Frame : Cardinal; Buffer : Pointer; Size : Integer );
  67. begin
  68.   sbMain.Panels[1].Text := 'Audio-Frame: ' + IntToStr( Frame );
  69. end;
  70.  
  71. // capture devices has been changed
  72. procedure TMainForm.OnChangeDevice( Sender : TObject );
  73. var
  74.   DeviceOptions : TDeviceOptions;
  75.   i : Integer;
  76. begin
  77.   // get a pointer to capture device option dialog handler class
  78.   DeviceOptions := Capture.DeviceOptions;
  79.   // cleanup the listbox
  80.   lstOptionDialogs.Clear;
  81.   // add a video header
  82.   lstOptionDialogs.Items.Add( 'Video Options' );
  83.   // add video option dialogs
  84.   i := 0;
  85.   while i < DeviceOptions.Count do begin
  86.     if DeviceOptions.IsVideo[i] then lstOptionDialogs.Items.Add( '+ ' + DeviceOptions.Captions[i] );
  87.     Inc( i );
  88.   end;
  89.   // add a audio header
  90.   lstOptionDialogs.Items.Add( 'Audio Options' );
  91.   // add audio option dialogs
  92.   i := 0;
  93.   while i < DeviceOptions.Count do begin
  94.     if not DeviceOptions.IsVideo[i] then lstOptionDialogs.Items.Add( '+ ' + DeviceOptions.Captions[i] );
  95.     Inc( i );
  96.   end;
  97. end;
  98.  
  99. // video format can be set now
  100. procedure TMainForm.OnVideoFormat( Sender : TObject );
  101. begin
  102.   // we don't set the video format here :)
  103.  
  104.   // resize capture control
  105.   Capture.SetBounds( 220, 8, Capture.VideoWidth, Capture.VideoHeight );
  106. end;
  107.  
  108. // audio format can be set now
  109. procedure TMainForm.OnAudioFormat( Sender : TObject );
  110. begin
  111.   // we don't set the audio format here :)
  112. end;
  113.  
  114. // capturing in progress ... :)
  115. procedure TMainForm.OnCaptureProgress( Sender: TObject );
  116. begin
  117.   sbMain.Panels[2].Text := 'Frames Captured ' + IntToStr( Capture.NotDropped )
  118.                          + '. Frames Dropped ' + IntToStr( Capture.FramesDropped ) + '.';
  119. end;
  120.  
  121. procedure TMainForm.FormCreate(Sender: TObject);
  122. var
  123.   StringList : TStringList;
  124.   i : Integer;
  125. begin
  126.  
  127.   // create the capture class
  128.   Capture := TCapture.Create( Self );
  129.   // we must set the parent property if we havn't installed capture component in delphi
  130.   Capture.Parent := Self;
  131.   // intialize capture class
  132.   if not Capture.Init then begin
  133.     MessageBox( Handle, 'No capture devices found.', PChar( Application.Title ), MB_ICONSTOP or MB_OK );
  134.   end;
  135.   // set grabber handlers
  136.   Capture.VideoGrabber.ProcessBuffer := OnVideoFrame;
  137.   Capture.AudioGrabber.ProcessBuffer := OnAudioFrame;
  138.   // set capture event handlers
  139.   Capture.OnVideoFormatChange := OnVideoFormat;
  140.   Capture.OnAudioFormatChange := OnAudioFormat;
  141.   Capture.OnChangeDevice := OnChangeDevice;
  142.   Capture.OnCaptureProgress := OnCaptureProgress;
  143.  
  144.   // get available video devices
  145.   StringList := GetVideoDevicesList;
  146.   // empty video device listbox
  147.   lstVideoDevices.Clear;
  148.   // add all video devices
  149.   i := 0;
  150.   while i < StringList.Count do begin
  151.     lstVideoDevices.Items.Add( StringList.Strings[i] );
  152.     Inc( i );
  153.   end;
  154.  
  155.   // take first device for capturing
  156.   if StringList.Count > 0 then begin
  157.     VideoDevice := StringList.Strings[0];
  158.     lstVideoDevices.ItemIndex := 0;
  159.   end else begin
  160.     VideoDevice := '';
  161.   end;
  162.  
  163.   // get available video devices
  164.   StringList := GetAudioDevicesList;
  165.   // empty video device listbox
  166.   lstAudioDevices.Clear;
  167.   // add all video devices
  168.   i := 0;
  169.   while i < StringList.Count do begin
  170.     lstAudioDevices.Items.Add( StringList.Strings[i] );
  171.     Inc( i );
  172.   end;
  173.  
  174.   // take first device for capturing
  175.   if StringList.Count > 0 then begin
  176.     AudioDevice := StringList.Strings[0];
  177.     lstAudioDevices.ItemIndex := 0;
  178.   end else begin
  179.     AudioDevice := '';
  180.   end;
  181.  
  182.   // setup component states...
  183.   lstResolution.ItemIndex := 10;
  184.   lstAudioFormat.ItemIndex := 4;
  185.   rbFrameRate10.Checked := True;
  186.  
  187.   // setup video format
  188.   Capture.SetVideoFormat( 352, 288, 24, 10 );
  189.   // setup audio format
  190.   Capture.SetAudioFormat( 8000, 1, 16 );
  191.   // set bounds of capture control
  192.   Capture.SetBounds( 220, 8, Capture.VideoWidth, Capture.VideoHeight );
  193.   // begin capturing
  194.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  195.  
  196. end;
  197.  
  198. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  199. begin
  200.   // free capture class if we havn't installed capture component in delphi
  201.   Capture.Free;
  202. end;
  203.  
  204. procedure TMainForm.lstOptionDialogsClick(Sender: TObject);
  205. begin
  206.   if lstOptionDialogs.ItemIndex < 0 then Exit;
  207.   // open options dialog
  208.   Capture.DeviceOptions.Dialog( Copy( lstOptionDialogs.Items[lstOptionDialogs.ItemIndex], 3, $FFFF ) );
  209. end;
  210.  
  211. procedure TMainForm.lstVideoDevicesChange(Sender: TObject);
  212. begin
  213.   if lstVideoDevices.ItemIndex < 0 then Exit;
  214.   // get new video device from listbox
  215.   VideoDevice := lstVideoDevices.Items[lstVideoDevices.ItemIndex];
  216.   // begin capturing...
  217.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  218. end;
  219.  
  220. procedure TMainForm.lstAudioDevicesChange(Sender: TObject);
  221. begin
  222.   if lstAudioDevices.ItemIndex < 0 then Exit;
  223.   // get new video device from listbox
  224.   AudioDevice := lstAudioDevices.Items[lstAudioDevices.ItemIndex];
  225.   // begin capturing...
  226.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  227. end;
  228.  
  229. procedure TMainForm.lstResolutionChange(Sender: TObject);
  230. var
  231.   szTmp : String;
  232.   iWidth, iHeight, iBpp : Integer;
  233. begin
  234.   if lstResolution.ItemIndex < 0 then Exit;
  235.   szTmp := lstResolution.Items[lstResolution.ItemIndex];
  236.   iWidth := StrToInt( Copy( szTmp, 0, Pos( 'x', szTmp ) - 1 ) );
  237.   szTmp := Copy( szTmp, Pos( 'x', szTmp ) + 1, 99 );
  238.   iHeight := StrToInt( Copy( szTmp, 0, Pos( 'x', szTmp ) - 1 ) );
  239.   szTmp := Copy( szTmp, Pos( 'x', szTmp ) + 1, 99 );
  240.   iBpp := StrToInt( szTmp );
  241.   Capture.SetVideoFormat( iWidth, iHeight, iBpp, Capture.VideoFrameRate );
  242.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  243. end;
  244.  
  245. procedure TMainForm.lstAudioFormatChange(Sender: TObject);
  246. var
  247.   szTmp : String;
  248.   iSampleRate, iBitRate, iChannels : Integer;
  249. begin
  250.   if lstAudioFormat.ItemIndex < 0 then Exit;
  251.   szTmp := lstAudioFormat.Items[lstAudioFormat.ItemIndex];
  252.   szTmp := StringReplace( szTmp, ' Hz - ', 'x', [] );
  253.   szTmp := StringReplace( szTmp, ' Bit - ', 'x', [] );
  254.   iSampleRate := StrToInt( Copy( szTmp, 0, Pos( 'x', szTmp ) - 1 ) );
  255.   szTmp := Copy( szTmp, Pos( 'x', szTmp ) + 1, 99 );
  256.   iBitRate := StrToInt( Copy( szTmp, 0, Pos( 'x', szTmp ) - 1 ) );
  257.   szTmp := Copy( szTmp, Pos( 'x', szTmp ) + 1, 99 );
  258.   iChannels := StrToInt( Copy( szTmp, 0, 1 ) );
  259.   Capture.SetAudioFormat( iSampleRate, iChannels, iBitRate );
  260.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  261. end;
  262.  
  263. procedure TMainForm.rbFrameRate5Click(Sender: TObject);
  264. begin
  265.   rbFrameRate5.Checked := True;
  266.   rbFrameRate10.Checked := False;
  267.   rbFrameRate15.Checked := False;
  268.   rbFrameRate30.Checked := False;
  269.   Capture.SetVideoFormat( Capture.VideoWidth, Capture.VideoHeight, Capture.VideoBitCount, 5 );
  270.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  271. end;
  272.  
  273. procedure TMainForm.rbFrameRate10Click(Sender: TObject);
  274. begin
  275.   rbFrameRate5.Checked := False;
  276.   rbFrameRate10.Checked := True;
  277.   rbFrameRate15.Checked := False;
  278.   rbFrameRate30.Checked := False;
  279.   Capture.SetVideoFormat( Capture.VideoWidth, Capture.VideoHeight, Capture.VideoBitCount, 10 );
  280.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  281. end;
  282.  
  283. procedure TMainForm.rbFrameRate15Click(Sender: TObject);
  284. begin
  285.   rbFrameRate5.Checked := False;
  286.   rbFrameRate10.Checked := False;
  287.   rbFrameRate15.Checked := True;
  288.   rbFrameRate30.Checked := False;
  289.   Capture.SetVideoFormat( Capture.VideoWidth, Capture.VideoHeight, Capture.VideoBitCount, 15 );
  290.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  291. end;
  292.  
  293. procedure TMainForm.rbFrameRate30Click(Sender: TObject);
  294. begin
  295.   rbFrameRate5.Checked := False;
  296.   rbFrameRate10.Checked := False;
  297.   rbFrameRate15.Checked := False;
  298.   rbFrameRate30.Checked := True;
  299.   Capture.SetVideoFormat( Capture.VideoWidth, Capture.VideoHeight, Capture.VideoBitCount, 30 );
  300.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  301. end;
  302.  
  303. procedure TMainForm.cmdBitmapClick(Sender: TObject);
  304. begin
  305.   Capture.ImageFile := 'capture.bmp';
  306.   Capture.SaveAsBitmap;
  307. end;
  308.  
  309. procedure TMainForm.cmdJpegClick(Sender: TObject);
  310. begin
  311.   Capture.ImageFile := 'capture.jpg';
  312.   Capture.SaveAsJpeg( 100 );
  313. end;
  314.  
  315. procedure TMainForm.cmdStartClick(Sender: TObject);
  316. begin
  317.   if Capture.Capturing then Exit;
  318.   Capture.UseTempFile := True;
  319.   Capture.TempCaptureFileName := 'capture~.avi';
  320.   Capture.CaptureFileName := 'capture.avi';
  321.  
  322.   // start capturing
  323.   if Capture.StartCapture( true ) then begin
  324.     // set button states
  325.     cmdBitmap.Enabled := False;
  326.     cmdStart.Enabled := False;
  327.     cmdStop.Enabled := True;
  328.   end;
  329.  
  330. end;
  331.  
  332. procedure TMainForm.cmdStopClick(Sender: TObject);
  333. begin
  334.   if not Capture.Capturing then Exit;
  335.   Capture.StopCapture;
  336.   // back to preview mode
  337.   Capture.ChooseDevices( VideoDevice, AudioDevice );
  338.   // set button states
  339.   cmdBitmap.Enabled := True;
  340.   cmdStart.Enabled := True;
  341.   cmdStop.Enabled := False;
  342. end;
  343.  
  344. end.
  345.