Web Cam'den Görüntü Alma

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.