Bug In ResizeMovie()?

[chris319]

I'm starting to think we may have a bug in ResizeMovie() in both 5.45 LTS and 5.61, both Windows 10, 64 bits.

I am getting different results depending on whether ResizeMovie() is called. When I give it MovieWidth() and MovieHeight(), I get a partial image. If I give it my own values, I get nothing but black pixels.

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)
ResizeMovie(1,0,0,MovieWidth(1),MovieHeight(1))
;Debug MovieWidth(1): Debug MovieHeight(1)

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

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

Delay(500)

;ResizeMovie(1,0,0,640,360)

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

[chris319]

I am willing to pay money to anyone who can successfully fix some of the problems with the movie functions

[normeus]

from instructions about OpenWindowedScreen:

Remarks

Only one windowed screen can be opened at one time.

Your sample code currently has two OpenWindowedScreen.

[edit] added some code (to your code ) - change the video file name to your video file name

Norm.

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,"c:/prg/zoom.avi")
If IsMovie(1) = 0 : Debug "error media not supported":End: EndIf
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)
;ResizeMovie(1,0,0,MovieWidth(1),MovieHeight(1))
Debug MovieWidth(1): Debug MovieHeight(1)

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

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

Delay(1520)

;ResizeMovie(1,0,0,640,360)

PauseMovie(1)

TestRect.RECT

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


Task = CAPTURE::Target(#Null,@TestRect)
If Task
  If CAPTURE::Frame(Task)
    Debug "capture"
    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()
        EndIf
    EndIf
  EndIf
  CAPTURE::Free(Task)
EndIf
  StartDrawing(ScreenOutput())
    DrawImage(ImageID(0),0,0)
  StopDrawing()
  FlipBuffers()




; 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
;           Debug x
;         Next
;     StopDrawing()
;       EndIf
; EndIf
Repeat
Until WaitWindowEvent(50) = #PB_Event_CloseWindow
CloseWindow(2):CloseWindow(1)
End

[chris319]

I have tried it both with and without windowed screens. No success either way.

[normeus]

This is what I see with Your code edited by me ( the one in my previous post):



my avi movie playing on the left window then stops at 1.5 seconds and a copy is made to 2nd window

pb 5.61x86 windows 10x64




Norm.

[chris319]

I tried your code and I still see a black rectangle where I should see the movie. I tried it with both OpenGL and DirectX11.

[normeus]

I used a freshly installed copy of windows 10x64 and also a fresh copy of PB 5.61x86 & x64
NO DirectX11 Subsystem in my compile.
NO OpenGL Subsystem in my compile.
[Edit oct,6,2017] better explained my system.

Unless someone tells you on their sample code to use those Subsystems don't use them.

By the way, "my code" is not mine. It is a copy and paste of answers here in the forum.

use google search which finds a lot more answers than the forum search:

https://www.google.com/advanced_search? ... rebasic.fr

Norm.

[Dude]

If it helps, here's what I get on my PC (Win 7, 64-bit, PureBasic 5.61 x86):

[chris319]

(the following might be your problem)
NO DirectX11 Subsystem.
NO OpenGL Subsystem.

I believe that if my computer were lacking those things, PB would put up an error message. I have explicitly entered them in compiler preferences and PB did not complain about it.

[chris319]

Here is some code that I use for an eyedropper program which can be found in Tricks & Tips. It's worked well but I have not yet tried it on a PB movie player. Worst case, I could play the video using VLC and use my eyedropper program to read the pixel values. This would be a second-best workaround but it would get me by.

I don't know if this code could be made to capture the entire movie player.

Code: Select all

;Original loupe code by Franco
#WI = 1:#HE=1
    Procedure CaptureScreen(Left.l, Top.l)
      DC = GetDC_(0)
      MemDC = CreateCompatibleDC_(DC)
      BmpID = CreateImage(0, #WI, #HE)
      SelectObject_( MemDC, BmpID)
      StretchBlt_( MemDC, 0, 0,#WI,#HE, DC,Left, Top, #WI, #HE, #SRCCOPY)
      DeleteDC_( MemDC)
      ReleaseDC_(0,DC)
      ProcedureReturn BmpID
    EndProcedure

[normeus]

Sorry @chris319

I meant, Do not use the Subsystems
from @Dude screen shot I see that copying of the left section of the screen works on other computers besides mine.

@Dude, use an AVI movie to see if it works.

Norm.

[Dude]

@Dude, use an AVI movie to see if it works.

I did use an AVI (my screenshot is of an AVI video).

@Dude screen shot I see that copying of the left section of the screen works on other computers besides mine.

So you're saying there's no bug, then?