2013-08-20 12:35

'****************************************************************
'*  Derived from VFW.bas... VB32 wrapper for Win32 Video For Windows
'*                           functions.
'*  created:        1998 by Ray Mercer
'*
'*  last modified:  12/2/98 by Ray Mercer (added comments)
'*
'*  a Visual Basic translation of Microsoft's vfw.h file which is
'*  a part of the Win32 Platform SDK
'*
'*  Copyright (c) 1998 Ray Mercer.  All rights reserved.
'****************************************************************

     $IFNDEF __VFW_INC
      $DEFINE __VFW_INC
     $ENDIF

     $IFNDEF TRUE
      $DEFINE TRUE 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE FALSE 0
     $ENDIF



'//General WINAPI Declares
     $IFNDEF __WIN32API       'windows inc loaded?
      $IFNDEF __RQINC2         'RapidQ2.inc loaded?

       $DEFINE WM_USER &H400
    'window styles for capture window
       $DEFINE WS_OVERLAPPED       &H00000000
       $DEFINE WS_CHILD            &H40000000
       $DEFINE WS_MINIMIZE         &H20000000
       $DEFINE WS_VISIBLE          &H10000000
       $DEFINE WS_DISABLED         &H08000000
       $DEFINE WS_MAXIMIZE         &H01000000
       $DEFINE WS_CAPTION          &H00C00000     '/* WS_BORDER | WS_DLGFRAME  */
       $DEFINE WS_BORDER           &H00800000
       $DEFINE WS_DLGFRAME         &H00400000
       $DEFINE WS_THICKFRAME       &H00040000
    'extended windows styles
       $DEFINE WS_EX_DLGMODALFRAME     &H00000001
       $DEFINE WS_EX_NOPARENTNOTIFY    &H00000004
       $DEFINE WS_EX_TOPMOST           &H00000008
       $DEFINE WS_EX_TRANSPARENT       &H00000020
       $DEFINE WS_EX_TOOLWINDOW        &H00000080
       $DEFINE WS_EX_WINDOWEDGE        &H00000100
       $DEFINE WS_EX_CLIENTEDGE        &H00000200
       $DEFINE WS_EX_STATICEDGE        &H00020000
       $DEFINE WS_EX_APPWINDOW         &H00040000


'set windows position
       $DEFINE SWP_NOSIZE             &H1
       $DEFINE SWP_NOMOVE	           &H2
       $DEFINE SWP_NOZORDER 	       &H4
       $DEFINE SWP_NOACTIVATE 	       &H10
       $DEFINE SWP_SHOWWINDOW 	       &H40
       $DEFINE SWP_NOSENDCHANGING	   &H400  'Don't send WM_WINDOWPOSCHANGING */



       DECLARE FUNCTION SendMessageAPI LIB "user32" ALIAS "SendMessageA" (BYVAL hwnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, lParam AS LONG) AS LONG


'VFW "customized" File Dialogs
       TYPE OPENFILENAME
        lStructSize 	AS DWORD	'Specifies the length, in bytes, of the structure.
        hwndOwner 		AS LONG		'any valid window handle, or it can be NULL if the dialog box has no owner
        hInstance 		AS LONG		'for OFN_ENABLETEMPLATEHANDLE or ENABLETEMPLATE  flags
        lpstrFilter 	AS LONG		'pointer to string containing pairs of filter strings, ("*.TXT;*.DOC;*.BAK"), no spaces!
        lpstrCustomFilter AS LONG	'null or pointer to a pair of null-terminated filter strings for preserving the filter pattern chosen by the user
        nMaxCustFilter 	AS DWORD	'the size, in bytes of the buffer identified by lpstrCustomFilter
        nFilterIndex 	AS DWORD	'index of the currently selected filter in the File Types
        lpstrFile 		AS LONG		'Pointer to string of the file name to initialize control,can be multple if OFN_ALLOWMULTISELECT  set, _
								'first char must be NULL if no initialization. Returns drive designator, path, file name, and extension of the selected file.
        nMaxFile 		AS DWORD	'size in bytes of lpstrFile should be >256 chars
        lpstrFileTitle 	AS LONG		'Pointer to string that receives the file name and extension (without path information) of the selected file. This member can be NULL
        nMaxFileTitle 	AS DWORD	'size in bytes of lpstrFileTitle
        lpstrInitialDir AS LONG		'pointer to string containing directory, different effect on different OS versions!
        lpstrTitle 		AS LONG		'pointer to string containing title
        flags 			AS DWORD	'
        nFileOffset 	AS SHORT	'zero-based offset, number of chars  to the 1st character of the file name in lpstrFile (not path)
        nFileExtension 	AS SHORT	'zero-based offset, number of chars  to the 1st character of the file extension in lpstrFile (not path)
        lpstrDefExt 	AS LONG		'pointer to string to append as filename extension if the user fails to type an extension- only 3 characters are used, should not contain a period (.)
        lCustData 		AS LONG		'AS LPARM
        lpfnHook 		AS LONG		'AS LPOFNHOOKPROC, pointer to callback function
        lpTemplateName 	AS LONG		'pointer to string that names a dialog template resource in the module identified by the hInstance member
'#if (_WIN32_WINNT >= 0x0500)
'  void *        pvReserved;
'  DWORD         dwReserved;
'  DWORD         FlagsEx;
'#endif // (_WIN32_WINNT >= 0x0500)
       END TYPE



      $ENDIF		' __RQINC2


      DECLARE FUNCTION DestroyWindow LIB "user32" ALIAS "DestroyWindow" (BYVAL hwnd AS LONG) AS LONG


      TYPE BITMAPINFOHEADER '40 bytes
       biSize 			AS LONG			'Size of this header
       biWidth 		AS LONG			'Width of image (pixels)
       biHeight 		AS LONG			'Height of image (pixels)
       biPlanes 		AS WORD			'Number of color planes
       biBitCount 		AS WORD			'Pixel bit depth (bits per pixel)
       biCompression 	AS LONG			'Compression type
       biSizeImage 	AS LONG			'Size of image (can be 0)
       biXPelsPerMeter AS LONG			'pixels per meter
       biYPelsPerMeter AS LONG			'dimensions
       biClrUsed 		AS LONG			'Number of colors (can be 0)
       biClrImportant	AS LONG			'minimum number Important colors (can be 0)
      END TYPE


      TYPE BITMAPINFO
   'bmiHeader As BITMAPINFOHEADER	'cant nest in RapidQ
       bmiHeader_biSize 			AS DWORD'Specifies the number of bytes required by the structure.
       bmiHeader_biWidth 			AS LONG	'Specifies the width of the bitmap, in pixels.
       bmiHeader_biHeight 			AS LONG	'height, if positive, bitmap is bottom-up DIB (origin = lower left corner). If biHeight is negative,  bitmap is top-down DIB (origin = upper left corner)
       bmiHeader_biPlanes 			AS WORD	'number of planes, must be set to 1
       bmiHeader_biBitCount 		AS WORD	'number of bits per pixel, must be 1, 4, 8, 16, 24, or 32
       bmiHeader_biCompression 	AS DWORD 'type of compression for a compressed bottom-up bitmap (top-down DIBs cannot be compressed)
											'BI_RGB	= An uncompressed format
											'BI_RLE8	= A run-length encoded (RLE) format for bitmaps with 8 bits per pixel.
											'BI_RLE4 = An RLE format for bitmaps with 4 bits per pixel.
											'BI_BITFIELDS =	not compressed and that the color table consists of three doubleword color masks(RGB) respectively, of each pixel, for 16- and 32-bits-per-pixel
       bmiHeader_biSizeImage 		AS DWORD	'the size, in bytes, of the image, may be set to 0 for BI_RGB bitmaps.
       bmiHeader_biXPelsPerMeter 	AS LONG		'horizontal resolution, in pixels per meter, of the target device for the bitmap.
       bmiHeader_biYPelsPerMeter 	AS LONG
       bmiHeader_biClrUsed 		AS DWORD	'number of color indices in the color table actually used, if zero, the bitmap uses max of biBitCount
       bmiHeader_biClrImportant 	AS DWORD	'number of color indices that are considered important for displaying the bitmap
	'bmiColors As RGBQUAD
       bmiColors_rgbBlue 			AS BYTE
       bmiColors_rgbGreen 			AS BYTE
       bmiColors_rgbRed 			AS BYTE
       bmiColors_rgbReserved 		AS BYTE
      END TYPE


     $ENDIF		'__WIN32API



