Delphi control camera

Delphi's camera control is very simple. All the underlying messaging functions have been defined in the system, Windows, and messages units. We only need to call them reasonably. I made the related operations of the camera into a control, so that you can drag the form and use it directly.

{************************************
* Camera control for Delphi7 *
* Made by rarnu *
* Credit 2006.08.27 *
*Http://rarnu.ik8.com*
************************************}

Unit racameraeye;

Interface

Uses
Sysutils, classes, controls, windows, messages;

{Event declaration}
Type
{Start camera event}
Tonstart = procedure (Sender: tobject) of object;
{Video stop event}
Tonstop = procedure (Sender: tobject) of object;
{Start video event}
Tonstartrecord = procedure (Sender: tobject) of object;
{Stopping video events}
Tonstoprecord = procedure (Sender: tobject) of object;

Type
Tracameraeye = Class (tcomponent)
Private
{Image Display container}
Fdisplay: twincontrol;
{Event correlation variable}
Fonstart: tonstart;
Fonstartrecord: tonstartrecord;
Fonstop: tonstop;
Fonstoprecord: tonstoprecord;
Protected
Public
{Structure and structure, covered by the tcomponent class}
Constructor create (aowner: tcomponent); override;
Destructor destroy; override;
{Start camera}
Procedure start;
{Stop camera}
Procedure stop;
{And save it to BMP}
Procedure savetobmp (filename: string );
{Recording Avi}
Procedure recordtoavi (filename: string );
{Stop recording}
Procedure stoprecord;
Published
Property display: twincontrol read fdisplay write fdisplay;
Property onstart: tonstart read fonstart write fonstart;
Property onstop: tonstop read fonstop write fonstop;
Property onstartrecord: tonstartrecord read fonstartrecord write fonstartrecord;
Property onstoprecord: tonstoprecord read fonstoprecord write fonstoprecord;
End;

{Message constant declaration}
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_grab_frame = wm_cap_start + 60;
Wm_cap_sequence = wm_cap_start + 62;
Wm_cap_file_set_capture_filea = wm_cap_start + 20;
Wm_cap_sequence_nofile = wm_cap_start + 63;
Wm_cap_set_overlay = wm_cap_start + 51;
Wm_cap_set_preview = wm_cap_start + 50;
Wm_cap_set_callback_videostream = wm_cap_start + 6;
Wm_cap_set_callback_error = wm_cap_start + 2;
Wm_cap_set_callback_statusa = wm_cap_start + 3;
Wm_cap_set_callback_frame = wm_cap_start + 5;
Wm_cap_set_scale = wm_cap_start + 53;
Wm_cap_set_previewrate = wm_cap_start + 52;

{Declare a dynamic function, which is transferred from the DLL to dynamically determine whether the function is available}
Type
Tfuncap = function (
Lpszwindowname: pchar;
Dwstyle: longint;
X: integer;
Y: integer;
Nwidth: integer;
Nheight: integer;
Parentwin: hwnd;
NID: integer): hwnd; stdcall;

{Global variable declaration}
VaR
Hwndc: thandle;
Funcap: tfuncap;
Dllhandle: thandle;

Procedure register;

Implementation

Procedure register;
Begin
Registercomponents ('rarnu components', [tracameraeye]);
End;

{Tracameraeye}

Constructor tracameraeye. Create (aowner: tcomponent );
VaR
Fpointer: pointer; {function pointer}
Begin
Inherited create (aowner );
Fdisplay: = nil;
{Call through DLL. If the DLL does not exist, no driver exists}
Dllhandle: = loadlibrary ('avicap32. dll ');
If dllhandle <= 0 then
Begin
MessageBox (twincontrol (owner). Handle, 'the camera driver is not installed or the driver is invalid. You cannot use this control! ', 'Error', mb_ OK or mb_iconerror );
Destroy; {release control}
Exit;
End;
{Function pointer pointing to specified API}
Fpointer: = getprocaddress (dllhandle, 'capcreatecapturew.wa ');
{Restore function pointer to object function}
Funcap: = tfuncap (fpointer );
End;

Destructor tracameraeye. Destroy;
Begin
Stoprecord;
Stop;
Fdisplay: = nil;
{Release if dll has been loaded}
If dllhandle> 0 then
Freelibrary (dllhandle );
Inherited destroy;
End;

Procedure tracameraeye. recordtoavi (filename: string );
Begin
If hwndc <> 0 then
Begin
Sendmessage (hwndc, wm_cap_file_set_capture_filea, 0, longint (pchar (filename )));
Sendmessage (hwndc, wm_cap_sequence, 0, 0 );
If assigned (onstartrecord) then
Onstartrecord (Self );
End;
End;

Procedure tracameraeye. savetobmp (filename: string );
Begin
If hwndc <> 0 then
Sendmessage (hwndc, wm_cap_savedib, 0, longint (pchar (filename )));
End;

Procedure tracameraeye. Start;
VaR
Ohandle: thandle;
Begin
If fdisplay = nil then exit;
Ohandle: = twincontrol (owner). Handle;
{Dynamic function control camera}
Hwndc: = funcap (
'My own capture Windows ',
Ws_child or ws_visible,
{Specified display range}
Fdisplay. Left, fdisplay. Top, fdisplay. Width, fdisplay. height,
Ohandle, 0 );
If hwndc <> 0 then
Begin
{Sending command}
Sendmessage (hwndc, wm_cap_set_callback_videostream, 0, 0 );
Sendmessage (hwndc, wm_cap_set_callback_error, 0, 0 );
Sendmessage (hwndc, wm_cap_set_callback_statusa, 0, 0 );
Sendmessage (hwndc, wm_cap_driver_connect, 0, 0 );
Sendmessage (hwndc, wm_cap_set_scale, 1, 0 );
Sendmessage (hwndc, wm_cap_set_previewrate, 66, 0 );
Sendmessage (hwndc, wm_cap_set_overlay, 1, 0 );
Sendmessage (hwndc, wm_cap_set_preview, 1, 0 );
End;
If assigned (onstart) then
Onstart (Self );
End;

Procedure tracameraeye. Stop;
Begin
If hwndc <> 0 then
Begin
Sendmessage (hwndc, wm_cap_driver_disconnect, 0, 0 );
Hwndc: = 0;
If assigned (onstop) then
Onstop (Self );
End;
End;

Procedure tracameraeye. stoprecord;
Begin
If hwndc <> 0 then
Begin
Sendmessage (hwndc, wm_cap_stop, 0, 0 );
If assigned (onstoprecord) then
Onstoprecord (Self );
End;
End;

End.