Web Cam'den Görüntü Alma

[efecannn]

Merhabalar,

Yeni bir konu ile birlikteyiz. Bu dersimizde Web Cam'den Delphi'de yaptığımız bir programcıkla nasıl görüntü alınabileceğini anlatacağım.

İlk Once Program'ımızın Calısmasi İçin;

unit VFW;

interface

{------------------------------------------------------------------------------
USES - Listing of units this unit is dependent on (makes calls to).
------------------------------------------------------------------------------}
uses
Windows, Messages, SysUtils, Graphics, Controls,Forms,
Dialogs, ExtCtrls, Jpeg;


{------------------------------------------------------------------------------
TYPE - Custom record types (UDT's in VB) and classes (including main form).
------------------------------------------------------------------------------}
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;

{------------------------------------------------------------------------------
Declarations
------------------------------------------------------------------------------}

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

{------------------------------------------------------------------------------
Functions
------------------------------------------------------------------------------}

constructor TVideo.Create(Owner: TPanel);
{Create the video window}
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.


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;

[Atillla]

Tesekkürler kardeş kendi pc mizde görüntü almak için galiba cok karısık bilmeyenler için yani benim için