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"
%ID_Timer = 500
%IDC_Graphic = 501
Global hDlg, hDlgB, hDCA, hDCB As Dword
Global wRes, hRes, bwTrigger, TextColor, BGColor As Long
Global pBuffer As String Ptr, pBufferSize As Long
Global r(), g(), b() As Long
Global qFreq, qStart, qStop As Quad
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,480, %WS_OverlappedWindow Or %WS_ClipSiblings Or %WS_ClipChildren To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgBProc() As Long
Local w,h As Long
Select Case Cb.Msg
Case %WM_InitDialog
QueryPerformanceFrequency qFreq
Control Add Graphic, hDlgB, %IDC_Graphic, "", 0,0,10,10, %SS_Notify
Graphic Attach hDlgB, %IDC_Graphic
Graphic Get DC To hDCB
SetTimer(hDlgB, %ID_Timer, 50, ByVal(%Null))
Case %WM_Size
Dialog Get Size hDlgB To w,h
Control Set Size hDlg, %IDC_Graphic, w,h
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Graphic : ChangeColor
End Select
Case %WM_Timer
QueryPerformanceCounter qStart
Dialog Set Text hDlgB, Time$
Dialog Get Client hDlg To w,h
hDCA = GetDC(hDlg)
BitBlt hDCB, 0,0,w,h, hDCA, 0,0, %SrcCopy 'copy using bitblt dialog hDC to memory Bitmap DC
ConvertToBinaryColors_Russ 'modify content of memory Bitmap
Graphic ReDraw
QueryPerformanceCounter qStop
Dialog Set Text hDlg, Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
End Select
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
Dialog New Pixels, hDlg, "DirectShow SampleGrabber Test",800,300,640,480, %WS_OverlappedWindow Or %WS_ClipSiblings Or %WS_ClipChildren To hDlgB
Dialog Show Modeless hDlgB Call DlgBProc
Case %WM_Size
Dialog Get Client hDlg To w,h
pWindow.SetWindowPosition(0,0,w,h)
Graphic Set Size w, h 'video and memory bitmap kept the same size
Case %WM_Destroy
pGraph = Nothing
pBuild = Nothing
pSysDevEnum = Nothing
End Select
End Function
Sub ChangeColor
If TextColor = %Yellow And BGColor = %Blue Then
TextColor = %White : BGColor = %Blue
ElseIf TextColor = %White And BGColor = %Blue Then
TextColor = %White : BGColor = %Black
ElseIf TextColor = %White And BGColor = %Black Then
TextColor = %Black : BGColor = %White
ElseIf TextColor = %Black And BGColor = %White Then
TextColor = RGB(150,150,150) : BGColor = RGB(150,150,150)
Else
TextColor = %Yellow : BGColor = %Blue
End If
End Sub
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_Beene
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
Sub ConvertToBinaryColors_Russ
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
Make2Color p, w*h, 4, TextColor, BGColor, bwTrigger 'DLL function
Graphic Set Bits bmp$
Graphic ReDraw
End Sub
Sub Make2Color(ByVal vptr As Byte Ptr,ByVal Count As Long,ByVal bytesPerPix As Long,ByVal clr1 As Dword,ByVal clr2 As Dword, ByVal trigger As Long)
clr1 = Bgr(clr1) : clr2 = Bgr(clr2)
Local i&
Local r1&,g1&,b1&
Local r2&,g2&,b2&
r1& = clr1 And &hff0000
g1& = clr1 And &hff00
b1& = clr1 And &hff
Shift Right r1,16
Shift Right g1,8
r2& = clr2 And &hff0000
g2& = clr2 And &hff00
b2& = clr2 And &hff
Shift Right r2,16
Shift Right g2,8
!pusha
!mov esi,vptr ' get the pointer to the first pixel
For i& = 1 To Count Step bytesPerPix
!xor eax,eax
!mov al,[esi+1]
!cmp eax,trigger
!jg Greater
!Xor eax,eax
!mov eax,r1
!mov [esi],al
!mov eax,g1
!mov [esi+1],al
!mov eax,b1
!mov [esi+2],al
!jmp doNext
Greater:
!Xor eax,eax
!mov eax,r2
!mov [esi],al
!mov eax,g2
!mov [esi+1],al
!mov eax,b2
!mov [esi+2],al
DoNext:
!Add esi,bytesPerPix
Next
!popa
' For i& = 0 To Count Step bytesPerPix
' If @vptr[i] < trigger Then
' @vptr[i] = r1
' @vptr[i+1] = g1
' @vptr[i+2] = b1
' Else
' @vptr[i] = r2
' @vptr[i+1] = g2
' @vptr[i+2] = b2
' End If
' i = i + bytesPerPix
' Next
End Sub
http://www.garybeene.com/sw/gbsnippets.htm