Improve company productivity with a Business Account.Sign Up

x
?
Solved

Real-time video capture using Delphi 2

Posted on 1997-09-07
9
Medium Priority
?
521 Views
Last Modified: 2010-04-04
I want to be able to generate an AVI file of moving real-time video from a video camera which is attatched to my computer.  The AVI file will be about 5 minutes in length.  I also want to be able to pass the size of the AVI frame i.e. 160 * 120 or 320*240, etc as a parameter when I initialise the video capture routine.

I roughly know how to do it using C, but I am finding Delphi a problem and I don't want to have to use C DLL's in my code, the boss wouldn't be happy.

VERY URGENT!!!!!!!!!!!!!!
0
Comment
Question by:StuartB
  • 6
  • 3
9 Comments
 

Author Comment

by:StuartB
ID: 1344301
Edited text of question
0
 

Author Comment

by:StuartB
ID: 1344302
Edited text of question
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1344303
Please submit more info.
You need create avi from Bitmaps or other things.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

Author Comment

by:StuartB
ID: 1344304
Edited text of question
0
 

Author Comment

by:StuartB
ID: 1344305
Edited text of question
0
 

Author Comment

by:StuartB
ID: 1344306
Adjusted points to 170
0
 
LVL 3

Expert Comment

by:mirek071497
ID: 1344307
Mail to me source in C then i translate this to Delphi.
Which version of Delphi ?
Now i don't know what you need. Do you need create avi from bitmaps in memory ? I don't know what is you'r video capture routine. I try do this fast but i connect to Ex-Ex only at 9:00am and 17:00 GMT.

mirek@izabell.itcomp.tpnet.pl
0
 
LVL 3

Accepted Solution

by:
mirek071497 earned 200 total points
ID: 1344308
Here is the translated source, but You must change variables for constans. The constans is defined in you'r header files.
I havn't Video Capture Hardware so i can't test this, and i can't say you whay you can't use other resolutions.


unit Capt;

Interface

uses
  Windows;

type
  TCaptureParams = record
    dwRequestMicroSecPerFrame : DWORD;
    fMakeUserHitOKToCapture   : BOOLEAN;
    wPercentDropForError      : word;
    fYield                    : boolean;
    dwIndexSize               : DWORD;
    wChunkGranularity         : word;
    fUsingDOSMemory           : Boolean;
    wNumVideoRequested        : word;
    fCaptureAudio             : Boolean;
    wNumAudioRequested        : word;
    vKeyAbort                 : word;
    fAbortLeftMouse           : Boolean;
    fAbortRightMouse          : Boolean;
    fLimitEnabled             : Boolean;
    wTimeLimit                : word;
    fMCIControl               : Boolean;
    fStepMCIDevice            : Boolean;
    dwMCIStartTime            : Dword;
    dwMCIStopTime             : Dword;
    fStepCaptureAt2x          : Boolean;
    wStepCaptureAverageFrames : word;
    dwAudioBufferSize         : DWord;
    fDisableWriteCache        : Boolean;
    AVStreamMaster            : word;
  end;
  PCaptureParams = ^TCaptureParams;


procedure SetVideoSize( hCaptureWindow : THandle; Width, Height : Integer );
// Sets the size of the image to capture into the AVI file.

(*
// i don't know what you need with this
// this proc is not used so i omit this
extern int _export WINAPI ImageProc( int FAR noLanes, int direction, int UK, int areaLen,
                                     int FAR *LenArray, int topCorr, int bottomCorr, int FAR *outCount);
*)

function CaptureAVI( hWndMain : THandle; Width, Height, FrameRate, AudioFlag, AudioBufSize,
                     CaptureTime, DoubRes : Integer; CaptureFile : LPSTR ) : THandle;
// Sets up and initiates the video capture sequence.

procedure AbortCaptureAVI( hCaptureWindow : THandle );
// Aborts the video capture sequence.

procedure StopCaptureAVI( hCaptureWindow : THandle );
// Stops the video capture sequence and saves the AVI file to the hard drive.




{ This functions need be imported but i don't know from which file
  I found so in they exist in schel32.dll but you must try this
  - You can find this in SDK !!}
function capSetVideoFormat( hCaptureWindow : THandle; bih : Pointer; sizeofbih: Integer ) : boolean;
function capCreateCaptureWindow( lpszWindowName : LPCSTR; dwStyle : DWORD; x, y, nWidth, nHeight : Integer;
                                 hWnd : THandle; nID : Integer ) : THandle;
procedure capCaptureGetSetup( hWnd : THandle; psCapParm : PCaptureParams; sizeofCAPPARMS : integer );
procedure capCaptureSetSetup(hwnd : THandle; psCapParms : PCaptureParams; wSize : integer);
procedure capFileSetCaptureFile(hwnd : THandle; szName : LPCSTR );


{ i don't know the value of this constans
  You must set correct values from vfw.h }
const
  WM_CAP_DRIVER_CONNECT = 0;
  WM_CAP_SEQUENCE       = 0;
  WM_CAP_ABORT          = 0;
  WM_CAP_STOP           = 0;

implementation

