PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

[MODULE] Desktop/Window Capture

https://www.purebasic.fr/english/viewtopic.php?t=69266

Page 1 of 2

[MODULE] Desktop/Window Capture

Posted: Tue Sep 26, 2017 7:27 pm
by Mijikai
Have fun :)

Code:

Code: Select all


;CAPTURE MODULE
;------------------
;by Mijikai
;Windows only!
;------------------

DeclareModule CAPTURE
  Declare.i Target(Handle.i,*Area.RECT)
  Declare.i Frame(*Capture)
  Declare.l Pixel(*Capture,X.i,Y.i)
  Declare.i Height(*Capture)
  Declare.i Width(*Capture)
  Declare.i Free(*Capture)
EndDeclareModule

Module CAPTURE
  
  Structure CAPTURE_STRUCT
    Handle.i
    SDC.i
    TDC.i
    DIB.i
    Bits.i
    BMI.BITMAPINFO
    Area.RECT
  EndStructure
  
  #CAPTUREBLT = $40000000
  
  Procedure.i Target(Handle.i,*Area.RECT)
    Protected *Capture.CAPTURE_STRUCT
    If *Area 
      *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
      If *Capture
        With *Capture
          \Handle = Handle
          \SDC = GetDC_(\Handle)
          If \SDC
            \TDC = CreateCompatibleDC_(\SDC)
            If \TDC
              CopyMemory(*Area,@\Area,SizeOf(RECT))
              \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
              \BMI\bmiHeader\biWidth = \Area\right
              \BMI\bmiHeader\biHeight = - \Area\bottom
              \BMI\bmiHeader\biPlanes = 1
              \BMI\bmiHeader\biBitCount = 32
              \BMI\bmiHeader\biCompression  = #BI_RGB
              \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
              If \DIB
                If SelectObject_(\TDC,\DIB)
                  ProcedureReturn *Capture
                EndIf
                DeleteObject_(\DIB)
              EndIf
              DeleteDC_(\TDC)
            EndIf
            ReleaseDC_(\Handle,\SDC)
          EndIf
        EndWith
        FreeMemory(*Capture)
      EndIf
    EndIf
  EndProcedure
  
  Procedure.i Frame(*Capture.CAPTURE_STRUCT)
    With *Capture
      ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT)  
    EndWith    
  EndProcedure
  
  Procedure.i Width(*Capture.CAPTURE_STRUCT)
    ProcedureReturn *Capture\Area\right - 1
  EndProcedure
  
  Procedure.i Height(*Capture.CAPTURE_STRUCT)
    ProcedureReturn *Capture\Area\bottom - 1
  EndProcedure
  
  Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
    Protected *Pixel.Long
    *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
    ProcedureReturn *Pixel\l
  EndProcedure
  
  Procedure.i Free(*Capture.CAPTURE_STRUCT)
    DeleteObject_(*Capture\DIB)
    DeleteDC_(*Capture\TDC)
    ReleaseDC_(*Capture\Handle,*Capture\SDC)
    FreeMemory(*Capture)
  EndProcedure
  
EndModule
Example:

Code: Select all

TestRect.RECT

TestRect\left = 400
TestRect\right = 400
TestRect\top = 400
TestRect\bottom = 400

Task = CAPTURE::Target(#Null,@TestRect)
If Task
  If CAPTURE::Frame(Task)
    If CreateImage(0,CAPTURE::Width(Task)+1,CAPTURE::Height(Task)+1)
      If StartDrawing(ImageOutput(0))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
          Next
        Next 
        StopDrawing()
        Debug SaveImage(0,"testimg.bmp")
      EndIf
    EndIf
  EndIf 
  CAPTURE::Free(Task)
EndIf

Re: [MODULE] Desktop/Window Capture

Posted: Wed Sep 27, 2017 2:33 pm
by walbus
I think, better for this little module,
hang on the module a complete working demo part

So the user can start the code and see directly a result
As sample a shrinked desktop shot on a little window

So the user can save the complete code and use directly as pbi

CompilerIf #PB_Compiler_IsMainFile ; Demo part
; Demo Code
compilerendif

Re: [MODULE] Desktop/Window Capture

Posted: Wed Sep 27, 2017 3:05 pm
by Mijikai
walbus wrote:I think, better for this little module,
hang on the module a complete working demo part
...
Thanks for the suggestion but it will stay as it is.
However i changed the example code from pseudo to working.

Re: [MODULE] Desktop/Window Capture

Posted: Wed Sep 27, 2017 5:53 pm
by Kwai chang caine
Works well but i have not the same color than my screen...perhaps it's the normal behavior :wink:
Thanks for sharing 8)