'------------------------------------------------------------------
'  Messages which can be sent to an AVICAP window
'------------------------------------------------------------------
     Public CONST WM_CAP_START AS LONG = WM_USER

     Public CONST WM_CAP_GET_CAPSTREAMPTR AS LONG = WM_CAP_START + 1

     Public CONST WM_CAP_SET_CALLBACK_ERROR AS LONG = WM_CAP_START + 2
     Public CONST WM_CAP_SET_CALLBACK_STATUS AS LONG = WM_CAP_START + 3
     Public CONST WM_CAP_SET_CALLBACK_YIELD AS LONG = WM_CAP_START + 4
     Public CONST WM_CAP_SET_CALLBACK_FRAME AS LONG = WM_CAP_START + 5
     Public CONST WM_CAP_SET_CALLBACK_VIDEOSTREAM AS LONG = WM_CAP_START + 6
     Public CONST WM_CAP_SET_CALLBACK_WAVESTREAM AS LONG = WM_CAP_START + 7
     Public CONST WM_CAP_GET_USER_DATA AS LONG = WM_CAP_START + 8
     Public CONST WM_CAP_SET_USER_DATA AS LONG = WM_CAP_START + 9

     Public CONST WM_CAP_DRIVER_CONNECT AS LONG = WM_CAP_START + 10
     Public CONST WM_CAP_DRIVER_DISCONNECT AS LONG = WM_CAP_START + 11
     Public CONST WM_CAP_DRIVER_GET_NAME AS LONG = WM_CAP_START + 12
     Public CONST WM_CAP_DRIVER_GET_VERSION AS LONG = WM_CAP_START + 13
     Public CONST WM_CAP_DRIVER_GET_CAPS AS LONG = WM_CAP_START + 14

     Public CONST WM_CAP_FILE_SET_CAPTURE_FILE AS LONG = WM_CAP_START + 20
     Public CONST WM_CAP_FILE_GET_CAPTURE_FILE AS LONG = WM_CAP_START + 21
     Public CONST WM_CAP_FILE_ALLOCATE AS LONG = WM_CAP_START + 22
     Public CONST WM_CAP_FILE_SAVEAS AS LONG = WM_CAP_START + 23
     Public CONST WM_CAP_FILE_SET_INFOCHUNK AS LONG = WM_CAP_START + 24
     Public CONST WM_CAP_FILE_SAVEDIB AS LONG = WM_CAP_START + 25

     Public CONST WM_CAP_EDIT_COPY AS LONG = WM_CAP_START + 30

     Public CONST WM_CAP_SET_AUDIOFORMAT AS LONG = WM_CAP_START + 35
     Public CONST WM_CAP_GET_AUDIOFORMAT AS LONG = WM_CAP_START + 36

     Public CONST WM_CAP_DLG_VIDEOFORMAT AS LONG = WM_CAP_START + 41
     Public CONST WM_CAP_DLG_VIDEOSOURCE AS LONG = WM_CAP_START + 42
     Public CONST WM_CAP_DLG_VIDEODISPLAY AS LONG = WM_CAP_START + 43
     Public CONST WM_CAP_GET_VIDEOFORMAT AS LONG = WM_CAP_START + 44
     Public CONST WM_CAP_SET_VIDEOFORMAT AS LONG = WM_CAP_START + 45
     Public CONST WM_CAP_DLG_VIDEOCOMPRESSION AS LONG = WM_CAP_START + 46

     Public CONST WM_CAP_SET_PREVIEW AS LONG = WM_CAP_START + 50
     Public CONST WM_CAP_SET_OVERLAY AS LONG = WM_CAP_START + 51
     Public CONST WM_CAP_SET_PREVIEWRATE AS LONG = WM_CAP_START + 52
     Public CONST WM_CAP_SET_SCALE AS LONG = WM_CAP_START + 53
     Public CONST WM_CAP_GET_STATUS AS LONG = WM_CAP_START + 54
     Public CONST WM_CAP_SET_SCROLL AS LONG = WM_CAP_START + 55

     Public CONST WM_CAP_GRAB_FRAME AS LONG = WM_CAP_START + 60
     Public CONST WM_CAP_GRAB_FRAME_NOSTOP AS LONG = WM_CAP_START + 61

     Public CONST WM_CAP_SEQUENCE AS LONG = WM_CAP_START + 62
     Public CONST WM_CAP_SEQUENCE_NOFILE AS LONG = WM_CAP_START + 63
     Public CONST WM_CAP_SET_SEQUENCE_SETUP AS LONG = WM_CAP_START + 64
     Public CONST WM_CAP_GET_SEQUENCE_SETUP AS LONG = WM_CAP_START + 65
     Public CONST WM_CAP_SET_MCI_DEVICE AS LONG = WM_CAP_START + 66
     Public CONST WM_CAP_GET_MCI_DEVICE AS LONG = WM_CAP_START + 67
     Public CONST WM_CAP_STOP AS LONG = WM_CAP_START + 68
     Public CONST WM_CAP_ABORT AS LONG = WM_CAP_START + 69

     Public CONST WM_CAP_SINGLE_FRAME_OPEN AS LONG = WM_CAP_START + 70
     Public CONST WM_CAP_SINGLE_FRAME_CLOSE AS LONG = WM_CAP_START + 71
     Public CONST WM_CAP_SINGLE_FRAME AS LONG = WM_CAP_START + 72

     Public CONST WM_CAP_PAL_OPEN AS LONG = WM_CAP_START + 80
     Public CONST WM_CAP_PAL_SAVE AS LONG = WM_CAP_START + 81
     Public CONST WM_CAP_PAL_PASTE AS LONG = WM_CAP_START + 82
     Public CONST WM_CAP_PAL_AUTOCREATE AS LONG = WM_CAP_START + 83
     Public CONST WM_CAP_PAL_MANUALCREATE AS LONG = WM_CAP_START + 84

     Public CONST WM_CAP_SET_CALLBACK_CAPCONTROL AS LONG = WM_CAP_START + 85

