Listing Program Mengambil Gambar dari Webcam dengan Delphi 7

Listing program dan langkah-langkah yang perlu dilakukan di dalam merancang program menangkap citra menngunakan webcam adalah sebagai berikut :

1. Jalankan Delphi.

2. Tambahkan pada Form Delphi berbagai komponen berikut 

: FilterGraph1 , VideoWindow1 , SampleGrabber1 , Filter1 , DBImage1 , Button1 , dan MainMenu1.

3. Atur properti berbagai komponen di atas, sebagai :

4. Klik 2x pada MainMenu1, atur tampilan sedemikian hingga seperti :

5. Tampilan Form sekarang akan berbentuk :

6. Klik 1x pada Form1, pada menu Events,

klik 2x pada sel OnCreate, setelah muncul halaman editor, tuliskan listing berikut :
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
Device: TMenuItem;
begin
SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
for i := 0 to SysDev.CountFilters - 1 do
begin
Device := TMenuItem.Create(Perangkat1);
Device.Caption := SysDev.Filters[i].FriendlyName;
Device.Tag := i;
Device.OnClick := OnSelectDevice;
Perangkat1.Add(Device);
end;
end;

Ket : Kalimat yang dicetak tebal tidak perlu dituliskan, atau telah tersedia pada halaman editor.
klik 2x pada sel OnCloseQuery, setelah muncul halaman editor, tuliskan listing berikut :
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
SysDev.Free;
FilterGraph1.ClearGraph;
Filend;
terGraph1.Active := false;

7. Kembali ke halaman Form1, klik 2x pada Button1, lalu tuliskan listing berikut :

procedure TForm1.Button1Click(Sender: TObject);
var sibegin
mpan : tbitmap;
simpan:=tbitmap.create;
SampleGrabber1.GetBitmap(DBImage1.Picture.Bitmap);
simpan:=DBImage1.Picture.Bitmap;
simend;
pan.savetofile('fadli.bmp');

8. Masih pada halaman editor, deklarasikan prosedur berikut :

procedure OnSelectDevice(sender: TObject);
di bawah,
private
{ Private declarations }
public
{ Public declarations }
procedure OnSelectDevice(sender: TObject);
Lalu tambahkan listing untuk prosedur tersebut, pada tubuh program.
procedure TForm1.OnSelectDevice(sender: TObject);
begin
FilterGraph1.ClearGraph;
FilterGraph1.Active := false;
Filter1.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
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;

Keterangan : kalimat yang diberi garis bawah (underline) merupakan kalimat yang tidak terpisah atau satu kalimat utuh.

9. Selanjutnya, tambahkan beberapa unit pada uses default sehingga menjadi :

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DBCtrls, Menus, DirectShow9, DSPack, DSUtil, ExtCtrls;

10. Deklarasikan variabel berikut, di bawah var header.

var
Form1: TForm1;
SysDev: TSysDevEnum;


11. Periksa kembali keseluruhan listing program, apakah persis seperti keseluruhan listing berikut :

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls, DBCtrls, Menus, DirectShow9, DSPack, DSUtil, ExtCtrls;
type
TForm1 = class(TForm)
FilterGraph1: TFilterGraph;
SampleGrabber1: TSampleGrabber;
Filter1: TFilter;
MainMenu1: TMainMenu;
Perangkat1: TMenuItem;
Button1: TButton;
VideoWindow1: TVideoWindow;
DBImage1: TDBImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
procedure OnSelectDevice(sender: TObject);
end;
var
Form1: TForm1;
SysDev: TSysDevEnum;
implementation
{$R *.dfm}
//------------------------------------------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var simpan : tbitmap;
begin
simpan:=tbitmap.create;
SampleGrabber1.GetBitmap(DBImage1.Picture.Bitmap);
simpan:=DBImage1.Picture.Bitmap;
simpan.savetofile('fadli.bmp');
end;
//-------------------------------------------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
Device: TMenuItem;
begin
SysDev:= TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if SysDev.CountFilters > 0 then
for i := 0 to SysDev.CountFilters - 1 do
begin
Device := TMenuItem.Create(Perangkat1);
Device.Caption := SysDev.Filters[i].FriendlyName;
Device.Tag := i;
Device.OnClick := OnSelectDevice;
Perangkat1.Add(Device);
end;
end;
//-------------------------------------------------------------------------------------------------------------------
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
SysDev.Free;
FilterGraph1.ClearGraph;
FilterGraph1.Active := false;
end;
//-----------------------------------------------------------------------------------------------------------------
procedure TForm1.OnSelectDevice(sender: TObject);
begin
FilterGraph1.ClearGraph;
FilterGraph1.Active := false;
Filter1.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
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;
end.

12. Eksekusi program (F9).
Salah satu tampilan program setelah eksekusi,

------------------------------Selamat Mencoba---------------------