' 
' 'sample code to test vfw.inc usb/webcam avi/capture
'  JohnK
$TYPECHECK ON
$INCLUDE <RapidQ2.inc>
$INCLUDE <vfw.inc>

DECLARE SUB CamFrameEvent(hCapWnd AS LONG, lpVHdr AS LONG)
DECLARE SUB CleanUp_WebCam
DECLARE SUB FormKeyDown(Key AS Word, Shift AS INTEGER)
DECLARE SUB StartTheCamUp
DECLARE SUB ReSetImage
DECLARE SUB ResizeMyBMPs
DECLARE SUB SetMenuItem(Sender AS QMENUITEM)

CREATE CamForm AS QFORM
	BorderStyle = bsToolWindow
	Caption = "Camera output, Click to Start"
    Center
 	OnClose = CleanUp_WebCam
    OnClick = StartTheCamUp
    OnKeyDown = FormKeyDown
END CREATE


CREATE MyCam AS QWebCam
    ShowErrors = True         'if  errors showmessages
    BitCount = 24
END CREATE

CREATE BMPx  AS QBitmapEx     'capture to our bitmap!
    PixelFormat = pf24bit     'must set this
    Font.Size = 15
    Font.AddStyles(fsBold, fsItalic)
END CREATE
DIM BMPx_pointer AS LONG

DIM RedBMP  AS QBitmap     'a red filter
    RedBMP.PixelFormat = pf24bit     'must set this

DIM BMPxErase AS QBitmapEx  'to remove last capture
    BMPxErase.PixelFormat = pf24bit
    BMPxErase.CopyMode = cmSrcErase

DIM  RedFlag    as integer
DIM  InvFlag    as integer
DIM  Motion1Flag   as integer
DIM  MotionFlag as integer

CREATE MyBitmapForm AS QFORM     'form with bitmap
  CREATE MainMenu AS QMainMenu
  CREATE MainTitle AS QMenuItem
    Caption = "Options"
  CREATE RedMenu AS QMenuItem
    RadioItem = True
    Caption = "red filter"
    OnClick = SetMenuItem
  END CREATE
  CREATE InvertMenu AS QMenuItem
    Caption = "invert"
    OnClick = SetMenuItem
  END CREATE
  CREATE Motion1Menu AS QMenuItem
    Caption = "Motion detect dark"
    OnClick = SetMenuItem
  END CREATE
  CREATE MontionMenu AS QMenuItem
    Caption = "motion detect light"
    OnClick = SetMenuItem
  END CREATE
  END CREATE
  END CREATE
END CREATE

SUB SetMenuItem(Sender AS QMENUITEM)
    RedFlag = False
    InvFlag = False
    Motion1Flag = False
    MotionFlag = False
    IF Sender.Handle = RedMenu.Handle THEN RedFlag = True : BMPx.CopyMode = cmSrcAnd
    IF Sender.Handle = InvertMenu.Handle THEN InvFlag = True :BMPx.CopyMode = cmDstInvert     'cmSrcInvert =inverse with filter
    IF Sender.Handle = Motion1Menu.Handle THEN Motion1Flag = True:  BMPx.CopyMode = cmSrcErase
    IF Sender.Handle = MontionMenu.Handle THEN MotionFlag = True: :  BMPx.CopyMode = cmMergePaint
    'cmNotSrcErase = &H1100A6 ' dest = (NOT src) AND (NOT dest)
    'cmSrcInvert = &H660046  ' dest = source XOR dest
    'cmSrcPaint = &HEE0086  ' dest = source OR dest
END SUB

'=== get it all going  ====
CamForm.ShowModal


SUB StartTheCamUp
    IF MyCam.CamInit(CamForm) THEN
        CamForm.Show
        MyCam.Preview = True
        IF MyCam.SetImageSize(320, 240) = False THEN showmessage "cannot set size"
        MyCam.Resize(CamForm)
        ReSetImage
        CamForm.Caption = "<Enter>options <b>bitmap <s>save img"
    ELSE
        Showmessage "Error: cannot initialize Camera"
        Application.Terminate
    END IF
