Web Cam'den Görüntü Alma

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

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.

Ş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;

  • Etiketler;
Yorum Yaz

Yorum yazabilmek için üye girişi yapmanız gerekiyor!

• 10 yıl önce
çok sağol walla
• 10 yıl önce
proje halini upload edebilme şansınız var mı acaba ? projeme eklemek istiyorum ama kodu ekleyemedim
• 10 yıl önce
oldu arkadaslar once masaustunde bir program klasoru olusturun sonra ustekı kodu alıp VFW.pas olark kaydettın sonrada delphide save project diyerek masaütünd oluştrudugunuz klasöre kaydedın ve o klasordekı unit.pas silin gerisi zaten anlatılıyor
• 9 yıl önce
Hocam teşekkürler Güzel Paylaşım.Tam aradığım şey.Bir projede geliştirerek kullanmam gerekiyor.Ancak şuan bende webcam'imi bulmasına rağmen siyah bir görüntü geliyor ve öylece kalıyor. Sizce Sorun nedir ? Sorunsuz çalışan bir programı upload edip bizim hatalarımızı görmemiz mümkünmüdür ? Kolay Gelsin
[i]Bu programı Java'da yapmam lazım, yardımcı olabilir misiniz ?[/i]

Yukarı Git