WebCameradan görüntü alma

[===]

Salamlar...

 

Bu dərslikdə siz Delphi 7-də WebCameradan görüntü almaq üçün proqram düzəltməyi öyrənəcəksiniz.İlk öncə aşağıdakı kodu VFW.pas kimi yaddaşa verin.

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:�0110200.sys');

p.Free;

j.Free;

result := true;

end

else

result := false;

end;

 

end.

Daha sonra Formumuza 1 Panel, 3 Button əlavə edək.Formun üzərinə iki dəfə klik edərək,kod bölməsinə keçək.Sonra Uses bölməsinə keçərək,VFW.pas faylını açaq.Kod bölməsinə keçək.

 

"Başla" buttonuna bu kodu yazaq:

TVideo.Create(Panel1);

 

"Dayan" buttonuna bu kodu yazaq:

Video := TVideo.Create(Panel1);

 

"Foto" buttonuna isə bu kodu yazaq:

Form1: TForm1;

Son olaraq kod pəncərəsindən

Form1: TForm1;

 

yazısını tapıb,altına bu kodu əlavə edək:

Video : TVideo;

[Guest Musa_]

Təşəkkürlər Həmid...

[TΛNNΞЯ]

Sagol men ee Hemid

[===]

Dəyməz.

[KymaR_]

Lazım olur hərdən çox sağ ol)

[===]

Dəyməz

[__xarqo__]

twkler ===

[Axellis]

Hemid Tesekkurler

[resad444]

Təşəkkürlər

[===]

Dəyməz...

[Ʌüsal]

kodlara gore tesekkur

bunu dahada aydin yazsaydin istifadeciler ucun asand olardi..video derslikle izah edilse yaxsi olar

[===]

Video Derslik Hazirlayardim.Amma YouTube Kanalim Bloka Dusub.Sekilli izah qoyacam

[KymaR_]

düzəlt ver mən qoyum

[AQIL_ISMAYIL]

Lazim Olur Hərdən Çox Sağ ol )

[Guest zver_777]

Xais edirem video hazirlaya bilersen!Hazirlasaz foruma yerlesdirinde

 

Salam!Xais edirem video hazirlayib foruma yerlesdirinde

[===]

Ehtiyac yoxdu video dərsliyə. Məncə yazılı pis izah olunmayıb.Həm də daha Delphi 7 ilə işləmirəm.Silmişəm

[Mubariz_bmw]

Men Delphi ni teze-teze oyrenirem,bawlayanlar ucun hansi proqram meslehetdi sizce?

[Elmar2001]

tesekkurler

[Ʌüsal]

Pascali oyren sonra delphiye kec

[Mubariz_bmw]

Vusal eKitab tapmaqda cetinlik cekirem,eger onun ucun elektron kitab varsa link qoy kocurum..

[===]

Pascal Yeni Başlayanlar Üçün Dərslik (Rusca)

[Mubariz_bmw]

Sagol,===

 

===,link islemedi

[===]

Link işləyir