IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  sohbet

Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 16 Nisan 2010, 12:35   #1
Çevrimdışı
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Web Cam'den Görüntü Alma




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

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
unit VFW;

interface

{------------------------------------------------------------------------------
 
USES Listing of units this unit is dependent on (makes calls to).
------------------------------------------------------------------------------}
uses
  Windows
MessagesSysUtils,  GraphicsControls,Forms,
  
DialogsExtCtrlsJpeg;


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


Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.



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

Oynat:

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
TVideo.Create(Panel1); 

Foto:

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
Video.Destroy

Son olarak kod penceresinden:

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
Form1TForm1

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

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
Video TVideo


 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları sohbet odaları Benimmekan Mobil Sohbet
Cevapla

Etiketler
alma, camden, görüntü, web


Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)
 
Seçenekler
Stil

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
Yarım Elma, Gönül (Hatır) Alma. (Gönül Alma, Bir Elma) PySSyCaT Atasözleri ve Deyimler 0 01 Ekim 2014 22:57
Ekrandan görüntü alma Satuk Windows 0 03 Eylül 2012 17:03
Web Cam'den Görüntü Alma Spacely Delphi 1 26 Nisan 2010 21:10
BMW Z4 İlk Görüntü Süslü Otomobil Haberleri 0 06 Şubat 2009 11:09