Listing Program mengambil gambar dari webcamp

Untuk dapat mengambil gambar dari webcam, terlebih dahulu kita harus mengintal DSPack. DSpack merupakan aplikasi tambahan Delphi yang dipakai untuk mendeteksi perangkat webcamp dan mengambil gambar. Untuk mengetahui bagai mana cara Menginstal DSPack silahkan baca tulisan saya Instalasi DSPack Delphi. Setelah DSPack terintal dengan benar maka lakukan langkah-langkah 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---------------------