PureBasic Forums - English

Code: Select all

#IDS_CAP_END = 301

#MicroSecond = 1000000

Enumeration
  #Window_0
EndEnumeration

Enumeration
  #Stream_0
  #Frame_0
  
EndEnumeration

Structure MYCAPSTATUS
  uiImageWidth.l
  uiImageHeight.l
  fLiveWindow.l
  fOverlayWindow.l
  fScale.l
  ptScroll.POINT
  fUsingDefaultPalette.l
  fAudioHardware.l
  fCapFileExists.l
  dwCurrentVideoFrame.l
  dwCurrentVideoFramesDropped.l
  dwCurrentWaveSamples.l
  dwCurrentTimeElapsedMS.l
  hPalCurrent.l
  fCapturingNow.l
  dwReturn.l
  wNumVideoAllocated.l
  wNumAudioAllocated.l
EndStructure


Structure MYCAPDRIVERCAPS 
  wDeviceIndex.l
  fHasOverlay.l
  fHasDlgVideoSource.l
  fHasDlgVideoFormat.l
  fHasDlgVideoDisplay.l
  fCaptureInitialized.l
  fDriverSuppliesPalettes.l
  hVideoIn.l
  hVideoOut.l
  hVideoExtIn.l
  hVideoExtOut.l
EndStructure 

Structure MYCAPTUREPARMS
dwRequestMicroSecPerFrame.l
fMakeUserHitOKToCapture.l
wPercentDropForError.l
fYield.l
dwIndexSize.l
wChunkGranularity.l
fUsingDOSMemory.l
wNumVideoRequested.l
fCaptureAudio.l
wNumAudioRequested.l
vKeyAbort.l
fAbortLeftMouse.l
fAbortRightMouse.l
fLimitEnabled.l
wTimeLimit.l
fMCIControl.l
fStepMCIDevice.l
dwMCIStartTime.l
dwMCIStopTime.l
fStepCaptureAt2x.l
wStepCaptureAverageFrames.l
dwAudioBufferSize.l
fDisableWriteCache.l
AVStreamMaster.l
EndStructure

mycapDriver.MYCAPDRIVERCAPS
mycapSetup.MYCAPTUREPARMS

;...I'll capture ~15 frames per sec
mycapSetup\dwRequestMicroSecPerFrame = #MicroSecond / 15
mycapSetup\fYield = #True
;...Max frames captured
mycapSetup\dwIndexSize = 1800
mycapSetup\fCaptureAudio = #True
;...Press Esc to stop capture
mycapSetup\vKeyAbort = #VK_ESCAPE
;...I'll auto end capture after 10 seconds
mycapSetup\fLimitEnabled = #True
mycapSetup\wTimeLimit = 10

Procedure CapStatusCallback(hwnd.l, nId.l, lpsz.l)
  result = #True
  If nId = #IDS_CAP_END
    StatusBarText(0, 0, "Capture ended")
    DisableGadget(0, 0)
    DisableGadget(1, 0)
    DisableGadget(2, 0)
    DisableGadget(3, 1)
    DisableGadget(4, 0)
    DisableGadget(5, 0)
  Else
    StatusBarText(0, 1, PeekS(lpsz))
  EndIf
  ProcedureReturn result
EndProcedure

Procedure CapYieldCallback(hwnd.l)
  result = #True
  ProcedureReturn result
EndProcedure

;...Path to saved stream capture
capStream$ = "c:\cap_stream.avi"

;...Path to saved frame capture
capFrame$ = "c:\cap_frame.bmp"

If OpenWindow(0, 0, 0, 685, 325, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) 
  If CreateStatusBar(0, WindowID(0))
    AddStatusBarField(135)
    AddStatusBarField(550)
    StatusBarText(0, 0, "")
    StatusBarText(0, 1, "")
  EndIf
  
  ;If CreateGadgetList(WindowID(0))
    ButtonGadget(0,10,10,90,20,"Select Format")
    ButtonGadget(1,110,10,90,20,"Select Source")
    ButtonGadget(2,210,10,90,20,"Capture Stream")
    ButtonGadget(3,310,10,90,20,"Stop Capture")
    DisableGadget(3, 1)
    ButtonGadget(4,410,10,90,20,"Capture Frame")
    ButtonGadget(5,510,10,90,20,"Save Frame...")
    ImageGadget(6, 350, 40, 320, 240, 0)
  ;EndIf
