Membuat Capture Foto dengan Webcam menggunakan Delphi

بِسْــــــــــــــــمِ اﷲِالرَّحْمَنِ اارَّحِيم

Bagaimana Membuat Program dengan delphi untuk mengambil atau meng-Capture Foto, disini ane kasih contohya ya meskipun sudah banyak artikel tentang hal ini, namun apa salahnya untuk dishare ulang. Aplikasi ini menggunakan Komponen Tambahan yaitu DSPACK, karena mungkin  ada berbagai versi jadi silahkan Sobat cari sendiri komponen tersebut dan juga cara menginstalnya.

Untuk Listing Codingnya :

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, DirectShow9, DSPack, DSUtil, ExtCtrls, Menus, DBCtrls, StdCtrls, Buttons; type TForm1 = class(TForm) FilterGraph1: TFilterGraph; Filter1: TFilter; SampleGrabber1: TSampleGrabber; ComboBox1: TComboBox; BitNyala: TBitBtn; BitBtn3: TBitBtn; Panel3: TPanel; Image1: TImage; BitKeluar: TBitBtn; Panel1: TPanel; VideoWindow1: TVideoWindow; procedure FormCreate(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure BitNyalaClick(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure BitKeluarClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; SysDev: TSysDevEnum; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var i: integer; begin SysDev:=TSysDevEnum.Create(CLSID_VideoInputDeviceCategory); For i:=0 to SysDev.CountFilters-1 do begin combobox1.Items.Add(SysDev.Filters[i].FriendlyName); ComboBox1.ItemIndex:=0 end end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin SysDev.Free; FilterGraph1.ClearGraph; FilterGraph1.Active := false; end; procedure TForm1.BitNyalaClick(Sender: TObject); begin try if BitNyala.Caption='Nyalakan Kamera' then BEGIN BitNyala.Caption:='Matikan Kamera'; FilterGraph1.ClearGraph; FilterGraph1.Active := false; Filter1.BaseFilter.Moniker :=SysDev.GetMoniker(combobox1.ItemIndex); FilterGraph1.Active := true; with FilterGraph1 as ICaptureGraphBuilder2 do RenderStream(@PIN_CATEGORY_PREVIEW,nil, Filter1 as IBaseFilter, SampleGrabber1 as IBaseFilter, VideoWindow1 as IbaseFilter); FilterGraph1.Play; END ELSE BEGIN BitNyala.Caption:='Nyalakan Kamera'; FilterGraph1.Stop; FilterGraph1.Active:=false END except end end; procedure TForm1.BitBtn3Click(Sender: TObject); begin if BitNyala.Caption='Nyalakan Kamera' then Application.MessageBox('Kamera Belum dinyalakan !!','Cek Dulu donk',MB_OK) else begin Panel3.Visible:=True; samplegrabber1.GetBitmap(Image1.Picture.Bitmap); Image1.Picture.SaveToFile('C:\Documents and Settings\Yudhiez\My Documents\My Pictures\'+FormatDateTime('MMyyyyHHmmss',now)+'.bmp'); Application.MessageBox('Gambar Sudah Disimpan ke My Pictures!!','Informasi',MB_OK); Image1.Picture:=nil; Panel3.Visible:=false; end end; procedure TForm1.BitKeluarClick(Sender: TObject); begin SysDev.Free; FilterGraph1.ClearGraph; FilterGraph1.Active := false; Application.Terminate; end; end.

untuk Cotoh Aplikasinya : Klik

Semoga Bermanfaat...