Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
#Include "qedit.inc"
Global hDlg, hDC As Dword
Global gBMP, gDC As Dword
Global wRes, hRes, bwTrigger, TextColor, BGColor As Long
Global pBuffer As String Ptr, pBufferSize As Long
Global pGraph As IGraphBuilder 'Filter Graph Manager
Global pBuild As ICaptureGraphBuilder2 'Capture Graph Builder
Global pSysDevEnum As ICreateDevEnum 'enumeration object
Global pEnumCat As IEnumMoniker
Global pMoniker As IMoniker 'contains information about other objects
Global pceltFetched As Dword
Global pCap As IBaseFilter 'Video capture filter
Global pControl As IMediaControl
Global pWindow As IVideoWindow 'Display Window
Function PBMain() As Long
Dialog Default Font "Tahoma", 12, 1
Dialog New Pixels, 0, "DirectShow SampleGrabber Test",300,300,640+150,480, %WS_OverlappedWindow Or %WS_ClipSiblings Or %WS_ClipChildren To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long, PS As PaintStruct
Select Case Cb.Msg
Case %WM_InitDialog
bwTrigger = 128
TextColor = %Yellow
BGColor = %Blue
pGraph = NewCom ClsId $CLSID_FilterGraph 'filter graph
pBuild = NewCom ClsId $CLSID_CaptureGraphBuilder2 'capture graph builder
pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum 'enumeration object
DisplayFirstCamera
Graphic Bitmap New 10,10 To gBMP 'correct size will be made in WM_Size
Graphic Attach gBMP, 0 'bitmap handle
Graphic Get DC To gDC 'bitmap DC
Case %WM_Size
Dialog Get Client hDlg To w,h
pWindow.SetWindowPosition(150,0,w-150,h)
Graphic Set Size w-150, h 'video and memory bitmap kept the same size
Case %WM_Paint
'draw on dialog
hDC = BeginPaint(hDlg, PS) 'hDC of the dialog
Dialog Get Client hDlg To w,h
BitBlt gDC, 0,0,w-150,h, hDC, 150,0, %SrcCopy 'copy using bitblt dialog hDC to memory Bitmap DC
ConvertToBinaryColors 'modify content of memory Bitmap
BitBlt hDC,150,0,w-150,h,gDC,0,0, %SrcCopy 'copy Graphic Bitmap back to dialog hDC
Rectangle hDC, 20,20,400,400 'just something extra for test purposes
Rectangle hDC, 60,60,300,300 'just something extra for test purposes
EndPaint hDlg, PS
Case %WM_Destroy
pGraph = Nothing
pBuild = Nothing
pSysDevEnum = Nothing
End Select
End Function
Sub DisplayFirstCamera
If pSysDevEnum.CreateClassEnumerator($CLSID_VideoInputDeviceCategory, pEnumCat, 0) <> %S_Ok Then Exit Sub
pEnumCat.next(1, pMoniker, pceltFetched) 'cycle through monikders
pMoniker.BindToObject(Nothing, Nothing, $IID_IBaseFilter, pCap) 'create device filter for the chosen device
pGraph.AddFilter(pCap,"First Camera") 'add chosen device filter to the filter graph
pBuild.SetFilterGraph(pGraph) 'initialize pBuild
pBuild.RenderStream $Pin_Category_Preview, $MediaType_Video, pCap, Nothing, Nothing 'render the live source
pWindow = pGraph
pWindow.Owner = hDlg
pWindow.WindowStyle = %WS_Child Or %WS_ClipChildren Or %WS_ClipSiblings 'video window settings
pControl = pGraph
pControl.Run
End Sub
Sub ConvertToBinaryColors
Local w,h,i,iColor,R,G,B As Long, p As Long Ptr, bmp$
Graphic Get Bits To bmp$
'get width/height of image
w = Cvl(bmp$,1)
h = Cvl(bmp$,5)
p = StrPtr(bmp$)+8 'position of starting position for bits in string
'get string position of coordinates and modify the string at that position
For i = 1 To w*h
iColor = @p 'result is a BGR color value 0-R-G-B
B = iColor Mod 256 'or this: iColor AND &HFF&
G = (iColor\256) Mod 256 'or this: (iColor AND &HFF00&) \ &H100
R = (iColor\256\256) Mod 256 'or this: (iColor AND &HFF0000&) \ &H10000&
iColor = 0.299*R + 0.587*G + 0.114*B 'or this: iColor = (R+G+B)/3
If iColor <= BWTrigger Then @p = Bgr(TextColor) Else @p = Bgr(BGColor)
Incr p
Next i
Graphic Set Bits bmp$
Graphic ReDraw
End Sub
http://www.garybeene.com/sw/gbsnippets.htm