Re: [MODULE] Desktop/Window Capture

Posted: Wed Sep 27, 2017 7:07 pm
by Mijikai
Kwai chang caine wrote:Works well but i have not the same color...
Thanks :)
The color is stored as BGR by Windows.

Re: [MODULE] Desktop/Window Capture

Posted: Thu Sep 28, 2017 5:42 pm
by chris319
Sorry, but this does not work with a movie.

Code: Select all

    ;CAPTURE MODULE
    ;------------------
    ;by Mijikai
    ;Windows only!
    ;------------------

    DeclareModule CAPTURE
      Declare.i Target(Handle.i,*Area.RECT)
      Declare.i Frame(*Capture)
      Declare.l Pixel(*Capture,X.i,Y.i)
      Declare.i Height(*Capture)
      Declare.i Width(*Capture)
      Declare.i Free(*Capture)
    EndDeclareModule

    Module CAPTURE
     
      Structure CAPTURE_STRUCT
        Handle.i
        SDC.i
        TDC.i
        DIB.i
        Bits.i
        BMI.BITMAPINFO
        Area.RECT
      EndStructure
     
      #CAPTUREBLT = $40000000
     
      Procedure.i Target(Handle.i,*Area.RECT)
        Protected *Capture.CAPTURE_STRUCT
        If *Area
          *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
          If *Capture
            With *Capture
              \Handle = Handle
              \SDC = GetDC_(\Handle)
              If \SDC
                \TDC = CreateCompatibleDC_(\SDC)
                If \TDC
                  CopyMemory(*Area,@\Area,SizeOf(RECT))
                  \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
                  \BMI\bmiHeader\biWidth = \Area\right
                  \BMI\bmiHeader\biHeight = - \Area\bottom
                  \BMI\bmiHeader\biPlanes = 1
                  \BMI\bmiHeader\biBitCount = 32
                  \BMI\bmiHeader\biCompression  = #BI_RGB
                  \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
                  If \DIB
                    If SelectObject_(\TDC,\DIB)
                      ProcedureReturn *Capture
                    EndIf
                    DeleteObject_(\DIB)
                  EndIf
                  DeleteDC_(\TDC)
                EndIf
                ReleaseDC_(\Handle,\SDC)
              EndIf
            EndWith
            FreeMemory(*Capture)
          EndIf
        EndIf
      EndProcedure
     
      Procedure.i Frame(*Capture.CAPTURE_STRUCT)
        With *Capture
          ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT) 
        EndWith   
      EndProcedure
     
      Procedure.i Width(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\right - 1
      EndProcedure
     
      Procedure.i Height(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\bottom - 1
      EndProcedure
     
      Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
        Protected *Pixel.Long
        *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
        ProcedureReturn *Pixel\l
      EndProcedure
     
      Procedure.i Free(*Capture.CAPTURE_STRUCT)
        DeleteObject_(*Capture\DIB)
        DeleteDC_(*Capture\TDC)
        ReleaseDC_(*Capture\Handle,*Capture\SDC)
        FreeMemory(*Capture)
      EndProcedure
     
    EndModule

;START OF DEMO

InitMovie()

LoadMovie(1,"handsfree big load.mp4")
MovieAudio(1,0,0)
ResizeMovie(1,0,0,640,360)

OpenWindow(1,0,0,640,400,"");LEFT
OpenWindow(2,640,0,640,400,"");RIGHT

PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)
Delay(500):StopMovie(1)


TestRect.RECT

;TestRect\left = 400
;TestRect\right = 400
;TestRect\top = 400
;TestRect\bottom = 400

TestRect\left = 0
TestRect\right = 400
TestRect\top = 0
TestRect\bottom = 400

Task = CAPTURE::Target(#Null,@TestRect)
If Task
  If CAPTURE::Frame(Task)
    If CreateImage(0,CAPTURE::Width(Task)+1,CAPTURE::Height(Task)+1)
      If StartDrawing(ImageOutput(0))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
          Next
        Next
        StopDrawing()

StartDrawing(WindowOutput(2))
DrawImage(ImageID(0),0,0)

;        Debug SaveImage(0,"testimg.bmp")
      EndIf
    EndIf
  EndIf
  CAPTURE::Free(Task)
EndIf

Repeat:Until WaitWindowEvent() = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End

Re: [MODULE] Desktop/Window Capture

Posted: Thu Sep 28, 2017 9:02 pm
by Mijikai
chris319 wrote:Sorry, but this does not work with a movie.

...
:?:
It does work...
Image


Try this quick edit of your code (let the video play and watch!):

Code: Select all

InitMovie()

LoadMovie(1,"YOUR MOVIE!")
MovieAudio(1,0,0)
ResizeMovie(1,0,0,640,360)

OpenWindow(1,0,0,640,400,"");LEFT
OpenWindow(2,640,0,640,400,"");RIGHT

PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)


TestRect.RECT

TestRect\left = 0
TestRect\right = 400
TestRect\top = 0
TestRect\bottom = 400
Task = CAPTURE::Target(WindowID(1),@TestRect)
Repeat
If Task
  If CAPTURE::Frame(Task)
    StartDrawing(WindowOutput(2))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
          Next
        Next
    StopDrawing()
      EndIf
EndIf
Until WaitWindowEvent(50) = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End
For true live capture a fast render function is needed (hint: Screen())!

Re: [MODULE] Desktop/Window Capture

Posted: Thu Sep 28, 2017 9:11 pm
by Kwai chang caine
The color is stored as BGR by Windows.
Thanks for your answer 8)

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 10:51 am
by chris319
Sorry, Mijikai, it's still drawing black rectangles, even with your quick fix.

