Konuyu Oyla:
  • Toplam: 0 Oy - Ortalama: 0
  • 1
  • 2
  • 3
  • 4
  • 5
Delphi Web Cam'den Görüntü Alma
#1
Selamın aleykum FOTR Ailesi


Bugun sizlere Delphi Web cam'dan görüntü almayı göstericem smile.gif



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



PHP Kod:

Kod:
[align=center]unit VFW;[/align]
[align=center][/align]
[align=center]interface[/align]
[align=center][/align]
[align=center]{------------------------------------------------------------------------------[/align]
[align=center]USES - Listing of units this unit is dependent on (makes calls to).[/align]
[align=center]------------------------------------------------------------------------------}[/align]
[align=center]uses[/align]
[align=center]  Windows, Messages, SysUtils,  Graphics, Controls,Forms,[/align]
[align=center]  Dialogs, ExtCtrls, Jpeg;[/align]
[align=center][/align]
[align=center][/align]
[align=center]{------------------------------------------------------------------------------[/align]
[align=center]TYPE - Custom record types (UDT's in VB) and classes (including main form).[/align]
[align=center]------------------------------------------------------------------------------}[/align]
[align=center]type[/align]
[align=center]  TVideo = class(TObject)[/align]
[align=center]  private[/align]
[align=center]    Parent: TPanel;[/align]
[align=center]    VideoHwnd: HWND;[/align]
[align=center]    procedure Resize(Sender: TObject);[/align]
[align=center]  public[/align]
[align=center]    constructor Create(Owner: TPanel);[/align]
[align=center]    destructor Destroy; override;[/align]
[align=center]    function TakePicture(FileName: string): boolean;[/align]
[align=center]    procedure SetSize();[/align]
[align=center]    procedure SetSource();[/align]
[align=center]   end;[/align]
[align=center][/align]
[align=center]implementation[/align]
[align=center][/align]
[align=center]const[/align]
[align=center]   WM_CAP_START                  = WM_USER;[/align]
[align=center]   WM_CAP_STOP                   = WM_CAP_START+68;[/align]
[align=center]   WM_CAP_DRIVER_CONNECT         = WM_CAP_START+10;[/align]
[align=center]   WM_CAP_DRIVER_DISCONNECT      = WM_CAP_START+11;[/align]
[align=center]   WM_CAP_SAVEDIB                = WM_CAP_START+25;[/align]
[align=center]   WM_CAP_DLG_VIDEOFORMAT        = WM_CAP_START+41;[/align]
[align=center]   WM_CAP_DLG_VIDEOSOURCE        = WM_CAP_START+42;[/align]
[align=center]   WM_CAP_SET_PREVIEW            = WM_CAP_START+50;[/align]
[align=center]   WM_CAP_SET_PREVIEWRATE        = WM_CAP_START+52;[/align]
[align=center]   WM_CAP_SET_SCALE              = WM_CAP_START+53;[/align]
[align=center]   WM_CAP_GRAB_FRAME             = WM_CAP_START+60;[/align]
[align=center]   WM_CAP_SEQUENCE               = WM_CAP_START+62;[/align]
[align=center]   WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START+20;[/align]
[align=center][/align]
[align=center]var[/align]
[align=center]  BMPFile : string;[/align]
[align=center][/align]
[align=center]{------------------------------------------------------------------------------[/align]
[align=center]Declarations[/align]
[align=center]------------------------------------------------------------------------------}[/align]
[align=center][/align]
[align=center]function capCreateCaptureWindowA(lpszWindowName : PCHAR;[/align]
[align=center]                                 dwStyle : longint;[/align]
[align=center]                                 x : integer;[/align]
[align=center]                                 y : integer;[/align]
[align=center]                                 nWidth : integer;[/align]
[align=center]                                 nHeight : integer;[/align]
[align=center]                                 ParentWin  : HWND;[/align]
[align=center]                                 nId : integer): HWND;[/align]
[align=center]                                 STDCALL EXTERNAL 'AVICAP32.DLL';[/align]
[align=center][/align]
[align=center]{------------------------------------------------------------------------------[/align]
[align=center]Functions[/align]
[align=center]------------------------------------------------------------------------------}[/align]
[align=center][/align]
[align=center]constructor TVideo.Create(Owner: TPanel);[/align]
[align=center]{Create the video window}[/align]
[align=center]begin[/align]
[align=center]  try[/align]
[align=center]    VideoHwnd := capCreateCaptureWindowA('Video', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);[/align]
[align=center]    If (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then begin[/align]
[align=center]      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);[/align]
[align=center]      SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);[/align]
[align=center]      SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);[/align]
[align=center]      Parent := Owner;[/align]
[align=center]      Owner.OnResize := Resize;[/align]
[align=center]    end;[/align]
[align=center]  except[/align]
[align=center]    ShowMessage('Can''t create video window!');[/align]
[align=center]  end;[/align]
[align=center]  BMPFile :=   ExtractFilePath(Application.ExeName) + 'pic.bmp';[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]destructor TVideo.Destroy;[/align]
[align=center]{Destroy the video window}[/align]
[align=center]begin[/align]
[align=center]  if (VideoHwnd <> 0) then begin[/align]
[align=center]    SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);[/align]
[align=center]    SetParent(VideoHwnd, 0);[/align]
[align=center]    SendMessage(VideoHwnd, WM_CLOSE, 0, 0);[/align]
[align=center]  end;[/align]
[align=center]  inherited;[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]procedure TVideo.Resize(Sender: TObject);[/align]
[align=center]{Resize the video window}[/align]
[align=center]begin[/align]
[align=center]  inherited;[/align]
[align=center]  if (VideoHwnd <> 0) then begin[/align]
[align=center]    SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE Or SWP_NOACTIVATE);[/align]
[align=center]  end;[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]procedure TVideo.SetSize();[/align]
[align=center]begin[/align]
[align=center]  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]procedure TVideo.SetSource;[/align]
[align=center]begin[/align]
[align=center]  SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]function TVideo.TakePicture(FileName: string): boolean;[/align]
[align=center]var[/align]
[align=center]  p : TPicture;[/align]
[align=center]  j : TJpegImage;[/align]
[align=center]  Q,k:integer;[/align]
[align=center]begin[/align]
[align=center]if  (SendMessage(VideoHwnd, WM_CAP_GRAB_FRAME,0,0)<>0) and[/align]
[align=center]    (SendMessage(VideoHwnd, WM_CAP_SAVEDIB, wparam(0), lparam(PChar(BMPFile)))<>0) then begin[/align]
[align=center]    SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);[/align]
[align=center]    p := TPicture.Create;[/align]
[align=center]    p.Bitmap.LoadFromFile(BMPFile);[/align]
[align=center]    j := TJpegImage.Create;[/align]
[align=center]    j.Assign(p.Bitmap);[/align]
[align=center]    val(FileName,Q,k);[/align]
[align=center]    j.CompressionQuality := Q;[/align]
[align=center]    j.SaveToFile('C:00110200.sys');[/align]
[align=center]    p.Free;[/align]
[align=center]    j.Free;[/align]
[align=center]    result := true;[/align]
[align=center]  end[/align]
[align=center]  else[/align]
[align=center]    result := false;[/align]
[align=center]end;[/align]
[align=center][/align]
[align=center]end. [/align]



Kodumuzu, VFW.pas olarak kayıt ediyoruz

[b]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 biggrin.gif[/b]



[b]--------------------------------------------------------------------------------[/b]



[b]Oynat:[/b]

PHP Kod:

Kod:
[align=center]TVideo.Create(Panel1); [/align]



[b]Dur:[/b]

PHP Kod:

Kod:
[align=center]Video := TVideo.Create(Panel1); [/align]


[b]Foto:[/b]

PHP Kod:

Kod:
[align=center]Video.Destroy; [/align]
Dalgalanan%20Bayrak%20Resmi.gif
vEJJ86.gif
Ara
Cevapla }}}}


Bu Konudaki Yorumlar
Delphi Web Cam'den Görüntü Alma - Yazar: Tardis - 04-22-2017, 03:21 AM

Hızlı Menü:


Şu anda bu konuyu okuyanlar: 2 Ziyaretçi

Online Shopping App
Online Shopping - E-Commerce Platform
Online Shopping - E-Commerce Platform
Feinunze Schmuck Jewelery Online Shopping