EndIf

If OpenLibrary(1, "C:\WINDOWS\system32\avicap32.dll")
  *capAddress = GetFunction(1, "capCreateCaptureWindowA")
  ;hWndC = CallFunctionFast(*capAddress, "My Capture Window", #WS_BORDER |#WS_CHILD | #WS_VISIBLE, 15, 40, 320, 240, WindowID(0),10)
  hWndC = CallFunctionFast(*capAddress, 0, #WS_BORDER |#WS_CHILD | #WS_VISIBLE, 15, 40, 320, 240, WindowID(0),10)
  CloseLibrary(0)
  SendMessage_(hWndC, #WM_CAP_DRIVER_CONNECT, 0, 0)
  SendMessage_(hWndC, #WM_CAP_SET_PREVIEW, #True, 0)
  SendMessage_(hWndC, #WM_CAP_SET_PREVIEWRATE, 30, 0)
  SendMessage_(hWndC, #WM_CAP_SET_CALLBACK_YIELD, 0, @CapYieldCallback())
  SendMessage_(hWndC, #WM_CAP_SET_CALLBACK_STATUS, 0, @CapStatusCallback())
  ;...Open a dialog to select video format
  SendMessage_(hWndC, #WM_CAP_DLG_VIDEOFORMAT, 0, 0)
  UpdateWindow_(hWndC)
Else
  MessageRequester("Error", "Could not open avicap32.dll", #PB_MessageRequester_Ok | #MB_ICONERROR)
EndIf

quit = #False

Repeat 
  
  event = WaitWindowEvent() 
  
  Select event
    
    Case #PB_Event_Gadget
      
      Select EventGadget()
        ;...Select video format
        Case 0
          SendMessage_(hWndC, #WM_CAP_DLG_VIDEOFORMAT, 0, 0)
          UpdateWindow_(hWndC)
          
        ;...Select capture source  
        Case 1
         SendMessage_(hWndC, #WM_CAP_DLG_VIDEOSOURCE, 0, 0)
        
        ;...Start capture stream
        Case 2
          DisableGadget(0, 1)
          DisableGadget(1, 1)
          DisableGadget(2, 1)
          DisableGadget(3, 0)
          DisableGadget(4, 1)
          DisableGadget(5, 1)
          
          ;...Clean up our previous stream capture
          If FileSize(capStream$)
            DeleteFile(capStream$)
          EndIf
          
          StatusBarText(0, 0, "Capturing to " + capStream$)
          StatusBarText(0, 1, "Press Esc To stop capture")
          SendMessage_(hWndC, #WM_CAP_SET_SEQUENCE_SETUP, SizeOf(MYCAPTUREPARMS), @mycapSetup)
          SendMessage_(hWndC, #WM_CAP_FILE_SET_CAPTURE_FILEA, 0, capStream$)
          SendMessage_(hWndC, #WM_CAP_SEQUENCE, 0, 0)
          StatusBarText(0, 0, "Press Esc to stop capture")
         
        ;...End capture stream  
        Case 3
          SendMessage_(hWndC, #WM_CAP_STOP, 0, 0)
          DisableGadget(0, 0)
          DisableGadget(1, 0)
          DisableGadget(2, 0)
          DisableGadget(2, 1)
          DisableGadget(4, 0)
          DisableGadget(5, 0)
          StatusBarText(0, 0, "Capture ended")
          
        ;...Capture still frame
        Case 4
          SendMessage_(hWndC, #WM_CAP_FILE_SAVEDIBA, 0, capFrame$)
          LoadImage(0, capFrame$)
          ResizeImage(0, 320, 240)
          SetGadgetState(6, ImageID(0))
          
        ;...Save captured still frame  
        Case 5
          saveFrame$ = SaveFileRequester("Save Captured Frame", "c:\myframe.bmp", "Image *.bmp", 0) 
          If saveFrame$
            SaveImage(0, saveFrame$)
          EndIf
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      SendMessage_(hWndC, #WM_CAP_STOP, 0, 0)
      SendMessage_(hWndC, #WM_CAP_DRIVER_DISCONNECT, 0, 0)
      DestroyWindow_(hWndC)
      quit = #True
      
  EndSelect
  
Until quit = #True

End