• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 515
  • Last Modified:

Real-time video capture using Delphi 2

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
StuartB
Asked:
StuartB
  • 6
  • 3
1 Solution
 
StuartBAuthor Commented:
Edited text of question
0
 
StuartBAuthor Commented:
Edited text of question
0
 
mirek071497Commented:
Please submit more info.
You need create avi from Bitmaps or other things.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
StuartBAuthor Commented:
Edited text of question
0
 
StuartBAuthor Commented:
Edited text of question
0
 
StuartBAuthor Commented:
Adjusted points to 170
0
 
mirek071497Commented:
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
 
mirek071497Commented:
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
 
StuartBAuthor Commented:
Very fast service.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now