' ------------------------------------------------------------------
'  VFW UDTS (from vfw.h)
' ------------------------------------------------------------------

     TYPE VFWPOINT 		'strange name to avoid collision with other POINT UDTs
      x AS LONG
      y AS LONG
     END TYPE

     TYPE CAPDRIVERCAPS
      wDeviceIndex AS LONG                    '// Driver index in system.ini
      fHasOverlay AS LONG                     '// Can device overlay?
      fHasDlgVideoSource AS LONG              '// Has Video source dlg?
      fHasDlgVideoFormat AS LONG              '// Has Format dlg?
      fHasDlgVideoDisplay AS LONG             '// Has External out dlg?
      fCaptureInitialized AS LONG             '// Driver ready to capture?
      fDriverSuppliesPalettes AS LONG         '// Can driver make palettes?
      hVideoIn AS LONG                        '// Driver In channel
      hVideoOut AS LONG                       '// Driver Out channel
      hVideoExtIn AS LONG                     '// Driver Ext In channel
      hVideoExtOut AS LONG                    '// Driver Ext Out channel
     END TYPE

     TYPE CAPSTATUS
      uiImageWidth AS LONG                    '// Width of the image
      uiImageHeight AS LONG                   '// Height of the image
      fLiveWindow AS LONG                     '// Now Previewing video?
      fOverlayWindow AS LONG                  '// Now Overlaying video?
      fScale AS LONG                          '// Scale image to client?
'    ptScroll As VFWPOINT                    '// Scroll position
      ptScroll_x AS LONG
      ptScroll_y AS LONG
      fUsingDefaultPalette AS LONG            '// Using default driver palette?
      fAudioHardware AS LONG                  '// Audio hardware present?
      fCapFileExists AS LONG                  '// Does capture file exist?
      dwCurrentVideoFrame AS LONG             '// # of video frames cap'td
      dwCurrentVideoFramesDropped AS LONG     '// # of video frames dropped
      dwCurrentWaveSamples AS LONG            '// # of wave samples cap'td
      dwCurrentTimeElapsedMS AS LONG          '// Elapsed capture duration
      hPalCurrent AS LONG                     '// Current palette in use
      fCapturingNow AS LONG                   '// Capture in progress?
      dwReturn AS LONG                        '// Error value after any operation
      wNumVideoAllocated AS LONG              '// Actual number of video buffers
      wNumAudioAllocated AS LONG              '// Actual number of audio buffers
     END TYPE

     Public CONST AVSTREAMMASTER_AUDIO AS LONG = 0  '/* Audio master (VFW 1.0, 1.1) */
     Public CONST AVSTREAMMASTER_NONE  AS LONG = 1  '/* No master */

     TYPE CAPTUREPARMS
      dwRequestMicroSecPerFrame AS LONG       '// Requested capture rate
      fMakeUserHitOKToCapture AS LONG         '// Show "Hit OK to cap" dlg?
      wPercentDropForError AS LONG            '// Give error msg if > (10% default)
      fYield AS LONG                          '// Capture via background task?
      dwIndexSize AS LONG                     '// Max index size in frames (32K default)
      wChunkGranularity AS LONG               '// Junk chunk granularity (2K default)
      fUsingDOSMemory AS LONG                 '// Use DOS buffers? (obsolete)
      wNumVideoRequested AS LONG              '// # video buffers, If 0, autocalc
      fCaptureAudio AS LONG                   '// Capture audio?
      wNumAudioRequested AS LONG              '// # audio buffers, If 0, autocalc
      vKeyAbort AS LONG                       '// Virtual key causing abort
      fAbortLeftMouse AS LONG                 '// Abort on left mouse?
      fAbortRightMouse AS LONG                '// Abort on right mouse?
      fLimitEnabled AS LONG                   '// Use wTimeLimit?
      wTimeLimit AS LONG                      '// Seconds to capture
      fMCIControl AS LONG                     '// Use MCI video source?
      fStepMCIDevice AS LONG                  '// Step MCI device?
      dwMCIStartTime AS LONG                  '// Time to start in MS
      dwMCIStopTime AS LONG                   '// Time to stop in MS
      fStepCaptureAt2x AS LONG                '// Perform spatial averaging 2x
      wStepCaptureAverageFrames AS LONG       '// Temporal average n Frames
      dwAudioBufferSize AS LONG               '// Size of audio bufs (0 = default)
      fDisableWriteCache AS LONG              '// Attempt to disable write cache
      AVStreamMaster AS LONG                  '// Which stream controls length?
     END TYPE


     TYPE CAPINFOCHUNK
      fccInfoID AS LONG                       '// Chunk ID, "ICOP" for copyright
      lpData AS LONG                          '// pointer to data
      cbData AS LONG                          '// size of lpData
     END TYPE

     TYPE VIDEOHDR
      lpData AS LONG                          ' address of video buffer
      dwBufferLength AS LONG                  ' size, in bytes, of the Data buffer
      dwBytesUsed AS LONG                     ' Bytes actually used
      dwTimeCaptured AS LONG                  ' Milliseconds from start of stream
      dwUser AS LONG                          ' user-specific data
      dwFlags AS LONG                         ' VHDR_DONE 		Done bit
											' VHDR_PREPARED 	Set if this header has been prepared
											' VHDR_INQUEUE 	Reserved for driver
											' VHDR_KEYFRAME 	Key Frame
      dwReserved(3) AS LONG                   ' reserved; do not use
     END TYPE



     TYPE WAVEFORMATEX
      wFormatTag 	AS WORD
      nChannels 	AS WORD
      nSamplesPerSec AS DWORD
      nAvgBytesPerSec AS DWORD
      nBlockAlign AS WORD
      wBitsPerSample AS WORD
      cbSize AS WORD
     END TYPE


'// Capture Function Declares
     DECLARE FUNCTION capCreateCaptureWindow LIB "avicap32.dll" ALIAS "capCreateCaptureWindowA" _
      (BYVAL lpszWindowName AS STRING, _
      BYVAL dwStyle AS LONG, _
      BYVAL x AS LONG, _
      BYVAL y AS LONG, _
      BYVAL nWidth AS LONG, _
      BYVAL nHeight AS LONG, _
      BYVAL hwndParent AS LONG, _
      BYVAL nID AS LONG) AS LONG 'returns HWND

     DECLARE FUNCTION capGetDriverDescription LIB "avicap32.dll" ALIAS "capGetDriverDescriptionA" _
      (BYVAL dwDriverIndex AS LONG, _
      BYVAL lpszName AS STRING, _
      BYVAL cbName AS LONG, _
      BYVAL lpszVer AS STRING, _
      BYVAL cbVer AS LONG) AS LONG 'returns C BOOL



     DECLARE FUNCTION GetOpenFileNamePreview LIB "msvfw32.dll" _
      ALIAS "GetOpenFileNamePreviewA" (filestruct AS OPENFILENAME) AS LONG
     PRIVATE DECLARE FUNCTION GetSaveFileNamePreview LIB "msvfw32.dll" _
      ALIAS "GetSaveFileNamePreviewA" (filestruct AS OPENFILENAME) AS LONG