Do I need to use a particular graphics library? Odd that it would work for you but not for me.

Code: Select all

InitSprite()
    ;CAPTURE MODULE
    ;------------------
    ;by Mijikai
    ;Windows only!
    ;------------------

    DeclareModule CAPTURE
      Declare.i Target(Handle.i,*Area.RECT)
      Declare.i Frame(*Capture)
      Declare.l Pixel(*Capture,X.i,Y.i)
      Declare.i Height(*Capture)
      Declare.i Width(*Capture)
      Declare.i Free(*Capture)
    EndDeclareModule

    Module CAPTURE
     
      Structure CAPTURE_STRUCT
        Handle.i
        SDC.i
        TDC.i
        DIB.i
        Bits.i
        BMI.BITMAPINFO
        Area.RECT
      EndStructure
     
      #CAPTUREBLT = $40000000
     
      Procedure.i Target(Handle.i,*Area.RECT)
        Protected *Capture.CAPTURE_STRUCT
        If *Area
          *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
          If *Capture
            With *Capture
              \Handle = Handle
              \SDC = GetDC_(\Handle)
              If \SDC
                \TDC = CreateCompatibleDC_(\SDC)
                If \TDC
                  CopyMemory(*Area,@\Area,SizeOf(RECT))
                  \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
                  \BMI\bmiHeader\biWidth = \Area\right
                  \BMI\bmiHeader\biHeight = - \Area\bottom
                  \BMI\bmiHeader\biPlanes = 1
                  \BMI\bmiHeader\biBitCount = 32
                  \BMI\bmiHeader\biCompression  = #BI_RGB
                  \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
                  If \DIB
                    If SelectObject_(\TDC,\DIB)
                      ProcedureReturn *Capture
                    EndIf
                    DeleteObject_(\DIB)
                  EndIf
                  DeleteDC_(\TDC)
                EndIf
                ReleaseDC_(\Handle,\SDC)
              EndIf
            EndWith
            FreeMemory(*Capture)
          EndIf
        EndIf
      EndProcedure
     
      Procedure.i Frame(*Capture.CAPTURE_STRUCT)
        With *Capture
          ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT)
        EndWith   
      EndProcedure
     
      Procedure.i Width(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\right - 1
      EndProcedure
     
      Procedure.i Height(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\bottom - 1
      EndProcedure
     
      Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
        Protected *Pixel.Long
        *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
        ProcedureReturn *Pixel\l
      EndProcedure
     
      Procedure.i Free(*Capture.CAPTURE_STRUCT)
        DeleteObject_(*Capture\DIB)
        DeleteDC_(*Capture\TDC)
        ReleaseDC_(*Capture\Handle,*Capture\SDC)
        FreeMemory(*Capture)
      EndProcedure
     
    EndModule

;START OF DEMO

InitMovie()

LoadMovie(1,"handsfree big load.mp4")
MovieAudio(1,0,0)
ResizeMovie(1,0,0,640,360)

OpenWindow(1,0,0,640,400,"");LEFT
OpenWindowedScreen(WindowID(1),0,0,640,400);LEFT

OpenWindow(2,640,0,640,400,"");RIGHT
OpenWindowedScreen(WindowID(2),0,0,640,400);RIGHT

PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)

;Delay(1000)
;StopMovie(1)

TestRect.RECT

TestRect\left = 0
TestRect\right = 400
TestRect\top = 0
TestRect\bottom = 400
Task = CAPTURE::Target(WindowID(1),@TestRect)

Repeat
If Task
  If CAPTURE::Frame(Task)
    StartDrawing(WindowOutput(2))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
          Next
        Next
    StopDrawing()
      EndIf
EndIf

Until WaitWindowEvent(50) = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 12:07 pm
by Mijikai
chris319 wrote:Sorry, Mijikai, it's still drawing black rectangles, even with your quick fix.

Do I need to use a particular graphics library? Odd that it would work for you but not for me.

...
The code you posted works for me - but it is slow - u need to wait several seconds until anything will happen.
This can be easily fixed with fast rendering on your side as mentioned before.
Please try the code again (preferably with PB 5.61 - just to be sure...) and let me know about the results.

There might be an issue depending on how PB displays (renders) the video - so far i never encountered one.
(Besides capturing the screen u could also try to hook into PB rendering function.)

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 5:06 pm
by chris319
I switched from PB 5.45 LTS to PB 5.61 and am still getting the same result -- a black rectangle. I can get it to draw a green rectangle as you can see on line 129 of the code I have posted.

I am able to read the screen pixels if the movie is played back using VLC, suggesting a PB issue.

This code isn't working:

Code: Select all

CAPTURE::Pixel(Task,x,y)

Code: Select all

InitSprite()
    ;CAPTURE MODULE
    ;------------------
    ;by Mijikai
    ;Windows only!
    ;------------------

    DeclareModule CAPTURE
      Declare.i Target(Handle.i,*Area.RECT)
      Declare.i Frame(*Capture)
      Declare.l Pixel(*Capture,X.i,Y.i)
      Declare.i Height(*Capture)
      Declare.i Width(*Capture)
      Declare.i Free(*Capture)
    EndDeclareModule

    Module CAPTURE
     
      Structure CAPTURE_STRUCT
        Handle.i
        SDC.i
        TDC.i
        DIB.i
        Bits.i
        BMI.BITMAPINFO
        Area.RECT
      EndStructure
     
      #CAPTUREBLT = $40000000
     
      Procedure.i Target(Handle.i,*Area.RECT)
        Protected *Capture.CAPTURE_STRUCT
        If *Area
          *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
          If *Capture
            With *Capture
              \Handle = Handle
              \SDC = GetDC_(\Handle)
              If \SDC
                \TDC = CreateCompatibleDC_(\SDC)
                If \TDC
                  CopyMemory(*Area,@\Area,SizeOf(RECT))
                  \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
                  \BMI\bmiHeader\biWidth = \Area\right
                  \BMI\bmiHeader\biHeight = - \Area\bottom
                  \BMI\bmiHeader\biPlanes = 1
                  \BMI\bmiHeader\biBitCount = 32
                  \BMI\bmiHeader\biCompression  = #BI_RGB
                  \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
                  If \DIB
                    If SelectObject_(\TDC,\DIB)
                      ProcedureReturn *Capture
                    EndIf
                    DeleteObject_(\DIB)
                  EndIf
                  DeleteDC_(\TDC)
                EndIf
                ReleaseDC_(\Handle,\SDC)
              EndIf
            EndWith
            FreeMemory(*Capture)
          EndIf
        EndIf
      EndProcedure
     
      Procedure.i Frame(*Capture.CAPTURE_STRUCT)
        With *Capture
          ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT)
        EndWith   
      EndProcedure
     
      Procedure.i Width(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\right - 1
      EndProcedure
     
      Procedure.i Height(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\bottom - 1
      EndProcedure
     
      Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
        Protected *Pixel.Long
        *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
        ProcedureReturn *Pixel\l
      EndProcedure
     
      Procedure.i Free(*Capture.CAPTURE_STRUCT)
        DeleteObject_(*Capture\DIB)
        DeleteDC_(*Capture\TDC)
        ReleaseDC_(*Capture\Handle,*Capture\SDC)
        FreeMemory(*Capture)
      EndProcedure
     
    EndModule

;START OF DEMO

InitMovie()

LoadMovie(1,"handsfree big load.mp4")
MovieAudio(1,0,0)
ResizeMovie(1,0,0,640,360)

OpenWindow(1,0,0,640,400,"");LEFT
OpenWindowedScreen(WindowID(1),0,0,640,400);LEFT

OpenWindow(2,640,0,640,400,"");RIGHT
OpenWindowedScreen(WindowID(2),0,0,640,400);RIGHT

PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)

Delay(500)
PauseMovie(1)

TestRect.RECT

TestRect\left = 0
TestRect\right = 400
TestRect\top = 0
TestRect\bottom = 400
Task = CAPTURE::Target(WindowID(1),@TestRect)

Repeat
If Task
  If CAPTURE::Frame(Task)
    StartDrawing(WindowOutput(2))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
;            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
            Plot(x,y,$00ff00);Swap Red & Blue for RGB if needed!
          Next
        Next
    StopDrawing()
      EndIf
EndIf

Until WaitWindowEvent(50) = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 6:00 pm
by chris319
The program sort-of works if I omit ResizeMovie(). The image is offset horizontally but at least it's an image, not black pixels.

So ResizeMovie() is suspect.

Code: Select all

InitSprite()
    ;CAPTURE MODULE
    ;------------------
    ;by Mijikai
    ;Windows only!
    ;------------------

    DeclareModule CAPTURE
      Declare.i Target(Handle.i,*Area.RECT)
      Declare.i Frame(*Capture)
      Declare.l Pixel(*Capture,X.i,Y.i)
      Declare.i Height(*Capture)
      Declare.i Width(*Capture)
      Declare.i Free(*Capture)
    EndDeclareModule

    Module CAPTURE
     
      Structure CAPTURE_STRUCT
        Handle.i
        SDC.i
        TDC.i
        DIB.i
        Bits.i
        BMI.BITMAPINFO
        Area.RECT
      EndStructure
     
      #CAPTUREBLT = $40000000
     
      Procedure.i Target(Handle.i,*Area.RECT)
        Protected *Capture.CAPTURE_STRUCT
        If *Area
          *Capture = AllocateMemory(SizeOf(CAPTURE_STRUCT))
          If *Capture
            With *Capture
              \Handle = Handle
              \SDC = GetDC_(\Handle)
              If \SDC
                \TDC = CreateCompatibleDC_(\SDC)
                If \TDC
                  CopyMemory(*Area,@\Area,SizeOf(RECT))
                  \BMI\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
                  \BMI\bmiHeader\biWidth = \Area\right
                  \BMI\bmiHeader\biHeight = - \Area\bottom
                  \BMI\bmiHeader\biPlanes = 1
                  \BMI\bmiHeader\biBitCount = 32
                  \BMI\bmiHeader\biCompression  = #BI_RGB
                  \DIB = CreateDIBSection_(\TDC,@\BMI,#DIB_RGB_COLORS,@\Bits,#Null,#Null)
                  If \DIB
                    If SelectObject_(\TDC,\DIB)
                      ProcedureReturn *Capture
                    EndIf
                    DeleteObject_(\DIB)
                  EndIf
                  DeleteDC_(\TDC)
                EndIf
                ReleaseDC_(\Handle,\SDC)
              EndIf
            EndWith
            FreeMemory(*Capture)
          EndIf
        EndIf
      EndProcedure
     
      Procedure.i Frame(*Capture.CAPTURE_STRUCT)
        With *Capture
          ProcedureReturn BitBlt_(\TDC,#Null,#Null,\Area\right,\Area\bottom,\SDC,\Area\left,\Area\top,#SRCCOPY|#CAPTUREBLT)
        EndWith   
      EndProcedure
     
      Procedure.i Width(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\right - 1
      EndProcedure
     
      Procedure.i Height(*Capture.CAPTURE_STRUCT)
        ProcedureReturn *Capture\Area\bottom - 1
      EndProcedure
     
      Procedure.l Pixel(*Capture.CAPTURE_STRUCT,X.i,Y.i)
        Protected *Pixel.Long
        *Pixel = *Capture\Bits + ((Y * *Capture\Area\right + X) << 2)
        ProcedureReturn *Pixel\l
      EndProcedure
     
      Procedure.i Free(*Capture.CAPTURE_STRUCT)
        DeleteObject_(*Capture\DIB)
        DeleteDC_(*Capture\TDC)
        ReleaseDC_(*Capture\Handle,*Capture\SDC)
        FreeMemory(*Capture)
      EndProcedure
     
    EndModule

;START OF DEMO

InitMovie()

LoadMovie(1,"handsfree big load.mp4")
MovieAudio(1,0,0)

OpenWindow(1,0,0,640,400,"");LEFT
OpenWindowedScreen(WindowID(1),0,0,640,400);LEFT
;ResizeMovie(1,0,0,640,360)

OpenWindow(2,640,0,640,400,"");RIGHT
OpenWindowedScreen(WindowID(2),0,0,640,400);RIGHT

PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)

Delay(500)
PauseMovie(1)

TestRect.RECT

TestRect\left = 0
TestRect\right = 640
TestRect\top = 0
TestRect\bottom = 400
Task = CAPTURE::Target(WindowID(1),@TestRect)

Repeat
If Task
  If CAPTURE::Frame(Task)
    StartDrawing(WindowOutput(2))
        For x = 0 To CAPTURE::Width(Task)
          For y = 0 To CAPTURE::Height(Task)
            Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
;            Plot(x,y,$00ff00);Swap Red & Blue for RGB if needed!
          Next
        Next
    StopDrawing()
      EndIf
EndIf

Until WaitWindowEvent(50) = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 6:17 pm
by Mijikai
It works for me - even when i resize every cycle.

Code: Select all

InitMovie()
    
    LoadMovie(1,"SOME MOVIE")
    MovieAudio(1,0,0)
    
    OpenWindow(1,0,0,640,400,"");LEFT
    OpenWindowedScreen(WindowID(1),0,0,640,400);LEFT
    
    
    OpenWindow(2,640,0,640,400,"");RIGHT
    OpenWindowedScreen(WindowID(2),0,0,640,400);RIGHT
    
    PlayMovie(1,WindowID(1)) ;: Delay(duration * 1000)
    
    
    TestRect.RECT
    
    TestRect\left = 0
    TestRect\right = 640
    TestRect\top = 0
    TestRect\bottom = 400
    Task = CAPTURE::Target(WindowID(1),@TestRect)
    
    Repeat
      ResizeMovie(1,0,0,Random(640,400),Random(400,200))
      If Task
        If CAPTURE::Frame(Task)
          StartDrawing(WindowOutput(2))
          For x = 0 To CAPTURE::Width(Task)
            For y = 0 To CAPTURE::Height(Task)
              Plot(x,y,CAPTURE::Pixel(Task,x,y));Swap Red & Blue for RGB if needed!
            Next
          Next
          StopDrawing()
        EndIf
      EndIf
    Until WaitWindowEvent(50) = #PB_Event_CloseWindow
    CloseWindow(2):CloseWindow(1)
    End

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 8:23 pm
by Kurzer
Chris319, I'm not trying the code, but I have a hunch about it. Maybe your video player uses hardware acceleration? If I'm not mistaken, in this case the video data is transferred directly to the video memory without using the MS Windows window manager.

This means that in the Windows system, only a monochrome rectangle can actually be seen, because the graphics card copies the video data into its own memory shortly before the data is displayed. This is a mechanism where the video data for Windows programs are not available.

I'm not 100% sure, correct me if it's different.

This post was translated fully automatically from German (without a single manual correction) using the fucking incredible, insane, terrifying, goose-skinned, brutally powerful neuronal translation program from http://www.deepl.com - (yes, I'm paralyzed by the translation performance :D )

Re: [MODULE] Desktop/Window Capture

Posted: Fri Sep 29, 2017 8:29 pm
by Bisonte
kurzer wrote:This post was translated fully automatically from German (without a single manual correction) using the fucking incredible, insane, terrifying, goose-skinned, brutally powerful neuronal translation program from http://www.deepl.com - (yes, I'm paralyzed by the translation performance :D )
Wohow. Your statement should be used as a signature. :mrgreen: But, you are right ! I agree 100% ! ;)
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited