WebCam Sederhana Menggunakan Pemrograman Delphi

   Let's Go To Coding......

masukkan sourcode ini ke delphi anda

unit CameraBSI;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DSPack , DirectShow9 , DSUtils;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Filter1: TFilter;
    FilterGraph1: TFilterGraph;
    VideoWindow1: TVideoWindow;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  CapEnum : TSysDevEnum;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
Var I: Integer;
begin
   If  Button1.Caption = 'Mulai' Then
        Begin
          Button1.Caption:= ' Tutup';
          CapEnum := TSysDevEnum.Create(CLSID_VideoinputDeviceCategory);
            for I := 0 to CapEnum.CountFilters - 1 do
              Begin
                ComBobox1.Items.Add(CapEnum.Filters[i].FriendlyName);
              End;

        End
     Else
     Close;

end;

procedure TForm1.ComboBox1Click(Sender: TObject);
begin
FilTerGraph1.ClearGraph;
FilTerGraph1.Active:=False;
Filter1.BaseFilter.Moniker := CapEnum.GetMoniker(Combobox1.ItemIndex);
FilTerGraph1.Active:=True;

        With FilTerGraph1 As ICaptureGraphBuilder2 Do
        RenderStream(@PIN_CATEGORY_PREVIEW,nil,Filter1 As IBaseFilter, nil, VideoWindow1 As IBaseFilter);
        FilTerGraph1.Play;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CapEnum.Free;
FilTerGraph1.ClearGraph;
FilTerGraph1.Active:=False;
end;

end.

   Pada combobox akan terisi secara otomatis WebCam yang sudah terpasang di PC/Laptop anda, WebCam berjalan ketika anda mengklik Button.

   Jika anda ingin menghasilkan sebuah media capture image menggunakan desktop, anda bisa mempergunakan code ini :

unit Paint_Config;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    GroupBox1: TGroupBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Function Tangkap:TBitmap;
Var DC:HDC;
ABitmap:TBitmap;
Begin
DC:=GetDC(GetDesktopWindow);
ABitmap:=TBitmap.Create;
   Try
   ABitmap.Width:=GetDeviceCaps(DC,HORZRES);
   ABitmap.Height:=GetDeviceCaps(DC,VERTRES);


   BitBlt(ABitmap.Canvas.Handle,0,0,ABitmap.Width,ABitmap.Height,DC,0,0,SRCCOPY);
   Finally
   ReleaseDC(GetDesktopWindow,DC);
   End;
   Result:=ABitmap;
   End;


procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap:=Tangkap;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption:='COBA DITANGKAP';
end;

end.

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

download hasil project klik disini

*sumber : http://fajar-el-ridikc.blogspot.com/#ixzz48sAW3GhD