'// ------------------------------------------------------------------
'// IDs for status and error callbacks
'// ------------------------------------------------------------------

     Public CONST IDS_CAP_BEGIN AS LONG = 300              '/* "Capture Start" */
     Public CONST IDS_CAP_END AS LONG = 301                '/* "Capture End" */

     Public CONST IDS_CAP_INFO AS LONG = 401               '/* "%s" */
     Public CONST IDS_CAP_OUTOFMEM AS LONG = 402           '/* "Out of memory" */
     Public CONST IDS_CAP_FILEEXISTS AS LONG = 403         '/* "File '%s' exists -- overwrite it?" */
     Public CONST IDS_CAP_ERRORPALOPEN AS LONG = 404       '/* "Error opening palette '%s'" */
     Public CONST IDS_CAP_ERRORPALSAVE AS LONG = 405       '/* "Error saving palette '%s'" */
     Public CONST IDS_CAP_ERRORDIBSAVE AS LONG = 406       '/* "Error saving frame '%s'" */
     Public CONST IDS_CAP_DEFAVIEXT AS LONG = 407          '/* "avi" */
     Public CONST IDS_CAP_DEFPALEXT AS LONG = 408          '/* "pal" */
     Public CONST IDS_CAP_CANTOPEN AS LONG = 409           '/* "Cannot open '%s'" */
     Public CONST IDS_CAP_SEQ_MSGSTART AS LONG = 410       '/* "Select OK to start capture\nof video sequence\nto %s." */
     Public CONST IDS_CAP_SEQ_MSGSTOP AS LONG = 411        '/* "Hit ESCAPE or click to end capture" */

     Public CONST IDS_CAP_VIDEDITERR AS LONG = 412         '/* "An error occurred while trying to run VidEdit." */
     Public CONST IDS_CAP_READONLYFILE AS LONG = 413       '/* "The file '%s' is a read-only file." */
     Public CONST IDS_CAP_WRITEERROR AS LONG = 414         '/* "Unable to write to file '%s'.\nDisk may be full." */
     Public CONST IDS_CAP_NODISKSPACE AS LONG = 415        '/* "There is no space to create a capture file on the specified device." */
     Public CONST IDS_CAP_SETFILESIZE AS LONG = 416        '/* "Set File Size" */
     Public CONST IDS_CAP_SAVEASPERCENT AS LONG = 417      '/* "SaveAs: %2ld%%  Hit Escape to abort." */

     Public CONST IDS_CAP_DRIVER_ERROR AS LONG = 418       '/* Driver specific error message */

     Public CONST IDS_CAP_WAVE_OPEN_ERROR AS LONG = 419    '/* "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." */
     Public CONST IDS_CAP_WAVE_ALLOC_ERROR AS LONG = 420   '/* "Error: Out of memory for wave buffers." */
     Public CONST IDS_CAP_WAVE_PREPARE_ERROR AS LONG = 421 '/* "Error: Cannot prepare wave buffers." */
     Public CONST IDS_CAP_WAVE_ADD_ERROR AS LONG = 422     '/* "Error: Cannot add wave buffers." */
     Public CONST IDS_CAP_WAVE_SIZE_ERROR AS LONG = 423    '/* "Error: Bad wave size." */

     Public CONST IDS_CAP_VIDEO_OPEN_ERROR AS LONG = 424   '/* "Error: Cannot open the video input device." */
     Public CONST IDS_CAP_VIDEO_ALLOC_ERROR AS LONG = 425  '/* "Error: Out of memory for video buffers." */
     Public CONST IDS_CAP_VIDEO_PREPARE_ERROR AS LONG = 426 '/* "Error: Cannot prepare video buffers." */
     Public CONST IDS_CAP_VIDEO_ADD_ERROR AS LONG = 427    '/* "Error: Cannot add video buffers." */
     Public CONST IDS_CAP_VIDEO_SIZE_ERROR AS LONG = 428   '/* "Error: Bad video size." */

     Public CONST IDS_CAP_FILE_OPEN_ERROR AS LONG = 429    '/* "Error: Cannot open capture file." */
     Public CONST IDS_CAP_FILE_WRITE_ERROR AS LONG = 430   '/* "Error: Cannot write to capture file.  Disk may be full." */
     Public CONST IDS_CAP_RECORDING_ERROR AS LONG = 431    '/* "Error: Cannot write to capture file.  Data rate too high or disk full." */
     Public CONST IDS_CAP_RECORDING_ERROR2 AS LONG = 432   '/* "Error while recording" */
     Public CONST IDS_CAP_AVI_INIT_ERROR AS LONG = 433     '/* "Error: Unable to initialize for capture." */
     Public CONST IDS_CAP_NO_FRAME_CAP_ERROR AS LONG = 434 '/* "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." */
     Public CONST IDS_CAP_NO_PALETTE_WARN AS LONG = 435    '/* "Warning: Using default palette." */
     Public CONST IDS_CAP_MCI_CONTROL_ERROR AS LONG = 436  '/* "Error: Unable to access MCI device." */
     Public CONST IDS_CAP_MCI_CANT_STEP_ERROR AS LONG = 437 '/* "Error: Unable to step MCI device." */
     Public CONST IDS_CAP_NO_AUDIO_CAP_ERROR AS LONG = 438 '/* "Error: No audio data captured.\nCheck audio card settings." */
     Public CONST IDS_CAP_AVI_DRAWDIB_ERROR AS LONG = 439  '/* "Error: Unable to draw this data format." */
     Public CONST IDS_CAP_COMPRESSOR_ERROR AS LONG = 440   '/* "Error: Unable to initialize compressor." */
     Public CONST IDS_CAP_AUDIO_DROP_ERROR AS LONG = 441   '/* "Error: Audio data was lost during capture, reduce capture rate." */

'/* status string IDs */
     Public CONST IDS_CAP_STAT_LIVE_MODE AS LONG = 500      '/* "Live window" */
     Public CONST IDS_CAP_STAT_OVERLAY_MODE AS LONG = 501   '/* "Overlay window" */
     Public CONST IDS_CAP_STAT_CAP_INIT AS LONG = 502       '/* "Setting up for capture - Please wait" */
     Public CONST IDS_CAP_STAT_CAP_FINI AS LONG = 503       '/* "Finished capture, now writing frame %ld" */
     Public CONST IDS_CAP_STAT_PALETTE_BUILD AS LONG = 504  '/* "Building palette map" */
     Public CONST IDS_CAP_STAT_OPTPAL_BUILD AS LONG = 505   '/* "Computing optimal palette" */
     Public CONST IDS_CAP_STAT_I_FRAMES AS LONG = 506       '/* "%d frames" */
     Public CONST IDS_CAP_STAT_L_FRAMES AS LONG = 507       '/* "%ld frames" */
     Public CONST IDS_CAP_STAT_CAP_L_FRAMES AS LONG = 508   '/* "Captured %ld frames" */
     Public CONST IDS_CAP_STAT_CAP_AUDIO AS LONG = 509      '/* "Capturing audio" */
     Public CONST IDS_CAP_STAT_VIDEOCURRENT AS LONG = 510   '/* "Captured %ld frames (%ld dropped) %d.%03d sec." */
     Public CONST IDS_CAP_STAT_VIDEOAUDIO AS LONG = 511     '/* "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps).  %ld audio bytes (%d,%03d sps)" */
     Public CONST IDS_CAP_STAT_VIDEOONLY AS LONG = 512      '/* "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps)" */