function  capSetVideoFormat; external 'Shell32.dll' name 'capSetVideoFormat';
function  capCreateCaptureWindow; external 'Shell32.dll' name 'capCreateCaptureWindow';
procedure capCaptureGetSetup; external 'Shell32.dll' name 'capCaptureGetSetup';
procedure capCaptureSetSetup; external 'Shell32.dll' name 'capCaptureSetSetup';
procedure capFileSetCaptureFile;  external 'Shell32.dll' name 'capFileSetCaptureFile';

procedure SetVideoSize( hCaptureWindow : THandle; Width, Height : Integer );
var bih : TBITMAPINFOHEADER;
begin
// This function was copied off the Microsoft MSDN library discs, but doesn't seem to work.
// If you have any insight into this it would be great.
// Rescale the frame size.
// Variable used to hold bitmap formatting info. for sizing the captured AVI frame.
  bih.biSize          := sizeof(TBITMAPINFOHEADER);
  bih.biCompression   := BI_RGB;
  bih.biWidth         := Width;
  bih.biHeight        := Height;
  bih.biPlanes        := 1;
  bih.biBitCount      := 8;
  bih.biSizeImage     := bih.biWidth * bih.biHeight * bih.biPlanes * bih.biBitCount div 8;
  bih.biXPelsPerMeter := 0;
  bih.biYPelsPerMeter := 0;
  bih.biClrUsed       := 0;
  bih.biClrImportant  := 0;
  if not capSetVideoFormat( hCaptureWindow, @bih, sizeof(bih) ) then
    if MessageBox( hCaptureWindow,
       'Video Formatting information has been rejected by your video driver hardware',
       'Incompatibility Warning',
       MB_APPLMODAL and MB_ICONINFORMATION and MB_OKCANCEL )=IDCANCEL then
      AbortCaptureAVI(hCaptureWindow);   // Aborts the capture process.
end;


function CaptureAVI( hWndMain : THandle; Width, Height, FrameRate, AudioFlag, AudioBufSize,
                     CaptureTime, DoubRes : Integer; CaptureFile : LPSTR ) : THandle;
var
  CapParms : TCaptureParams;
  hCaptureWindow : THandle;
begin
// Create a capture window.
  hCaptureWindow := capCreateCaptureWindow( 'Capture Window', WS_CHILD, 0, 0, Width, Height, hWndMain, 0);
// Attempt to rescale the frame size.  This function always seems to fail.
// If you have any insight into this I would be grateful.
  SetVideoSize(hCaptureWindow, Width, Height);

// Analyse system and initiate video drivers.
  SendMessage(hCaptureWindow, WM_CAP_DRIVER_CONNECT, 0, 0 );

// Gets the current state of the video capture control structure.
  capCaptureGetSetup(hCaptureWindow, @CapParms, sizeof(TCaptureParams));

// Overrides to the video capture control structure.
  CapParms.dwRequestMicroSecPerFrame := round( FrameRate * 4444.466666 );
  CapParms.fMakeUserHitOKToCapture := FALSE;
  CapParms.fYield := TRUE;
  CapParms.fCaptureAudio := boolean(AudioFlag);
  CapParms.vKeyAbort := NULL;
  CapParms.fAbortLeftMouse := FALSE;
  CapParms.fAbortRightMouse := FALSE;
  if(CaptureTime > 0) then
    begin
      CapParms.fLimitEnabled := TRUE;
      CapParms.wTimeLimit := CaptureTime;
    end
  else
    CapParms.fLimitEnabled := FALSE;

  CapParms.fStepCaptureAt2x := boolean(DoubRes);
  CapParms.dwAudioBufferSize := AudioBufSize;
//      CapParms.AVIStreamMaster = AVISTREAMMASTER_NONE;

// Set the overrides to the structure.
  capCaptureSetSetup(hCaptureWindow, @CapParms, sizeof(TCAPTUREPARAMS));

// Tells the capture function where to place the capture file.
  capFileSetCaptureFile(hCaptureWindow, CaptureFile);

// Capture video sequence.
  SendMessage(hCaptureWindow, WM_CAP_SEQUENCE, 0, 0 );


// returns handle to capture window to enable the calling application to stop the capture sequence.
  result := hCaptureWindow;

end;

procedure AbortCaptureAVI( hCaptureWindow : THandle );
begin
  SendMessage( hCaptureWindow, WM_CAP_ABORT, 0, 0 );
  DestroyWindow( hCaptureWindow );
end;

procedure StopCaptureAVI( hCaptureWindow : THandle );
begin
  SendMessage(hCaptureWindow, WM_CAP_STOP, 0, 0 );
  DestroyWindow(hCaptureWindow);
end;

end.
0
 

Author Comment

by:StuartB
ID: 1344309
Very fast service.
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In the video, one can understand the process of resizing images in single or bulk. Kernel Bulk Image Resizer is an easy to use tool for resizing large number of images. One can add and resize multiple images with this tool in single go. The video sh…
Watch the video to know the simple way to remove or recover or reset lost or forgotten passwords of Outlook PST file. With Kernel Outlook Password Recovery tool such operation is very easy to perform. It is a freeware with limitation to use with 500…

585 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question