Selamın aleykum FOTR Ailesi
Bugun sizlere Delphi Web cam'dan görüntü almayı göstericem
İ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 [/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]