'Translations of C- "Message Cracker" Macros to VB (declared in vfw.h)
' to disable Callbacks, set lpProc to 0
     FUNCTION capSetCallbackOnError(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnError = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_ERROR, 0&, lpProc)
     END FUNCTION
     FUNCTION capSetCallbackOnStatus(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnStatus = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_STATUS, 0&, lpProc)
     END FUNCTION
     FUNCTION capSetCallbackOnYield(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnYield = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_YIELD, 0&, lpProc)
     END FUNCTION
     FUNCTION capSetCallbackOnFrame(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnFrame = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_FRAME, 0&, lpProc)
     END FUNCTION
     FUNCTION capSetCallbackOnVideoStream(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnVideoStream = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0&, lpProc)
     END FUNCTION
	'Proper CallBack Function template:
	' use for capSetCallbackOnFrame  OR capSetCallbackOnVideoStream
	'FUNCTION capVideoStreamCallback(hCapWnd AS LONG, lpVHdr AS VIDEOHDR) AS LONG
	'...
	'END FUNCTION

	'IF capSetCallbackOnFrame(hCapWnd, CODEPTR(capVideoStreamCallback) = 0 THEN 'flag error


     FUNCTION capSetCallbackOnWaveStream(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnWaveStream = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0&, lpProc)
     END FUNCTION
     FUNCTION capSetCallbackOnCapControl(BYVAL hCapWnd AS LONG, BYVAL lpProc AS LONG) AS LONG' Boolean
      capSetCallbackOnCapControl = SendMessageAPI(hCapWnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0&, lpProc)
     END FUNCTION

     FUNCTION capSetUserData(BYVAL hCapWnd AS LONG, BYVAL lUser AS LONG) AS LONG' Boolean
      capSetUserData = SendMessageAPI(hCapWnd, WM_CAP_SET_USER_DATA, 0&, lUser)
     END FUNCTION
     FUNCTION capGetUserData(BYVAL hCapWnd AS LONG) AS LONG
      capGetUserData = SendMessageAPI(hCapWnd, WM_CAP_GET_USER_DATA, 0&, 0&)
     END FUNCTION

     FUNCTION capDriverConnect(BYVAL hCapWnd AS LONG, BYVAL i AS LONG) AS LONG' Boolean
