Announcement

Collapse
No announcement yet.

Window Colors Control

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Window Colors Control

    I'm thinking about an alternative solution to the question I posted about using Direct Show to modify/display frames from a video stream in real-time.

    Instead of trying to access the video stream, I wonder if I can put code in WM_Paint to draw on top of the video output?

    The code below tries to simply draw rectangles over a a dialog, where Direct Show is being used to display camera output. But in the code below, the video output draws over the GDI output. In this case, I want the GDI drawn on top of the video images.

    In the final solution, I want to copy the video frame that is shown on the window, modify the copy, and then place the modified copy on top of the video.


    Click image for larger version

Name:	pb_2136.jpg
Views:	106
Size:	18.7 KB
ID:	783875

    Code:
    'Compilable Example:
    #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, wRes, hRes  As Dword
    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
             pGraph      = NewCom ClsId $CLSID_FilterGraph                              'filter graph
             pBuild      = NewCom ClsId $CLSID_CaptureGraphBuilder2                     'capture graph builder
             pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum                         'enumeration object
             DisplayFirstCamera
    
           Case %WM_Command
              Select Case Cb.Ctl
              End Select
    
          Case %WM_Paint
             'draw on dialog
             hDC = BeginPaint(hDlg, PS)
             Rectangle hDC, 20,20,200,200
             Rectangle hDC, 60,60,100,100
             EndPaint hDlg, PS
    
          Case %WM_Destroy
             pGraph = Nothing
             pBuild = Nothing
             pSysDevEnum = Nothing
    
          Case %WM_Size
             Dialog Get Client hDlg To w,h
             pWindow.SetWindowPosition(150,0,w-150,h)
    
       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

  • #2
    If drawing directly on the dialog (where the video is being rendered) doesn't work out, I can create an overlay window of the same size/position as the video output, then draw the modified image on the floating window.

    But, I'd like to go with the first approach if possible.

    Working on it ...

    Comment


    • #3
      Here's a better example. Copy of dialog hDC bitblt'd to memory bitmap DC. Memory bitmap converted to a pair of colors. Memory bitmap DC bitblt'd back to hDC.

      Still doesn't work , but it is the concept I had in mind and is a good place to start testing...

      Code:
      'Compilable Example:
      #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

      Comment


      • #4
        Removed... Suggestions weren't good...

        Last edited by Pierre Bellisle; 13 Aug 2019, 10:18 PM.

        Comment


        • #5
          This works but puts the video in one dialog and the modified image in another ...

          Click image for larger version  Name:	pb_2137.jpg Views:	71 Size:	31.2 KB ID:	783893

          Code:
          'Compilable Example:
          #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                         '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
             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
          Last edited by Gary Beene; 15 Aug 2019, 07:11 AM.

          Comment


          • #6
            The intent is to put the modified image over the incoming video stream, showing only the modified image. But I was happy to demo getting binary color concept without having to use the DirectShow SampleGrabber approach (only because it seems awfully complicated for what I want to do).

            The conversion takes about 30ms on my PC, at 640x480. That's not bad but I'll need a much faster conversion function to support larger resolutions.

            There's also some "fuzz" in the image - I think from uneven lighting in the room. I'll have to think on how to lock out any jitter in the converted image.


            Comment


            • #7
              Gary,
              Does swapping the non wanted image out of dialog and the wanted one on dialog could be acceptable for you.

              Code:
                          CASE %IDCANCEL 'ESC
                            LOCAL  hStatic AS DWORD
                            LOCAL  hVideo  AS DWORD
                            STATIC Video   AS DWORD
                            hStatic = FindWindowEx(hDlg, %NULL ,"Static", "")
                            hVideo  = FindWindowEx(hDlg, %NULL ,"VideoRenderer", "ActiveMovie Window")
                            Video = Video XOR 1
                            IF Video THEN
                              SetWindowPos(hVideo, 0, 0, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                              SetWindowPos(hStatic, 0, -10000, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                            ELSE
                              SetWindowPos(hVideo, 0, -10000, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                              SetWindowPos(hStatic, 0, 0, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                            END IF

              Comment


              • #8
                Hi Pierre!

                Sorry for not answering earlier, but I was out of town today.

                I'm not quite sure what you mean. Can you say a bit more?

                Normally, I'd want only the modified image visible. During testing it would be nice to see both images.

                In my earlier tests, if I move pWindow to a non-visible position, the DC will not contain the unedited video. I relocate the video like this:

                Code:
                         pWindow.SetWindowPosition(10000,0,w2,h)
                In particular, GetDC(hDlg) does not seem to return a DC that contains the video window.

                Did you see different results?

                Comment


                • #9
                  Pierre, here's code that uses a single dialog - video adjacent to modified image.

                  In WM_Size, if I do this ...

                  Code:
                           pWindow.SetWindowPosition(-10000,0,w/2,h)
                  ... then no video is shown.


                  Code:
                  'Compilable Example:
                  #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, 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,1280,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
                           QueryPerformanceFrequency qFreq
                           bwTrigger   = 128
                           TextColor   = %Yellow
                           BGColor     = %Blue
                  
                           Control Add Graphic, hDlg, %IDC_Graphic, "", 0,0,640,480, %SS_Notify
                           Graphic Attach hDlg, %IDC_Graphic
                           Graphic Get DC To hDCB
                           SetTimer(hDlg, %ID_Timer, 50, ByVal(%Null))
                  
                           pGraph      = NewCom ClsId $CLSID_FilterGraph                              'filter graph
                           pBuild      = NewCom ClsId $CLSID_CaptureGraphBuilder2                     'capture graph builder
                           pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum                         'enumeration object
                           DisplayFirstCamera
                  
                        Case %WM_Command
                           Select Case Cb.Ctl
                              Case %IDC_Graphic : ChangeColor
                           End Select
                  
                        Case %WM_Size
                           Dialog Get Client hDlg To w,h
                           Control Set Loc hDlg, %IDC_Graphic, w/2,0
                           Control Set Size hDlg, %IDC_Graphic, w/2,h
                           pWindow.SetWindowPosition(0,0,w/2,h)
                           Graphic Set Size w, h                 'video and memory bitmap kept the same size
                  
                        Case %WM_Destroy
                           pGraph = Nothing
                           pBuild = Nothing
                           pSysDevEnum = Nothing
                  
                        Case %WM_Timer
                           QueryPerformanceCounter   qStart
                  
                           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_Beene                         'modify content of memory Bitmap
                           Graphic ReDraw
                  
                           QueryPerformanceCounter   qStop
                           Dialog Set Text hDlg, Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
                  
                  
                     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 = %White
                     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

                  Comment


                  • #10
                    Going through my snippets library, I found this function. It reduces the 640x480 image conversion time from 30ms to about 20ms. It looks like about 75% of the conversion time is in the function, not in the Graphic Get/Set bits operation

                    As compared to 640x480, a resolution of 1920x1080 has 7X more pixels, whereas a 2560x1440 resolution has 12X more pixels.

                    I'd like full screen conversion at real-time speeds, so I'm still needing a significant speed improvement - on the order of 10X - to handle higher resolutions.

                    I'm pretty sure there was a thread a few years ago that did a comparison of several gray-scale code solutions. I need to look that up and see if there were any better options, possible some that incorporate ASM.

                    Code:
                    Sub ConvertToBinaryColors_B  'uses BYTE pointer/CVL solution
                       Local w As Long, h As Long, bp As Byte Ptr, i As Long, p As Long Ptr
                       Local iColor As Long, R As Long, G As Long, B As Long, bmp$
                    
                       'get the string from ID_Graphic1
                       Graphic Get Bits To bmp$
                    
                       'get width/height of image
                       w = Cvl(bmp$,1)
                       h = Cvl(bmp$,5)
                       bp = StrPtr(bmp$)+8
                       p = bp
                    
                       'get string position of coordinates and modify the string at that position
                       For i = 1 To w*h
                          B = @bp                      'string BGR bytes positions are 0-R-G-B
                          Incr bp : G = @bp
                          Incr bp : R = @bp
                          Incr bp : Incr bp
                          iColor = 0.299*R + 0.587*G + 0.114*B  'create gray component
                          If iColor <= BWTrigger Then @p = Bgr(TextColor) Else @p = Bgr(BGColor)
                          Incr p
                       Next i
                    
                       'put the modified string into ID_Graphic2
                       Graphic Set Bits bmp$
                    End Sub

                    Comment


                    • #11
                      On the speed ... there's a great thread here on the topic. I'll come back to that after the display question is resolved.

                      Comment


                      • #12
                        Pierre,

                        In the 2-dialog version, I tried moving the main dialog off-screen and the video does not convert.

                        I tried hiding the main dialog and the video does not convert.

                        Anything that takes the main video display off-screen seems to prevent the DC in hDCA = GetDC(hDlg) from having full video content.

                        The only thing I'm seeing that works is to place the 2nd dialog directly on top of the main video dialog. In that case, the converted video is shown. There are lots of code complications with that, but it does seem to work.

                        I'll keep looking ...

                        Comment


                        • #13
                          Two dialogs. Converted image placed over main video with WS_Popup border. WM_Size keeps the two in size sync. WM_WindowPosChanged keeps the two co-located. Not as complicated as I worried but will take a little more effort when the incoming image does not fill the dialog. I thought resizing would be a problem but the resize cursors seem to work as desired. (added ... just remembered that WS_Popup doesn't resize - very convenient in this case).

                          Left click on converted image to have it change the binary colors.

                          I still think there out to be a way not to use 2 dialogs but haven't found it yet.

                          Here's the result ... the converted image is a dialog whose size/pos is forced to match the client area of the main dialog.


                          Click image for larger version  Name:	pb_2139.jpg Views:	2 Size:	20.5 KB ID:	783949

                          Code:
                          'Compilable Example:
                          #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, "Single Dialog Image Conversion",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                         '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",0,0,640,480, %WS_Popup Or %WS_ClipSiblings Or %WS_ClipChildren To hDlgB
                                   Dialog Show Modeless hDlgB Call DlgBProc
                          
                                Case %WM_WindowPosChanged
                                   Dialog Set Loc hDlgB, 0,0
                          
                                Case %WM_Size
                                   Dialog Get Client hDlg To w,h
                                   pWindow.SetWindowPosition(0,0,w,h)
                                   Dialog Set Size hDlgB, 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
                             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

                          Comment


                          • #14
                            Just tried it on a 1920x1080 and 2560x1440 dialogs. 0.09s and 1.5s respectively. It does work conversion frame rates are too slow. I'll go over to the thread I mentioned and try some of the faster code discussed there. I love it when something done years ago is just sitting there, waiting to be plucked for use today!

                            At those resolutions, when the main dialog is being resized there's a noticeable delay before the converted image dialog resizes. Not surprising I guess, but will want to work on that.

                            And I still don't like the 2-dialog approach.

                            Lots of playing yet to be done ...

                            Comment


                            • #15
                              Hey Gary,

                              Here is uncleaned and buggy code of what I was thinking...
                              It shows the idea but works very badly, disastrous flickers and loosing keyboard after first left click on high contrast image.
                              Need a lot of work, probably too much...

                              Code:
                              #Compile Exe 'PBWIN10 & JR includes
                              #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, 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
                                 MSGBOX "Type ENTER to swap...", , "Move control"
                                 Dialog Default Font "Tahoma", 12, 1
                                 Dialog New Pixels, 0, "DirectShow SampleGrabber Test",300,300,1280,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
                                       QueryPerformanceFrequency qFreq
                                       bwTrigger   = 128
                                       TextColor   = %Yellow
                                       BGColor     = %Blue
                              
                                       Control Add Graphic, hDlg, %IDC_Graphic, "", 0,0,640,480, %SS_Notify
                                       Graphic Attach hDlg, %IDC_Graphic
                                       Graphic Get DC To hDCB
                                       SetTimer(hDlg, %ID_Timer, 50, ByVal(%Null))
                              
                                       pGraph      = NewCom ClsId $CLSID_FilterGraph                              'filter graph
                                       pBuild      = NewCom ClsId $CLSID_CaptureGraphBuilder2                     'capture graph builder
                                       pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum                         'enumeration object
                                       DisplayFirstCamera
                              
                                       PostMessage(hDlg, %WM_COMMAND, MAK(DWORD, %IDOK, %BN_CLICKED), 0)
                              
                                    Case %WM_Command
                                       Select Case Cb.Ctl
                                          Case %IDC_Graphic : ChangeColor
                              
                                          CASE %IDOK 'ENTER
                                            LOCAL  hStatic AS DWORD
                                            LOCAL  hVideo  AS DWORD
                                            STATIC Video   AS DWORD
                                            hStatic = FindWindowEx(hDlg, %NULL ,"Static", "")
                                            hVideo  = FindWindowEx(hDlg, %NULL ,"VideoRenderer", "ActiveMovie Window")
                                            Video = Video XOR 1
                                            Dialog Get Client hDlg To w,h
                                            IF Video THEN
                                              pWindow.SetWindowPosition(0000,0,w/2,h)
                                              'SetWindowPos(hVideo, 0, 0, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                                              SetWindowPos(hStatic, 0, -10000, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                                              WinBeep(4500, 60)
                                            ELSE
                                              pWindow.SetWindowPosition(-10000,0,w/2,h)
                                              'SetWindowPos(hVideo, 0, -10000, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                                              SetWindowPos(hStatic, 0, 0, 0, 0, 0, %SWP_NOZORDER OR %SWP_NOSIZE)
                                            END IF
                              
                                       End Select
                              
                                    Case %WM_Size
                                       Dialog Get Client hDlg To w,h
                                       'Control Set Loc hDlg, %IDC_Graphic, w/2,0
                                       Control Set Size hDlg, %IDC_Graphic, w/2,h
                                       IF Video THEN
                                         pWindow.SetWindowPosition(0000,0,w/2,h)
                                       ELSE
                                         pWindow.SetWindowPosition(-10000,0,w/2,h)
                                       END IF
                                       Graphic Set Size w/2, h                 'video and memory bitmap kept the same size
                              
                                    Case %WM_Destroy
                                       pGraph = Nothing
                                       pBuild = Nothing
                                       pSysDevEnum = Nothing
                              
                                    Case %WM_Timer
                                       QueryPerformanceCounter   qStart
                              
                                       Dialog Get Client hDlg To w,h
                                       hDCA = GetDC(hDlg)
                                       'hDCA = GetDC(FindWindowEx(hDlg, %NULL ,"VideoRenderer", "ActiveMovie Window"))
                                       BitBlt hDCB, 0,0,w,h, hDCA,0,0,%SrcCopy 'copy using bitblt dialog hDC to memory Bitmap DC
                                       ConvertToBinaryColors_Beene             'modify content of memory Bitmap
                                       Graphic ReDraw
                              
                                       QueryPerformanceCounter   qStop
                                       Dialog Set Text hDlg, Format$((qStop-qStart)/qFreq,"###.000") & " seconds"
                              
                                 End Select
                              End Function
                              
                              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
                                    IF 0 THEN
                                      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:
                                    ELSE
                                      B = iColor = iColor AND &HFF&
                                      G = (iColor AND &HFF00&) \ &H100
                                      R = (iColor AND &HFF0000&) \ &H10000&
                                      iColor = (R+G+B)/3
                                    END IF
                                    If iColor <= BWTrigger Then @p = Bgr(TextColor) Else @p = Bgr(BGColor)
                                    Incr p
                                 Next
                                 Graphic Set Bits bmp$
                                 Graphic ReDraw
                              End Sub
                              
                              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 = %White
                                 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

                              Comment


                              • #16
                                Howdy, Pierre!

                                Yes, that flash is what I observed as well and other than the 2 dialog approach I gave in post #13, I've not found a way to remove the flash/keep modified images streaming.

                                The good news is that at least I have one approach that works. I've give it some focus - speed especially and then try to branch out into single dialog solutions and addressing some of the other issues that I see.

                                Comment

                                Working...
                                X