Merhabalar,
Yeni bir konu ile birlikteyiz. Bu dersimizde Web Cam'den Delphi'de yaptığımız bir progr*****la nasıl görüntü alınabileceğini anlatacağım.
İlk Once Program'ımızın Calısmasi İçin;
Yeni bir konu ile birlikteyiz. Bu dersimizde Web Cam'den Delphi'de yaptığımız bir progr*****la nasıl görüntü alınabileceğini anlatacağım.
İlk Once Program'ımızın Calısmasi İçin;
Kod:
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.