'	i = 0&
      capDriverConnect = SendMessageAPI(hCapWnd, WM_CAP_DRIVER_CONNECT, i, 0&)
     END FUNCTION

     FUNCTION capDriverDisconnect(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capDriverDisconnect = SendMessageAPI(hCapWnd, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
     END FUNCTION

     FUNCTION capDriverGetName(BYVAL hCapWnd AS LONG) AS STRING
   'returns driver name as VB string
      DIM szBuffer AS STRING

      szBuffer = STRING$(128, 0)
      CALL SendMessageAPI(hCapWnd, WM_CAP_DRIVER_GET_NAME, 128, szBuffer)
      capDriverGetName = LEFT$(szBuffer, INSTR(szBuffer, CHR$(0)) - 1)
     END FUNCTION

     FUNCTION capDriverGetVersion(BYVAL hCapWnd AS LONG) AS STRING
   'returns version as VB string
      DIM szBuffer AS STRING
      DIM retVal AS LONG' Boolean

      szBuffer = STRING$(128, 0)
      retVal = SendMessageAPI(hCapWnd, WM_CAP_DRIVER_GET_VERSION, 128, szBuffer)
      IF 0 <> retVal THEN
       capDriverGetVersion = LEFT$(szBuffer, INSTR(szBuffer, CHR$(0)) - 1)
      END IF
     END FUNCTION

     FUNCTION capDriverGetCaps(hCapWnd AS LONG, Caps AS CAPDRIVERCAPS, lSize AS LONG) AS LONG' Boolean
   'fills CAPDRIVERCAPS UDT
      capDriverGetCaps = SendMessageAPI(hCapWnd, WM_CAP_DRIVER_GET_CAPS, lSize, Caps)
     END FUNCTION

     FUNCTION capFileSetCaptureFile(BYVAL hCapWnd AS LONG, lpSzFileName AS LONG) AS LONG	'ByVal FilePath As String) As Long
      capFileSetCaptureFile = SendMessageAPI(hCapWnd, WM_CAP_FILE_SET_CAPTURE_FILE, 0&, lpSzFileName)
     END FUNCTION

     FUNCTION capFileGetCaptureFile(BYVAL hCapWnd AS LONG) AS STRING
   'returns full path of capture file as VB string
      DIM szBuffer AS STRING
      DIM retVal AS LONG' Boolean

      szBuffer = STRING$(128, 0)
      retVal = SendMessageAPI(hCapWnd, WM_CAP_FILE_GET_CAPTURE_FILE, 128, szBuffer)
      IF retVal THEN
       capFileGetCaptureFile = LEFT$(szBuffer, INSTR(szBuffer, CHR$(0)) - 1)
      END IF
     END FUNCTION

     FUNCTION capFileAlloc(BYVAL hCapWnd AS LONG, BYVAL dwSize AS LONG) AS LONG' Boolean
      capFileAlloc = SendMessageAPI(hCapWnd, WM_CAP_FILE_ALLOCATE, 0&, dwSize)
     END FUNCTION

     FUNCTION capFileSaveAs(BYVAL hCapWnd AS LONG, BYVAL lpSzFilePath AS LONG) AS LONG' Boolean
      capFileSaveAs = SendMessageAPI(hCapWnd, WM_CAP_FILE_SAVEAS, 0&, lpSzFilePath)
     END FUNCTION

     FUNCTION capFileSetInfoChunk(BYVAL hCapWnd AS LONG, ByRef InfChunk AS CAPINFOCHUNK) AS LONG' Boolean
      capFileSetInfoChunk = SendMessageAPI(hCapWnd, WM_CAP_FILE_SET_INFOCHUNK, 0&, InfChunk)
     END FUNCTION

     FUNCTION capFileSaveDIB(BYVAL hCapWnd AS LONG, BYVAL lpSzFileName AS LONG) AS LONG
      capFileSaveDIB = SendMessageAPI(hCapWnd, WM_CAP_FILE_SAVEDIB, 0&, lpSzFileName)
     END FUNCTION

     FUNCTION capEditCopy(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capEditCopy = SendMessageAPI(hCapWnd, WM_CAP_EDIT_COPY, 0&, 0&)
     END FUNCTION

     FUNCTION capSetAudioFormat(BYVAL hCapWnd AS LONG, ByRef wavFormat AS WAVEFORMATEX, BYVAL WavFormatSize AS LONG) AS LONG' Boolean
      capSetAudioFormat = SendMessageAPI(hCapWnd, WM_CAP_SET_AUDIOFORMAT, WavFormatSize, wavFormat)
     END FUNCTION

     FUNCTION capSetAudioFormatAsArray(BYVAL hCapWnd AS LONG, BYVAL wavFormat AS LONG, BYVAL WavFormatSize AS LONG) AS LONG' Boolean
      capSetAudioFormatAsArray = SendMessageAPI(hCapWnd, WM_CAP_SET_AUDIOFORMAT, WavFormatSize, wavFormat)
     END FUNCTION

     FUNCTION capGetAudioFormat(BYVAL hCapWnd AS LONG, ByRef wavFormat AS WAVEFORMATEX, BYVAL WavFormatSize AS LONG) AS LONG
      capGetAudioFormat = SendMessageAPI(hCapWnd, WM_CAP_GET_AUDIOFORMAT, WavFormatSize, wavFormat)
     END FUNCTION

     FUNCTION capGetAudioFormatAsArray(BYVAL hCapWnd AS LONG, BYVAL wavFormat AS LONG, BYVAL WavFormatSize AS LONG) AS LONG
      capGetAudioFormatAsArray = SendMessageAPI(hCapWnd, WM_CAP_GET_AUDIOFORMAT, WavFormatSize, wavFormat)
     END FUNCTION

     FUNCTION capGetAudioFormatSize(BYVAL hCapWnd AS LONG) AS LONG
      capGetAudioFormatSize = SendMessageAPI(hCapWnd, WM_CAP_GET_AUDIOFORMAT, 0&, 0&)
     END FUNCTION

     FUNCTION capDlgVideoFormat(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capDlgVideoFormat = SendMessageAPI(hCapWnd, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
     END FUNCTION

     FUNCTION capDlgVideoSource(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capDlgVideoSource = SendMessageAPI(hCapWnd, WM_CAP_DLG_VIDEOSOURCE, 0&, 0&)
     END FUNCTION

     FUNCTION capDlgVideoDisplay(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capDlgVideoDisplay = SendMessageAPI(hCapWnd, WM_CAP_DLG_VIDEODISPLAY, 0&, 0&)
     END FUNCTION

     FUNCTION capDlgVideoCompression(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capDlgVideoCompression = SendMessageAPI(hCapWnd, WM_CAP_DLG_VIDEOCOMPRESSION, 0&, 0&)
     END FUNCTION

     FUNCTION capGetVideoFormat(BYVAL hCapWnd AS LONG, ByRef BmpFormat AS BITMAPINFO, BYVAL CapFormatSize AS LONG) AS LONG
      capGetVideoFormat = SendMessageAPI(hCapWnd, WM_CAP_GET_VIDEOFORMAT, CapFormatSize, BmpFormat)
     END FUNCTION

     FUNCTION capGetVideoFormatSize(BYVAL hCapWnd AS LONG) AS LONG
      capGetVideoFormatSize = SendMessageAPI(hCapWnd, WM_CAP_GET_VIDEOFORMAT, 0&, 0&)
     END FUNCTION

     FUNCTION capSetVideoFormat(BYVAL hCapWnd AS LONG, ByRef BmpFormat AS BITMAPINFO, BYVAL CapFormatSize AS LONG) AS LONG' Boolean
      capSetVideoFormat = SendMessageAPI(hCapWnd, WM_CAP_SET_VIDEOFORMAT, CapFormatSize, BmpFormat)
     END FUNCTION

     FUNCTION capPreview(BYVAL hCapWnd AS LONG, BYVAL f AS LONG) AS LONG' Boolean
      capPreview = SendMessageAPI(hCapWnd, WM_CAP_SET_PREVIEW, f, 0&) 'convert the VB Boolean to a C BOOL with the - sign
     END FUNCTION

     FUNCTION capPreviewRate(BYVAL hCapWnd AS LONG, BYVAL wMS AS LONG) AS LONG' Boolean
      capPreviewRate = SendMessageAPI(hCapWnd, WM_CAP_SET_PREVIEWRATE, wMS, 0&)
     END FUNCTION

     FUNCTION capOverlay(BYVAL hCapWnd AS LONG, BYVAL f AS LONG) AS LONG' Boolean
      capOverlay = SendMessageAPI(hCapWnd, WM_CAP_SET_OVERLAY, -(f), 0&)
     END FUNCTION

     FUNCTION capPreviewScale(BYVAL hCapWnd AS LONG, BYVAL f AS LONG) AS LONG' Boolean
      capPreviewScale = SendMessageAPI(hCapWnd, WM_CAP_SET_SCALE, -(f), 0&)
     END FUNCTION

     FUNCTION capGetStatus(BYVAL hCapWnd AS LONG, ByRef capStat AS CAPSTATUS, wSize AS LONG) AS LONG' Boolean
      capGetStatus = SendMessageAPI(hCapWnd, WM_CAP_GET_STATUS, wSize, capStat)
     END FUNCTION

     FUNCTION capSetScrollPos(BYVAL hCapWnd AS LONG, ByRef pt AS VFWPOINT) AS LONG' Boolean
      capSetScrollPos = SendMessageAPI(hCapWnd, WM_CAP_SET_SCROLL, 0&, pt)
     END FUNCTION

     FUNCTION capGrabFrame(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capGrabFrame = SendMessageAPI(hCapWnd, WM_CAP_GRAB_FRAME, 0&, 0&)
     END FUNCTION

     FUNCTION capGrabFrameNoStop(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capGrabFrameNoStop = SendMessageAPI(hCapWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureSequence(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureSequence = SendMessageAPI(hCapWnd, WM_CAP_SEQUENCE, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureSequenceNoFile(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureSequenceNoFile = SendMessageAPI(hCapWnd, WM_CAP_SEQUENCE_NOFILE, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureStop(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureStop = SendMessageAPI(hCapWnd, WM_CAP_STOP, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureAbort(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureAbort = SendMessageAPI(hCapWnd, WM_CAP_ABORT, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureSingleFrameOpen(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureSingleFrameOpen = SendMessageAPI(hCapWnd, WM_CAP_SINGLE_FRAME_OPEN, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureSingleFrameClose(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureSingleFrameClose = SendMessageAPI(hCapWnd, WM_CAP_SINGLE_FRAME_CLOSE, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureSingleFrame(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capCaptureSingleFrame = SendMessageAPI(hCapWnd, WM_CAP_SINGLE_FRAME, 0&, 0&)
     END FUNCTION

     FUNCTION capCaptureGetSetup(BYVAL hCapWnd AS LONG, ByRef capParms AS CAPTUREPARMS, S AS LONG) AS LONG' Boolean
      capCaptureGetSetup = SendMessageAPI(hCapWnd, WM_CAP_GET_SEQUENCE_SETUP, S, capParms)
     END FUNCTION

     FUNCTION capCaptureSetSetup(BYVAL hCapWnd AS LONG, capParms AS CAPTUREPARMS,  S AS LONG) AS LONG' Boolean
      capCaptureSetSetup = SendMessageAPI(hCapWnd, WM_CAP_SET_SEQUENCE_SETUP, S, capParms)
     END FUNCTION

     FUNCTION capSetMCIDeviceName(BYVAL hCapWnd AS LONG, BYVAL lpDeviceName AS LONG) AS LONG' Boolean
   'DeviceName = DeviceName & Chr$(0) 'null-terminate the string just to be safe
      capSetMCIDeviceName = SendMessageAPI(hCapWnd, WM_CAP_SET_MCI_DEVICE, 0&, lpDeviceName)
     END FUNCTION

     FUNCTION capGetMCIDeviceName(BYVAL hCapWnd AS LONG) AS STRING
   'returns device name as VB string (default name is "")
      DIM dwSize AS LONG
      DIM szBuffer AS STRING

      dwSize = 128 'MCISTRING_MAX
      szBuffer = STRING$(dwSize, 0)
      CALL SendMessageAPI(hCapWnd, WM_CAP_GET_MCI_DEVICE, dwSize, szBuffer)
      capGetMCIDeviceName = LEFT$(szBuffer, INSTR(szBuffer, CHR$(0)) - 1)
     END FUNCTION

     FUNCTION capPaletteOpen(BYVAL hCapWnd AS LONG, BYVAL lpSzFilePath AS LONG) AS LONG' Boolean
      capPaletteOpen = SendMessageAPI(hCapWnd, WM_CAP_PAL_OPEN, 0&, lpSzFilePath)
     END FUNCTION

     FUNCTION capPaletteSave(BYVAL hCapWnd AS LONG, BYVAL lpSzFilePath AS LONG) AS LONG' Boolean
      capPaletteSave = SendMessageAPI(hCapWnd, WM_CAP_PAL_SAVE, 0&, lpSzFilePath)
     END FUNCTION

     FUNCTION capPalettePaste(BYVAL hCapWnd AS LONG) AS LONG' Boolean
      capPalettePaste = SendMessageAPI(hCapWnd, WM_CAP_PAL_PASTE, 0&, 0&)
     END FUNCTION

     FUNCTION capPaletteAuto(BYVAL hCapWnd AS LONG, BYVAL iFrames AS LONG, BYVAL iColors AS LONG) AS LONG' Boolean
      IF iColors < 257 THEN     'iColors should not be greater than 256
       capPaletteAuto = SendMessageAPI(hCapWnd, WM_CAP_PAL_AUTOCREATE, iFrames, iColors)
      ELSE
       SHOWMESSAGE "Error in Color num -- capPaletteAuto"
      END IF
     END FUNCTION

     FUNCTION capPaletteManual(BYVAL hCapWnd AS LONG, BYVAL f AS LONG, BYVAL iColors AS LONG) AS LONG' Boolean
      IF iColors < 257 THEN       'iColors should not be greater than 256
       capPaletteManual = SendMessageAPI(hCapWnd, WM_CAP_PAL_MANUALCREATE, -(f), iColors)
      ELSE
       SHOWMESSAGE "Error in Color num -- capPaletteAuto"
      END IF
     END FUNCTION





'*********************************************************************************
'*****
'*****
'*****    Custom video Cam capture component based on vfw API calls
'*****        John Kelly , 2/2005
'*****
'*********************************************************************************



     TYPE QWebCam EXTENDS QOBJECT

PUBLIC:
      hCapWnd			AS LONG		'our capture window frame (not parent)
      CamNum			AS LONG		'in case more than one camera & driver, index 0 - 9
      Left			AS LONG
      Top				AS LONG
      Width			AS LONG
      Height			AS LONG
      Overlay			AS LONG
      Init 			AS LONG
      FrameBuffers    AS LONG     'max number of requested frame buffers
      ImageHeight		AS LONG		PROPERTY SET SetImageHeight
      ImageWidth		AS LONG		PROPERTY SET SetImageWidth
      BitCount		AS WORD		PROPERTY SET SetBitCount
      Preview			AS LONG		PROPERTY SET SetPreview
      Capture 		AS LONG		PROPERTY SET SetCapture         'to file or each frame buffer
      FrameInterval	AS WORD		'Interval, in milliseconds, between frames are captured and displayed
      FramesDropped	AS LONG
      CAPTION			AS STRING
      Tag				AS LONG		'window ID from createWindow function
      FormStyle		AS LONG
	'This is an Event but Function pointers don't give absolute address so this doesnt work ->EVENT(OnFrame_EventTemplate)
      OnFrame 		AS LONG		PROPERTY SET SetOnFrame





      FUNCTION CamInit(Form AS QFORM) AS LONG			'Create Cap Window, init the web cam
       DIM rtn AS LONG
       DIM	DriverCaps	AS CAPDRIVERCAPS
       DIM MyCapParms	AS CAPTUREPARMS


       IF This.Init THEN EXIT FUNCTION		'been here before? Then don't run

	'**** use capCapture from vfw.inc  ******
       WITH This
        .hCapWnd = capCreateCaptureWindow(.CAPTION, .FormStyle, .Left, .Top, .Width, .Height, Form.Handle, .tag)
        IF .hCapWnd = 0 THEN
         SHOWMESSAGE("Could not create capture window")
         RESULT = 0
         EXIT FUNCTION
        END IF

	' Get the current streaming video parms, and reset with user values
        capCaptureGetSetup(.hCapWnd, MyCapParms, SIZEOF(MyCapParms))
        MyCapParms.dwRequestMicroSecPerFrame = .FrameInterval '3333 = 30 frames per second
        MyCapParms.fYield = true                      ' capture in background/allow processing
        MyCapParms.wNumVideoRequested = This.FrameBuffers  ' max number of video frame buffs - just a guess
        MyCapParms.fCaptureAudio = false                   ' don't capture audio
        MyCapParms.AVStreamMaster = AVSTREAMMASTER_NONE ' no audio/video syncing

    'set up the driver and capture
        IF capCaptureSetSetup(.hCapWnd, MyCapParms, SIZEOF(MyCapParms)) = 0 THEN SHOWMESSAGE "Set setup failed"
	'capCaptureGetSetup(.hCapWnd, MyCapParms, sizeof(MyCapParms))	'to check if values set...

    'connect
        rtn = capDriverConnect (.hCapWnd, .CamNum)
        IF rtn THEN
         capDriverGetCaps(.hCapWnd, DriverCaps, SIZEOF (DriverCaps))
         .Init = DriverCaps.fCaptureInitialized
         .CamNum = DriverCaps.wDeviceIndex	'reset Connect?
         .Overlay = DriverCaps.fHasOverlay
         IF .Overlay THEN .Overlay = capOverlay(.hCapWnd, True)		'auto turn on Overlay
         IF .Preview THEN
          capPreviewRate(.hCapWnd, .FrameInterval)
          .Preview = capPreview(.hCapWnd, True)
         END IF
         IF (.OnFrame <> 0) THEN
          IF capSetCallbackOnFrame(This.hCapWnd, This.OnFrame) = 0 THEN SHOWMESSAGE "Frame Callback Error"
         END IF
        ELSE
         SHOWMESSAGE("Could not connect to Camera")
        END IF
       END WITH
       RESULT = rtn
      END FUNCTION



      SUB SetOnFrame(TheCallBackAddr AS LONG)		'pass in 0 to turn off callback
       This.OnFrame = TheCallBackAddr
       IF This.Init THEN
        IF capSetCallbackOnFrame(This.hCapWnd, This.OnFrame) = 0 THEN SHOWMESSAGE "Frame Callback Error"
       END IF
      END SUB



      FUNCTION SetImageHeight (TheImageHeight AS LONG) AS LONG
       DIM VideoFormat AS BITMAPINFO
       DIM SzbmpInfo AS DWORD: SzbmpInfo = SIZEOF(VideoFormat)

       IF TheImageHeight > 0 THEN
        This.ImageHeight =  TheImageHeight
        IF This.Init THEN
         SzbmpInfo = capGetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo)
         IF SzbmpInfo = 0 THEN RESULT = 0: EXIT FUNCTION		'crashed!
         VideoFormat.bmiHeader_biSize = SzbmpInfo
         VideoFormat.bmiHeader_biHeight = TheImageHeight		'if positive, bitmap is bottom-up DIB (origin = lower left corner). If biHeight is negative,  bitmap is top-down DIB (origin = upper left corner)
         IF capSetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo) THEN
          This.ImageHeight =  TheImageHeight
          RESULT =  TheImageHeight
         END IF
        END IF
       END IF
      END FUNCTION


      SUB SetImageWidth (TheImageWidth AS LONG) AS LONG
       DIM VideoFormat AS BITMAPINFO
       DIM SzbmpInfo AS DWORD: SzbmpInfo = SIZEOF(VideoFormat)

       IF TheImageWidth > 0 THEN
        This.ImageWidth =  TheImageWidth
        IF This.Init THEN
         SzbmpInfo = capGetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo)
         IF SzbmpInfo = 0 THEN RESULT = 0: EXIT SUB		'crashed!
         VideoFormat.bmiHeader_biSize = SzbmpInfo
         VideoFormat.bmiHeader_biWidth = TheImageWidth
         IF capSetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo) THEN
          This.ImageWidth =  TheImageWidth
          RESULT =  TheImageWidth
         END IF
        END IF
       END IF
      END SUB



      FUNCTION SetBitCount (TheBitCount AS WORD) AS WORD
       DIM VideoFormat AS BITMAPINFO
       DIM SzbmpInfo AS DWORD: SzbmpInfo = SIZEOF(VideoFormat)

       RESULT = 0
       IF TheBitCount > 0 THEN
		'This.BitCount =  TheBitCount
        IF This.Init THEN
         SzbmpInfo = capGetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo)
         IF SzbmpInfo = 0 THEN RESULT = 0: EXIT FUNCTION		'crashed!
         VideoFormat.bmiHeader_biSize = SzbmpInfo
         VideoFormat.bmiHeader_biBitCount = TheBitCount
         IF capSetVideoFormat(This.hCapWnd, VideoFormat, SzbmpInfo) THEN
          This.BitCount =  TheBitCount
          RESULT =  TheBitCount
         END IF
        END IF
       END IF
      END FUNCTION



      FUNCTION GetStatus() AS LONG
       DIM CapStats	AS CAPSTATUS

       WITH This
        RESULT = 0
        IF capGetStatus(.hCapWnd, CapStats, SIZEOF(CapStats)) THEN
         .ImageHeight = CapStats.uiImageHeight
         .ImageWidth	= CapStats.uiImageWidth
         .FramesDropped = CapStats.dwCurrentVideoFramesDropped
         .Overlay = CapStats.fOverlayWindow
         .Preview = CapStats.fLiveWindow
         RESULT = True
        END IF
       END WITH
      END FUNCTION



      SUB ShowDialogBox(TheBoxNum)		'get info button
       DIM WasCapturing	AS LONG
       DIM	DriverCaps	    AS CAPDRIVERCAPS

       WasCapturing = False
       IF TheBoxNum THEN
        IF This.Capture THEN
         WasCapturing = True
         This.Capture = False
        END IF

        IF This.Init = False THEN
         capDriverGetCaps(This.hCapWnd, DriverCaps, SIZEOF (DriverCaps))
        END IF

        SHOWMESSAGE STR$(DriverCaps.fHasDlgVideoFormat)
'ShowMessage str$(DriverCaps.fHasDlgVideoSource)
'ShowMessage str$(DriverCaps.fHasDlgVideoDisplay)

	' Video source Dialog box
        SELECT CASE TheBoxNum
        CASE 1
'            IF DriverCaps.fHasDlgVideoFormat THEN capDlgVideoFormat(This.hCapWnd)
         capDlgVideoFormat(This.hCapWnd)
        CASE 2
         IF DriverCaps.fHasDlgVideoSource THEN capDlgVideoSource(This.hCapWnd)
        CASE 3
         IF DriverCaps.fHasDlgVideoDisplay THEN capDlgVideoDisplay(This.hCapWnd)
        CASE ELSE
         capDlgVideoCompression(This.hCapWnd)
        END SELECT
'       IF WasCapturing THEN This.Capture = True
       END IF
      END SUB



      SUB SetCapture(TheCaptureFlag AS LONG)
       WITH This
        .Capture = TheCaptureFlag
        IF .Init THEN
         IF .Capture THEN
          .Capture = capCaptureSequenceNoFile(.hCapWnd)
          IF .Overlay THEN .Overlay = capOverlay(.hCapWnd, True)		'auto turn on Overlay
         ELSE
          IF .Overlay THEN .Overlay = capOverlay(.hCapWnd, False)		'auto turn off Overlay
          capCaptureStop(.hCapWnd)
         END IF
        END IF
       END WITH
      END SUB



      SUB SetPreview(ThePreviewFlag AS LONG)
       This.Preview = ThePreviewFlag
       IF This.Init THEN
        IF This.Preview THEN
         capPreview(This.hCapWnd, True)
        ELSE
         capPreview(This.hCapWnd, 0&)
        END IF
       END IF
      END SUB




      SUB CleanUp
       WITH This
        IF .Init THEN
         capPreview(.hCapWnd, 0&)
         capSetCallbackOnFrame(.hCapWnd, 0&)	'turn off callback
         capCaptureStop(.hCapWnd)
'		IF .Capture THEN capCaptureStop(.hCapWnd)
         capDriverDisconnect(.hCapWnd)
         DestroyWindow(.hCapWnd)
         .Init = False
        END IF
       END WITH
      END SUB






      FUNCTION GrabFrameToClipBoard() AS LONG
       DIM i AS INTEGER
       DIM T AS SINGLE
       DIM info AS TBITMAP
       DIM rtn AS LONG
       DIM hBitmap AS LONG
       DIM Bitmap1 AS QBITMAP

       capEditCopy(This.hCapWnd)
       IF clipboard.hasformat(CF_BITMAP) THEN
        clipboard.OPEN
        hBitmap=clipboard.GetAsHandle(CF_BITMAP)
        clipboard.CLOSE
       ELSE
        SHOWMESSAGE "Cliboard is not in a valid format"
       END IF

       RESULT = GetObject(Bitmap1.Handle,SIZEOF(info),info)
       RESULT = GetObject(hBitmap,SIZEOF(info),info)
      END FUNCTION



      FUNCTION SaveFrameToFile(TheFileName AS STRING) AS LONG
       DIM TmpStr 	AS STRING

       TmpStr = TheFileName				'RQ does not pass the string pointer to function!!
       capGrabFrameNoStop(This.hCapWnd)
       RESULT = capFileSaveDIB(This.hCapWnd, VARPTR(TmpStr))	' need this to send pointer
      END FUNCTION



      SUB ReSize(TheForm AS QFORM)
       DIM retVal AS LONG
       DIM capStats AS CAPSTATUS

    'Get the capture window attributes
       retVal = capGetStatus(This.hCapWnd, CapStats, SIZEOF(CapStats))
       IF retVal THEN
        'Resize the parent form to fit
        CALL SetWindowPos(TheForm.Handle, _
         0&, _
         0&, _
         0&, _
         This.ImageWidth + (TheForm.Width - TheForm.ClientWidth), _
         This.ImageHeight + (TheForm.Height - TheForm.ClientHeight),_
         SWP_NOMOVE OR SWP_NOZORDER OR SWP_NOSENDCHANGING)
'        'Resize the capture window to format size
        CALL SetWindowPos(This.hCapWnd, _
         0&, _
         0&, _
         0&, _
         This.ImageWidth, _
         This.ImageHeight, _
         SWP_NOMOVE OR SWP_NOZORDER OR SWP_NOSENDCHANGING)
        capPreviewScale(This.hCapWnd, True)
       END IF
      END SUB



      CONSTRUCTOR
       CamNum			= 0
       Left			= 0
       Top				= 0
       Width			= 240
       Height			= 200
       OverLay			= 0
       Init			= 0
       FrameBuffers    = 4
       ImageHeight 	= This.SetImageHeight(This.Height)		'set these by GetStatus
       ImageWidth		= This.SetImageWidth(This.Width)
       Capture 		= 0
       FrameInterval	= 16	'16 ms or about 60 Hz
       FramesDropped	= 0
       Preview			= True
       CAPTION			= "video"
       Tag				= 0
       FormStyle		= WS_CHILD OR WS_VISIBLE
      END CONSTRUCTOR


     END TYPE




     SUB AddThisStuff

'	capDriverGetCaps(ghWndCap, &CapDrvCaps, sizeof (CAPDRIVERCAPS))

	' Video source Dialog box
'	if (CapDrvCaps.fHasDlgVideoSource) THEN capDlgVideoSource(ghWndCap)

	' Video format dialog box.
'	if (CapDrvCaps.fHasDlgVideoFormat) THEN capDlgVideoFormat(ghWndCap)


	' Are there new image dimensions?
'	capGetStatus(ghWndCap, &CapStatus, sizeof (CAPSTATUS))

	' If so, notify the parent of a size change.

	' Video source Dialog box
'	if (CapDrvCaps.fHasDlgVideoDisplay THEN capDlgVideoDisplay(ghWndCap)


     END SUB

2013-08-20 12:35