Merhabalar,

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

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

Kod:
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 : integer; y : integer; nWidth : integer; nHeight : integer; ParentWin : HWND; nId : integer): HWND; STDCALL EXTERNAL 'AVICAP32.DLL'; constructor TVideo.Create(Owner: TPanel); 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; 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); 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 Cift 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 gormezdi.

Şimdi Gerekli Bilesenleri Ekledigimize Gore Form1 goruntusu Şoyle olmalıdır;

Kod bolumune gecelim:

Oynat:

Kod:
TVideo.Create(Panel1);

Dur:

Kod:
Video := TVideo.Create(Panel1);

Foto:

Kod:
Video.Destroy;
Son olarak kod penceresinden:

Kod:
Form1: TForm1;

kısmını bulup altına şunu ekliyoruz:

Kod:
Video : TVideo;

__________________