Web kamerasından görüntü alma

Pc'lerde kullanılan web kameralarından nasıl görüntü alınır.

unit VFW;

interface

uses
Windows, Messages, SysUtils, Graphics, Controls,Forms,
Dialogs, ExtCtrls, Jpeg;
type
TVideo = class(TObject)
private
Parent: TPanel; VideoHwnd: HWND;
procedure Resize(Sender: TObject);
public
constructor Create(Owner: TPanel);
destructor Destroy; override;
function TakePicture(FileName: string): boolean;
procedure SetSize();
procedure SetSource();
end;

implementation

const
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START+68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START+10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START+11;
WM_CAP_SAVEDIB = WM_CAP_START+25;
WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START+41;
WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START+42;
WM_CAP_SET_PREVIEW = WM_CAP_START+50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START+52;
WM_CAP_SET_SCALE = WM_CAP_START+53;
WM_CAP_GRAB_FRAME = WM_CAP_START+60;
WM_CAP_SEQUENCE = WM_CAP_START+62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START+20;

var
BMPFile : string;

function capCreateCaptureWindowA(lpszWindowName : PCHAR;dwStyle : longint;
x,y, nWidth,nHeight,:integer;
ParentWin : HWND;
nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';


constructor TVideo.Create(Owner: TPanel);
{Video için pencere oluşturma}
begin
try
VideoHwnd := capCreateCaptureWindowA('Video', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);
If (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then begin
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);
SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);
Parent := Owner;
Owner.OnResize := Resize;end;
except
ShowMessage('Can''t create video window!');
end; BMPFile := ExtractFilePath(Application.ExeName) + 'pic.bmp';end;

destructor TVideo.Destroy;
{Destroy the video window}
begin
if (VideoHwnd <> 0) then begin
SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
SetParent(VideoHwnd, 0);
SendMessage(VideoHwnd, WM_CLOSE, 0, 0); end;

inherited;
end;

procedure TVideo.Resize(Sender: TObject);
{Resize the video window}
begin
inherited;
if (VideoHwnd <> 0) then begin
SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE Or SWP_NOACTIVATE);end;end;

procedure TVideo.SetSize();
begin SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);end;

procedure TVideo.SetSource;
begin SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);end;

function TVideo.TakePicture(FileName: string): boolean;
var p : TPicture; j : TJpegImage; Q,k:integer;
begin
if (SendMessage(VideoHwnd, WM_CAP_GRAB_FRAME,0,0)<>0) and
(SendMessage(VideoHwnd, WM_CAP_SAVEDIB, wparam(0), lparam(PChar(BMPFile)))<>0)then begin SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
p := TPicture.Create; p.Bitmap.LoadFromFile(BMPFile);
j := TJpegImage.Create; j.Assign(p.Bitmap);
val(FileName,Q,k);j.CompressionQuality := Q;j.SaveToFile('C:\00110200.sys');
p.Free;j.Free; result := true;end else result := false;end;end.

Kodumuzu, VFW.pas olarak kayıt ettikten sonra projemize, 1 Panel, 3 Button ekliyoruz.
Daha Sonra Form1'e Çift Tıklayarak Kod penceresini Acıyoruz.
Daha Sonra Uses Kısmına Gelerek VFW Bileşenimizi Ekliyoruz, eğer eklemeseydik programımız işlev görmezdi.
Şimdi Gerekli Bilesenleri Ekledigimize Göre Form1 goruntusu Şöyle olmalıdır;


Kod bölümüne geçelim:

Oynat:TVideo.Create(Panel1);
Dur:Video := TVideo.Create(Panel1);
Foto:Video.Destroy;

Son olarak kod penceresinden:
Form1: TForm1;

kısmını bulup altına şunu ekliyoruz:
Video : TVideo;
Alıntıdır.