END SUB


SUB FormKeyDown(Key AS Word, Shift AS INTEGER) 
  SELECT CASE Key

   CASE 27 'esc
	IF MyCam.Preview THEN
		MyCam.Preview = False
	ELSE
		MyCam.Preview = True
	END IF

   CASE 13 'Return
     ReSetImage

   CASE ASC("b"), ASC("B")      'toggle bitmap capture
	IF MyCam.OnFrame THEN
		MyCam.OnFrame = 0&
        MyBitmapForm.Close
	ELSE
		MyCam.OnFrame = CODEPTR(CamFrameEvent)
        IF (MyBitmapForm.ClientWidth <> MyCam.ImageWidth) OR _
            (MyBitmapForm.ClientHeight <> MyCam.ImageHeight) THEN
            ResizeMyBMPs    
        END IF
        MyBitmapForm.Show
	END IF

   CASE ASC("s"), ASC("S")      'toggle bitmap Save
	   IF (MyCam.SaveFrameToFile("test.bmp") = False) THEN ShowMessage "Capture failed"
  END SELECT
END SUB



SUB CleanUp_WebCam
	MyCam.CleanUp			'turns off OnFrameEvent
	IF CamForm.Visible THEN CamForm.Close
END SUB


SUB ReSetImage
    'This code allows the user to set their own video dimensions
    MyCam.ShowDialogBox(1)      '1 = video size, 2=options, 3=display, 4 = compression
    MyCam.GetStatus             'what happened?
    IF MyCam.SetImageSize(MyCam.ImageWidth, MyCam.ImageHeight) = False THEN
        showmessage "cannot set size"
    ELSE
        MyCam.Resize(CamForm)
        ResizeMyBMPs
    END IF
END SUB



SUB ResizeMyBMPs
    MyBitmapForm.ClientWidth = MyCam.ImageWidth
    MyBitmapForm.ClientHeight = MyCam.ImageHeight
    BMPx.Width = MyCam.ImageWidth
    BMPx.Height = MyCam.ImageHeight
    BMPx_pointer = BMPx.Pointer
    RedBMP.Width = MyCam.ImageWidth
    RedBMP.Height = MyCam.ImageHeight
    RedBMP.FillRect(0,0, RedBMP.Width, RedBMP.Height, &HFF)
    BMPxErase.Width = MyCam.ImageWidth
    BMPxErase.Height = MyCam.ImageHeight
END SUB


SUB CamFrameEvent(hCapWnd AS LONG, lpVHdr AS LONG) 'doesn't work with lpVHdr as VIDEOHDR)
    STATIC IsBusy           'we are busy go away

    IF IsBusy = False THEN
        IsBusy = True
     	DIM Hdr AS VIDEOHDR
     	MEMCPY(Hdr, lpVHdr, SIZEOF(Hdr))		'must do this! Can't pass UDT
     	MEMCPY(BMPx_Pointer, (Hdr.lpData), MyCam.ImageWidth * MyCam.ImageHeight * (MyCam.BitCount\8))

        IF (RedFlag OR InvFlag) THEN BMPx.Draw(0,0, RedBMP.BMP)
        IF (Motion1Flag OR MotionFlag) THEN 
            BMPx.Draw(0,0, BMPxErase.BMP)
         	MEMCPY(BMPxErase.Pointer, (Hdr.lpData), MyCam.ImageWidth * MyCam.ImageHeight * (MyCam.BitCount\8))
        ELSE
            BMPx.TextOut(0&, 0&, "Aren't you pretty?", 255, -1)
        END IF
        MyBitmapForm.Draw(0,0, BMPx.BMP)
        IsBusy = False
    END IF
END SUB