Windows Media Player Control

Justin · Post by **Justin** » Mon Apr 24, 2023 9:29 am

Hi. Just noticed that in windowlessVideo mode, wich is required for the div to overlay, the video performance is worst as mentioned in the docs.
I tried a h.264 1080p mkv video and stutters in windowless while plays fine in non windowless.

I did some tests and in non windowless it's possible to have a layered child window on top of the video so it will be possible to draw there, someday i´ll try it.

Mesa · Post by **Mesa** » Tue Mar 04, 2025 11:16 am

I've tried to manage brightness (and contrast), but i can't understand why my procedure setb() doesn't work, any idea ?

Click on the menu brightness to trigger setb().

Code: Select all

;Windows Media Player Example
;Justin 06/2020

XIncludeFile "wmp.pb"

EnableExplicit

Define.i ev
Global.i g_wmp, g_lastUIMode

;- Enum MENU_ID
Enumeration
	#MENU_ID_OPEN
	#MENU_ID_UI_NONE
	#MENU_ID_UI_MINI
	#MENU_ID_UI_FULL
	#MENU_ID_PLAY_PAUSE
	#MENU_ID_STOP
	#MENU_ID_GET_CURRENT_TIME
	#MENU_ID_FORWARD
	#MENU_ID_INCREASE_SPEED
	#MENU_ID_DECREASE_SPEED
	#MENU_ID_RESET_SPEED
	#MENU_ID_Brightness
EndEnumeration

Procedure fileOpen()
	Protected.s file
	Protected.IWMPCore core = wmp_GetCore(g_wmp)
	Protected.WMP_OBJECT *wmp = wmp_GetObject(g_wmp)

	file = OpenFileRequester("Open", "", "", 0)
	If file
		
		core\put_URL(file) 
		
;----------------- PB BUG ------------------------
;Calling a method with a bstr from inside a structure produces an IMA.
;*wmp\wmpCore\put_URL(file) ;	IMA
;-------------------------------------------------
	EndIf
EndProcedure

Procedure onResize()
	ResizeGadget(g_wmp, 0, 0, WindowWidth(0), WindowHeight(0) - MenuHeight())
EndProcedure

Procedure setUIMode(menId.l)
	Protected.IWMPPlayer2 player = wmp_GetPlayer(g_wmp)
	
	SetMenuItemState(0, g_lastUIMode, #False)
	
	Select menid
		Case #MENU_ID_UI_FULL
			player\put_uiMode("full")
			
		Case #MENU_ID_UI_MINI
			player\put_uiMode("mini")

		Case #MENU_ID_UI_NONE
			player\put_uiMode("none")
	EndSelect
	
	SetMenuItemState(0, menId, #True)
	g_lastUIMode = menId
EndProcedure

Procedure playPause()
	Protected.IWMPCore core = wmp_GetCore(g_wmp)
	Protected.IWMPControls controls = wmp_GetControls(g_wmp)
	Protected.l state
	
	core\get_playState(@state)
	If state = #wmppsPaused
		controls\play()
		
	ElseIf state = #wmppsPlaying
		controls\pause()
	EndIf 
EndProcedure

Procedure stop()
	Protected.IWMPControls controls = wmp_GetControls(g_wmp)

	controls\stop()
EndProcedure

Procedure getCurrentTime()
	Protected.IWMPControls controls
	Protected.d dPosition
	Protected.i bPosition
	
	controls = wmp_GetControls(g_wmp)
	If controls
		If controls\get_currentPosition(@dPosition) = #S_OK
			Debug dPosition
		EndIf 
		
		If controls\get_currentPositionString(@bPosition) = #S_OK
			Debug PeekS(bPosition)
			
			SysFreeString_(bPosition)
		EndIf
		
		Debug controls\put_currentPosition(dPosition + 10)
	EndIf 
EndProcedure

;Advances 10 seconds
Procedure forward()
	Protected.IWMPControls controls
	Protected.d currPos, inCrement

	inCrement = 10
	controls = wmp_GetControls(g_wmp)
	If controls
		controls\get_currentPosition(@currPos)
		controls\put_currentPosition(currPos + inCrement)
	EndIf 
EndProcedure

Procedure increaseSpeed()
	Protected.IWMPSettings sett
	Protected.d rate, incStep
	
	incStep = 0.1
	If g_wmp
		sett = wmp_GetInterface(g_wmp, ?IID_IWMPSettings)
		If sett
			sett\get_rate(@rate)
			sett\put_rate(rate + incStep)
			sett\Release()
		EndIf
	EndIf 
EndProcedure

Procedure decreaseSpeed()
	Protected.IWMPSettings sett
	Protected.d rate, incStep
	
	incStep = 0.1
	If g_wmp
		sett = wmp_GetInterface(g_wmp, ?IID_IWMPSettings)
		If sett
			sett\get_rate(@rate)
			sett\put_rate(rate - incStep)
			sett\Release()
		EndIf
	EndIf 
EndProcedure

Procedure resetSpeed()
	Protected.IWMPSettings sett
	
	If g_wmp
		sett = wmp_GetInterface(g_wmp, ?IID_IWMPSettings)
		If sett
			sett\put_rate(1.0)
			sett\Release()
		EndIf
	EndIf 
EndProcedure

;-
;- === HERE =======
Procedure setb()
  
  Protected.IWMPVideoSettingsCtrl sett
  Protected br
  
  If g_wmp
    Debug "g_wmp is ok "+g_wmp
    
    sett = wmp_GetInterface(g_wmp, ?IID_IWMPVideoSettingsCtrl)
    
    If sett
      Debug "sett "+sett
      ; 		  sett\get_brightness(@br)
      Debug sett\put_brightness(10)
      ; 		  Debug br
      sett\Release()
    Else
      Debug "sett.IWMPVideoSettingsCtrl not initialized."
    EndIf
  EndIf 
  
  
  
EndProcedure

;-
;*params are in reversed order.
Procedure eventCallback(wmp.i, dispid.l, *params.DISPPARAMS_)
	Select dispid
		Case #_WMPOCXEvents_dispid_PlayStateChange
			Debug "PlayStateChange " + Str(*params\rgvarg\var[0]\lVal)
	
		Case #_WMPOCXEvents_dispid_PositionChange
			Debug "PositionChange " + "old: " + StrD(*params\rgvarg\var[1]\dblVal) + " new: " + StrD(*params\rgvarg\var[0]\dblVal)
			
		Case #_WMPOCXEvents_dispid_Click
			Select *params\rgvarg\var[3]\iVal
				Case 1
					Debug "Left Click"
					
				Case 2
					Debug "Right Click"
					
				Case 4
					Debug "Middle Click"
			EndSelect
	EndSelect
EndProcedure

OpenWindow(0, 100, 150, 600, 400, "WMP", #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
CreateMenu(0, WindowID(0))
MenuTitle("File")
MenuItem(#MENU_ID_OPEN, "Open...")
MenuTitle("Playback")
MenuItem(#MENU_ID_PLAY_PAUSE, "Play / Pause")
MenuItem(#MENU_ID_STOP, "Stop")
MenuItem(#MENU_ID_GET_CURRENT_TIME, "Get current time")
MenuItem(#MENU_ID_FORWARD, "Forward")

MenuTitle("View")
OpenSubMenu("UI Mode")
MenuItem(#MENU_ID_UI_NONE, "None")
MenuItem(#MENU_ID_UI_MINI, "Mini")
MenuItem(#MENU_ID_UI_FULL, "Full")
CloseSubMenu()

MenuTitle("Speed")
MenuItem(#MENU_ID_INCREASE_SPEED, "Increase")
MenuItem(#MENU_ID_DECREASE_SPEED, "Decrease")
MenuItem(#MENU_ID_RESET_SPEED, "Reset")
; CloseSubMenu()

MenuTitle(">> Brightness <<")
MenuItem(#MENU_ID_Brightness, "click here")

AddKeyboardShortcut(0, #PB_Shortcut_Up, #MENU_ID_INCREASE_SPEED)
AddKeyboardShortcut(0, #PB_Shortcut_Down, #MENU_ID_DECREASE_SPEED)

BindEvent(#PB_Event_SizeWindow, @onResize())

g_wmp = wmp_Create(#PB_Any, 0, 0, WindowWidth(0), WindowHeight(0) - MenuHeight(), @eventCallback())
If g_wmp = 0
	MessageRequester("Fatal error", "WMP could not be created, is WMP installed?")
	End
EndIf 

setUIMode(#MENU_ID_UI_NONE)

Repeat
	ev = WaitWindowEvent()
	Select ev
		Case #PB_Event_Menu
			Select EventMenu()
				Case #MENU_ID_OPEN : fileOpen()
					
				Case #MENU_ID_UI_NONE, #MENU_ID_UI_MINI, #MENU_ID_UI_FULL : setUIMode(EventMenu())
					
				Case #MENU_ID_PLAY_PAUSE : playPause()
				
				Case #MENU_ID_STOP : stop()
				
				Case #MENU_ID_GET_CURRENT_TIME : getCurrentTime()
			
				Case #MENU_ID_FORWARD : forward()
				
				Case #MENU_ID_INCREASE_SPEED : increaseSpeed()
				
				Case #MENU_ID_DECREASE_SPEED : decreaseSpeed()
				
				Case #MENU_ID_RESET_SPEED : resetSpeed()
				  
				Case #MENU_ID_Brightness:setb()
				  
			EndSelect
	EndSelect
Until  ev = #PB_Event_CloseWindow

M.

Justin · Post by **Justin** » Thu Mar 06, 2025 4:44 pm

That's an undocumented interface, it will not work.

To set the brightness you need to use DirectShow.
First install the codecs for current video formats:
https://github.com/Nevcairiel/LAVFilters/releases

This code is done with the help of AI in C++, currently creates and releases all the interfaces for every movie, maybe it can be done better.

Code: Select all

;DShow.pb

;DirectShow video
;Justin 03/25

;Codecs
;https://github.com/Nevcairiel/LAVFilters/releases

EnableExplicit

Macro DEFINE_GUID(name, _l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8) 
	DataSection 
		name:
  	Data.l _l
  	Data.w w1, w2
  	Data.b b1, b2, b3, b4, b5, b6, b7, b8
  EndDataSection
EndMacro

;- #VMR9Mode
#VMR9Mode_Windowed    = $1
#VMR9Mode_Windowless  = $2
#VMR9Mode_Renderless  = $4

;- VMR9ProcAmpControl
Structure VMR9ProcAmpControl Align #PB_Structure_AlignC
	dwSize.l
	dwFlags.l
	Brightness.f
	Contrast.f
	Hue.f
	Saturation.f
EndStructure

;- VMR9ProcAmpControlRange
Structure VMR9ProcAmpControlRange Align #PB_Structure_AlignC
	dwSize.l
	dwProperty.l
	MinValue.f
	MaxValue.f
	DefaultValue.f
	StepSize.f
EndStructure

;- #ProcAmpControl9_
#ProcAmpControl9_Brightness = $00000001
#ProcAmpControl9_Contrast   = $00000002
#ProcAmpControl9_Hue        = $00000004
#ProcAmpControl9_Saturation = $00000008
#ProcAmpControl9_Mask       = $0000000F

;- GUIDS
DEFINE_GUID(IID_IGraphBuilder,          $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaControl,          $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBaseFilter,            $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IVMRFilterConfig9,      $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
DEFINE_GUID(IID_IVMRMixerControl9, 			$1a777eaa, $47c8, $4930, $b2, $c9, $8f, $ee, $1c, $1b, $0f, $3b)
DEFINE_GUID(CLSID_FilterGraph,          $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)

;- _APP
Structure _APP
	win.i
	menu.i
	pGraph.IGraphBuilder
	pControl.IMediaControl
	pVMRMixer.IVMRMixerControl9
	pWC.IVMRWindowlessControl9
EndStructure
Global._APP app

;- #MENU_ID_
Enumeration
	#MENU_ID_LOAD_MOVIE
	#MENU_ID_SET_BRIGHTNESS
	#MENU_ID_GET_RANGE
	#MENU_ID_TEST
EndEnumeration

;- DECLARES
Declare SetupVMR9(win.i)
Declare InitDirectShow(win.i)
Declare ReleaseDirectShow()

Procedure ResizeVideo()
	Protected.RECT rc
	
	;Resize the video To fit the window
	GetClientRect_(WindowID(app\win), @rc)
	If app\pWC
		app\pWC\SetVideoPosition(0, @rc)
	EndIf 
EndProcedure

Procedure Load_Movie()
	Protected.s filename
	
	filename = OpenFileRequester("", "", "", 0)
	If filename = "" : ProcedureReturn : EndIf
	
	;Stop current movie and release interfaces
	If app\pGraph
		ReleaseDirectShow()
	EndIf
	
	;Initialize interfaces
	If InitDirectShow(app\win) = 0
		MessageRequester("Error", "Failed To initialize DirectShow")
		ProcedureReturn
	EndIf 
		
	If app\pGraph\RenderFile(@filename, #Null) <> #S_OK
		MessageRequester("Error", "Failed to render file, install codecs")
		ProcedureReturn
	EndIf
	
	ResizeVideo()
	
	app\pControl\Run()
EndProcedure

Procedure SetBrightness()
	Protected.VMR9ProcAmpControl brightnessControl 
	
	brightnessControl\dwSize = SizeOf(VMR9ProcAmpControl)
	brightnessControl\dwFlags = #ProcAmpControl9_Brightness
	
	;Brightness range -99.9 to 100.0, neutral 0.0
	brightnessControl\Brightness = -50.0
	
	If app\pVMRMixer
		app\pVMRMixer\SetProcAmpControl(0, @brightnessControl)
	EndIf 
EndProcedure

Procedure GetRange()
	Protected.VMR9ProcAmpControlRange range
	
	
	If app\pVMRMixer
		range\dwSize = SizeOf(VMR9ProcAmpControlRange)
		range\dwProperty = #ProcAmpControl9_Brightness
		If app\pVMRMixer\GetProcAmpControlRange(0, @range) = #S_OK
			Debug "Brightness " + "Max: " + StrF(range\MaxValue) + " Min: " + StrF(range\MinValue) + " Def: " + StrF(range\DefaultValue)
		Else
			Debug "Error, failed to get Brightness range"
		EndIf 
		
		range\dwSize = SizeOf(VMR9ProcAmpControlRange)
		range\dwProperty = #ProcAmpControl9_Contrast
		If app\pVMRMixer\GetProcAmpControlRange(0, @range) = #S_OK
			Debug "Contrast " + "Max: " + StrF(range\MaxValue) + " Min: " + StrF(range\MinValue) + " Def: " + StrF(range\DefaultValue)
		
		Else
			Debug "Error, failed to get Contrast"
		EndIf
		
		range\dwSize = SizeOf(VMR9ProcAmpControlRange)
		range\dwProperty = #ProcAmpControl9_Hue
		If app\pVMRMixer\GetProcAmpControlRange(0, @range) = #S_OK
			Debug "Hue " + "Max: " + StrF(range\MaxValue) + " Min: " + StrF(range\MinValue) + " Def: " + StrF(range\DefaultValue)
		
		Else
			Debug "Error, failed to get Hue"
		EndIf
		
		range\dwSize = SizeOf(VMR9ProcAmpControlRange)
		range\dwProperty = #ProcAmpControl9_Saturation
		If app\pVMRMixer\GetProcAmpControlRange(0, @range) = #S_OK
			Debug "Saturation " + "Max: " + StrF(range\MaxValue) + " Min: " + StrF(range\MinValue) + " Def: " + StrF(range\DefaultValue)
		
		Else
			Debug "Error, failed to get Saturation"
		EndIf
		
	EndIf
EndProcedure

Procedure Test()
	app\pControl\Stop()
EndProcedure

Procedure SetupVMR9(win.i)
	Protected.IBaseFilter pVMR9
	Protected.IVMRFilterConfig9 pConfig
	
	;Create the VMR9 filter
	CoCreateInstance_(?CLSID_VideoMixingRenderer9, #Null, #CLSCTX_INPROC_SERVER, ?IID_IBaseFilter, @pVMR9)
	
	;Add it To the graph
	app\pGraph\AddFilter(pVMR9, @"VMR9")
	
	pVMR9\QueryInterface(?IID_IVMRFilterConfig9, @pConfig)
	If pConfig
		pConfig\SetRenderingMode(#VMR9Mode_Windowless)
		pConfig\Release()
  EndIf
  
  pVMR9\QueryInterface(?IID_IVMRWindowlessControl9, @app\pWC)
	app\pWC\SetVideoClippingWindow(WindowID(win))
	
	pVMR9\QueryInterface(?IID_IVMRMixerControl9, @app\pVMRMixer)
  pVMR9\Release()
  
	ProcedureReturn app\pVMRMixer
EndProcedure

Procedure InitDirectShow(win)
	;Create GraphBuilder
	If CoCreateInstance_(?CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, ?IID_IGraphBuilder, @app\pGraph) = #S_OK
		;Query MediaControl
		If app\pGraph\QueryInterface(?IID_IMediaControl, @app\pControl) = #S_OK
			;SetupVMR9
			ProcedureReturn SetupVMR9(win)
		EndIf
	EndIf 
	
	ProcedureReturn 0 ;Error
EndProcedure

Procedure ReleaseDirectShow()
	Protected.IEnumFilters pEnum
	Protected.IBaseFilter pFilter
	
	If app\pControl
		app\pControl\Stop()
		app\pControl\Release()
		app\pControl = 0
	EndIf

	If app\pGraph
		app\pGraph\EnumFilters(@pEnum)
		If pEnum
			While pEnum\Next(1, @pFilter, #Null) = #S_OK
        app\pGraph\RemoveFilter(pFilter)
        pFilter\Release()
        
        pEnum\Reset()
			Wend
			
			pEnum\Release()
		EndIf
	
		app\pGraph\Release() : app\pGraph = 0
	EndIf
	
	If app\pVMRMixer : app\pVMRMixer\Release() : app\pVMRMixer = 0 : EndIf
	If app\pWC : app\pWC\Release() : app\pWC = 0 : EndIf
EndProcedure

Procedure main()
	Protected.l ev
	
	CoInitialize_(0)
	
	app\win = OpenWindow(#PB_Any, 10, 10, 600, 400, "DirectShow", #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget)
	
	app\menu = CreateMenu(#PB_Any, WindowID(app\win))
	MenuTitle("Test")
	MenuItem(#MENU_ID_LOAD_MOVIE, "Load movie")
	MenuItem(#MENU_ID_SET_BRIGHTNESS, "Set brightness")
	MenuItem(#MENU_ID_GET_RANGE, "Get range")
	MenuItem(#MENU_ID_TEST, "Test")

	BindMenuEvent(app\menu, #MENU_ID_LOAD_MOVIE, @Load_Movie())
	BindMenuEvent(app\menu, #MENU_ID_SET_BRIGHTNESS, @SetBrightness())
	BindMenuEvent(app\menu, #MENU_ID_GET_RANGE, @GetRange())
	BindMenuEvent(app\menu, #MENU_ID_TEST, @Test())

	BindEvent(#PB_Event_SizeWindow, @ResizeVideo())
		
	Repeat
		ev = WaitWindowEvent()
		
	Until ev = #PB_Event_CloseWindow
	
	ReleaseDirectShow()
EndProcedure

main()

Mesa · Post by **Mesa** » Mon Mar 10, 2025 4:40 pm

Thanks justin, it works.

But i have a strange problem, this code works with many videos, like mp4 videos, etc but the brightness and contrast don't work with avi videos without compression, do you have an idea ?

Under a little code to test brightness and contrast:

Code: Select all

;DShow.pb

;DirectShow video
;Justin 03/25

;Codecs
;https://github.com/Nevcairiel/LAVFilters/releases

EnableExplicit

Macro DEFINE_GUID(name, _l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  DataSection
    name:
    Data.l _l
    Data.w w1, w2
    Data.b b1, b2, b3, b4, b5, b6, b7, b8
  EndDataSection
EndMacro

;- #VMR9Mode
#VMR9Mode_Windowed   = $1
#VMR9Mode_Windowless = $2
#VMR9Mode_Renderless = $4

;- VMR9ProcAmpControl
Structure VMR9ProcAmpControl Align #PB_Structure_AlignC
  dwSize.l
  dwFlags.l
  Brightness.f
  Contrast.f
  Hue.f
  Saturation.f
EndStructure

;- #ProcAmpControl9_
#ProcAmpControl9_Brightness = $00000001
#ProcAmpControl9_Contrast   = $00000002
#ProcAmpControl9_Hue        = $00000004;nominal valid range from -180 to 180 degrees and a default value of 0.
#ProcAmpControl9_Saturation = $00000008
#ProcAmpControl9_Mask       = $0000000F
; #ProcAmpControl9_Mask = Bitwise OR of all the previous flags. This value is used internally by the VMR-9, and is not a valid flag.

;- GUIDS
DEFINE_GUID(IID_IGraphBuilder, $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaControl, $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBaseFilter, $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IVMRFilterConfig9, $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
DEFINE_GUID(IID_IVMRMixerControl9, $1a777eaa, $47c8, $4930, $b2, $c9, $8f, $ee, $1c, $1b, $0f, $3b)
DEFINE_GUID(CLSID_FilterGraph, $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)

;- _APP
Structure _APP
  win.i
  menu.i
  pGraph.IGraphBuilder
  pControl.IMediaControl
  pVMRMixer.IVMRMixerControl9
  pWC.IVMRWindowlessControl9
  Brightness.f
  Contrast.f
  Width.i
  Height.i
  VideoW.i
  VideoH.i
  RatioW.i
  RatioH.i
  ContainerID.i
  ContainerW.i
  ContainerH.i
  ContainerX.i
  ContainerY.i
  Filename.s
EndStructure
Global._APP app



;- DECLARES
Declare SetupVMR9(win.i)
Declare InitDirectShow(win.i)
Declare ReleaseDirectShow()

Declare ResizeVideo()
Procedure ResizeVideo()
  Protected rc.RECT, w
  ;TODO aspect ratio (16/9  9/16, ...)
  
  ;Resize the video To fit the window
  GetClientRect_(WindowID(app\win), @rc);:Debug rc\bottom
  
  w = rc\right
  ResizeGadget(app\ContainerID, #PB_Ignore , #PB_Ignore ,
               WindowWidth(app\win) - GadgetX(app\ContainerID), rc\bottom - app\ContainerY)
  
  GetClientRect_(app\ContainerID, @rc);:Debug rc\bottom
  If app\pWC
    app\pWC\SetVideoPosition(0, @rc)
  EndIf
  
EndProcedure

Procedure GetSizeMovie()
  ;   Protected lpWidth, lpHeight, lpARWidth, lpARHeight
  
  app\pWC\GetNativeVideoSize(@app\VideoW, @app\VideoH, @app\RatioW, @app\RatioH)
  Debug app\VideoW
  Debug app\VideoH
  Debug app\RatioW
  Debug app\RatioH
EndProcedure

Procedure Load_Movie()
  Protected.s filename
  
  filename = OpenFileRequester("", "", "", 0)
  If filename = "" : ProcedureReturn : EndIf
  
  app\Filename = filename
  
  ;Stop current movie and release interfaces
  If app\pGraph
    ReleaseDirectShow()
  EndIf
  
  ;Initialize interfaces
  If InitDirectShow(app\win) = 0
    MessageRequester("Error", "Failed To initialize DirectShow")
    ProcedureReturn
  EndIf
  
  If app\pGraph\RenderFile(@filename, #Null) <> #S_OK
    MessageRequester("Error", "Failed to render file, install codecs")
    ProcedureReturn
  EndIf
  
  GetSizeMovie()
  ResizeVideo()
  
  app\pControl\Run()
EndProcedure
Procedure Load_Movie2(filename.s)
  
  app\Filename = filename
  
  ;Stop current movie and release interfaces
  If app\pGraph
    ReleaseDirectShow()
  EndIf
  
  ;Initialize interfaces
  If InitDirectShow(app\win) = 0
    MessageRequester("Error", "Failed To initialize DirectShow")
    ProcedureReturn
  EndIf
  
  If app\pGraph\RenderFile(@filename, #Null) <> #S_OK
    MessageRequester("Error", "Failed to render file, install codecs")
    ProcedureReturn
  EndIf
  
  GetSizeMovie()
  ResizeVideo()
  
  app\pControl\Run()
EndProcedure


Procedure SetBrightness()
  Protected.VMR9ProcAmpControl brightnessControl
  
  brightnessControl\dwSize  = SizeOf(VMR9ProcAmpControl)
  brightnessControl\dwFlags = #ProcAmpControl9_Brightness
  
  ;Brightness range -99.9 to 100.0, neutral 0.0
  brightnessControl\Brightness = app\Brightness
  
  If app\pVMRMixer
    app\pVMRMixer\SetProcAmpControl(0, @brightnessControl)
  EndIf
EndProcedure

Procedure SetContrast()
  ;   #ProcAmpControl9_Brightness = $00000001
  ; #ProcAmpControl9_Contrast   = $00000002
  ; #ProcAmpControl9_Hue        = $00000004
  ; #ProcAmpControl9_Saturation = $00000008
  ; #ProcAmpControl9_Mask       = $0000000F
  
  Protected.VMR9ProcAmpControl ContrastControl
  
  ContrastControl\dwSize  = SizeOf(VMR9ProcAmpControl)
  ContrastControl\dwFlags = #ProcAmpControl9_Contrast
  
  ;Brightness range -99.9 to 100.0, neutral 0.0
  ContrastControl\Contrast = app\Contrast
  
  If app\pVMRMixer
    app\pVMRMixer\SetProcAmpControl(0, @ContrastControl)
  EndIf
  
EndProcedure

Procedure Run()
  app\pControl\Run()
EndProcedure

Procedure Pause()
  app\pControl\Pause()
  ;   Debug app\pWC\RepaintVideo(WindowID(app\win),GadgetID(app\ContainerID))
  
EndProcedure
Procedure Stop()
  app\pControl\Stop()
EndProcedure

Procedure SetupVMR9(win.i)
  Protected.IBaseFilter pVMR9
  Protected.IVMRFilterConfig9 pConfig
  
  ;Create the VMR9 filter
  CoCreateInstance_(?CLSID_VideoMixingRenderer9, #Null, #CLSCTX_INPROC_SERVER, ?IID_IBaseFilter, @pVMR9)
  
  ;Add it To the graph
  app\pGraph\AddFilter(pVMR9, @"VMR9")
  
  pVMR9\QueryInterface(?IID_IVMRFilterConfig9, @pConfig)
  If pConfig
    pConfig\SetRenderingMode(#VMR9Mode_Windowless);#VMR9Mode_Windowed  #VMR9Mode_Renderless
    pConfig\Release()
  EndIf
  
  pVMR9\QueryInterface(?IID_IVMRWindowlessControl9, @app\pWC)
  ; 	app\pWC\SetVideoClippingWindow(WindowID(win))
  app\pWC\SetVideoClippingWindow(GadgetID(app\ContainerID))
  
  pVMR9\QueryInterface(?IID_IVMRMixerControl9, @app\pVMRMixer)
  pVMR9\Release()
  
  ProcedureReturn app\pVMRMixer
EndProcedure

Procedure InitDirectShow(win)
  ;Create GraphBuilder
  If CoCreateInstance_(?CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, ?IID_IGraphBuilder, @app\pGraph) = #S_OK
    ;Query MediaControl
    If app\pGraph\QueryInterface(?IID_IMediaControl, @app\pControl) = #S_OK
      ;SetupVMR9
      ProcedureReturn SetupVMR9(win)
    EndIf
  EndIf
  
  ProcedureReturn 0 ;Error
EndProcedure

Procedure ReleaseDirectShow()
  Protected.IEnumFilters pEnum
  Protected.IBaseFilter pFilter
  
  If app\pControl
    app\pControl\Stop()
    app\pControl\Release()
    app\pControl = 0
  EndIf
  
  If app\pGraph
    app\pGraph\EnumFilters(@pEnum)
    If pEnum
      While pEnum\Next(1, @pFilter, #Null) = #S_OK
        app\pGraph\RemoveFilter(pFilter)
        pFilter\Release()
        
        pEnum\Reset()
      Wend
      
      pEnum\Release()
    EndIf
    
    app\pGraph\Release() : app\pGraph = 0
  EndIf
  
  If app\pVMRMixer : app\pVMRMixer\Release() : app\pVMRMixer = 0 : EndIf
  If app\pWC : app\pWC\Release() : app\pWC = 0 : EndIf
EndProcedure






;- GADGET_ID_
Enumeration
  #Container
  #Run
  #Pause
  #Stop
  #Track_Brightness
  #Track_Contrast
  
EndEnumeration
;- #MENU_ID_
Enumeration
  #MENU_ID_LOAD_MOVIE
  #MENU_ID_SET_BRIGHTNESS
  #MENU_ID_SET_CONTRAST
  #MENU_ID_STOP
  #MENU_ID_PAUSE
  #MENU_ID_RUN
  #test
EndEnumeration



Procedure Brightness()
  Protected offset = 0
  
  app\Brightness = (GetGadgetState(#Track_Brightness) - offset) / 10:Debug app\Brightness
  SetBrightness()
  
  SetWindowTitle(app\win, "Brightness: " + StrD(app\Brightness, 1) + " Contrast: " + Str(app\Contrast * 100))
EndProcedure

Procedure Contrast()
  
  app\Contrast = GetGadgetState(#Track_Contrast) / 100:Debug app\Contrast
  SetContrast()
  
  SetWindowTitle(app\win, "Brightness: " + StrD(app\Brightness, 1) + " Contrast: " + Str(app\Contrast * 100))
EndProcedure



Procedure test()
  Protected lpWidth, lpHeight, lpARWidth, lpARHeight
  ;   Debug app\pWC\GetMaxIdealVideoSize(@lpWidth, @lpHeight)
  ;   Debug lpWidth
  ;   Debug lpHeight
  
EndProcedure


Procedure init(container, filename$)
  Protected movie
  Protected w, h
  
  app\ContainerID = container
  app\ContainerW  = GadgetWidth(container)
  app\ContainerH  = GadgetHeight(container)
  app\ContainerX  = GadgetX(container)
  app\ContainerY  = GadgetY(container)
  
  app\Filename = filename$
  
  app\Width  = app\ContainerW
  app\Height = app\ContainerH
  
EndProcedure

Procedure main()
  Protected ev, movie$
  
  CoInitialize_(0)
  
  app\win = OpenWindow(#PB_Any, 0, 0, DesktopUnscaledX(800), DesktopUnscaledX(400), "DirectShow", #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_ScreenCentered )
  
  app\menu = CreateMenu(#PB_Any, WindowID(app\win))
  MenuTitle("Fichier")
  MenuItem(#MENU_ID_LOAD_MOVIE, "Load movie")
  MenuItem(#MENU_ID_SET_BRIGHTNESS, "Set brightness")
  MenuItem(#MENU_ID_SET_CONTRAST, "Set contrast")
  MenuItem(#MENU_ID_STOP, "Stop")
  MenuItem(#MENU_ID_PAUSE, "Pause")
  MenuItem(#MENU_ID_RUN, "Run")
  
  MenuItem(#test, "test")
  
  BindMenuEvent(app\menu, #MENU_ID_LOAD_MOVIE, @Load_Movie())
  BindMenuEvent(app\menu, #MENU_ID_SET_BRIGHTNESS, @SetBrightness())
  BindMenuEvent(app\menu, #MENU_ID_SET_CONTRAST, @SetContrast())
  BindMenuEvent(app\menu, #MENU_ID_STOP, @Stop())
  BindMenuEvent(app\menu, #MENU_ID_PAUSE, @Pause())
  BindMenuEvent(app\menu, #MENU_ID_RUN, @Run())
  BindMenuEvent(app\menu, #test, @test())
  
  
  ButtonGadget(#Run, 10, 0, 30, 30, ">")
  ButtonGadget(#Pause, 40, 0, 30, 30, "II")
  ButtonGadget(#Stop, 70, 0, 30, 30, "O")
  BindGadgetEvent(#Run, @Run())
  BindGadgetEvent(#Pause, @Pause())
  BindGadgetEvent(#Stop, @Stop())
  
  TrackBarGadget(#Track_Brightness, 100, 0, 280, 30, 0, 0, #PB_TrackBar_Ticks )
  SendMessage_(GadgetID(#Track_Brightness), #TBM_SETRANGEMIN, 1,  - 1000)
  SendMessage_(GadgetID(#Track_Brightness), #TBM_SETRANGEMAX, 1, 1000)
  SetGadgetState(#Track_Brightness, 0)
  BindGadgetEvent(#Track_Brightness, @Brightness())
  
  
  
  
  
  TrackBarGadget(#Track_Contrast, 400, 0, 280, 30, 0, 100, #PB_TrackBar_Ticks )
  BindGadgetEvent(#Track_Contrast, @Contrast())
  
  ContainerGadget(#Container, 0, 35, 711, 400)
  
  ;movie$ = "f:\z.mp4"
  movie$="f:\z.avi"
  
  init(#Container, movie$)
  
  Load_Movie2(movie$)
  
  
  BindEvent(#PB_Event_SizeWindow, @ResizeVideo())
  Repeat
    ev = WaitWindowEvent()
    
  Until ev = #PB_Event_CloseWindow
  
  ReleaseDirectShow()
EndProcedure

main()

M.

Justin · Post by **Justin** » Mon Mar 10, 2025 11:21 pm

Hi, I don't have any uncompressed video to test, it worked with all the avi compressed videos i tried but i noticed that mkv videos don't play, i will look into it later.

I uptated the code with a function to get the supported ranges GetRange(), you can try that before setting the range.

AI says it should work with uncompressed videos, but it can be some issues:

ProcAmpControl Requires VMR9 in Mixing Mode (done)

Make sure IVMRMixerControl9::SetProcAmpControl() is being called.
Ensure VMR9 is in Windowless mode before setting brightness/contrast:
pVMRConfig->SetRenderingMode(VMR9Mode_Windowless);

Some AVI Files Use Unsupported Color Spaces

If the AVI file is using a non-RGB or non-YUV format, VMR9 may fail to process colors.
Fix: Convert it to a supported format using a Color Space Converter filter.
pGraph->AddFilter(pColorSpaceConverter, L"Color Space Converter");

Graphics Card or Driver May Override Settings

Some GPU drivers override DirectShow's brightness/contrast settings.
If changes are not visible, try disabling hardware acceleration in VMR9:
pVMRConfig->SetRenderingPrefs(VMR9RenderPrefs_DoNotUseOverlay);

Mesa · Post by **Mesa** » Wed Mar 19, 2025 10:38 am

I've made some tests:

Hi, I don't have any uncompressed video to test, it worked with all the avi compressed videos i tried but i noticed that mkv videos don't play, i will look into it later.

I 've created this avis with virtualdub2.0 or avidemux, they are free softwares.

Make sure IVMRMixerControl9::SetProcAmpControl() is being called.

yes and i've got this error code:
VFW_E_VMR_NO_PROCAMP_HW
0x80040299
(on 2 differents pcs)

Ensure VMR9 is in Windowless mode before setting brightness/contrast:
pVMRConfig->SetRenderingMode(VMR9Mode_Windowless);

ok

Some AVI Files Use Unsupported Color Spaces

it could be that

If the AVI file is using a non-RGB or non-YUV format, VMR9 may fail to process colors.

it's a rgb24, even if i convert it in rgb32

Graphics Card or Driver May Override Settings
Some GPU drivers override DirectShow's brightness/contrast settings.

it could be that but on 2 different pcs ?

If changes are not visible, try disabling hardware acceleration in VMR9:
pVMRConfig->SetRenderingPrefs(VMR9RenderPrefs_DoNotUseOverlay);

i can't find VMR9RenderPrefs_DoNotUseOverlay anywhere.

M.

Justin · Post by **Justin** » Thu Mar 20, 2025 6:02 pm

Can you upload a sample of the not working video to somewhere?

Mesa · Post by **Mesa** » Mon Mar 24, 2025 3:28 pm

Very short example but enough to get the error message : "Error, failed to get Brightness range".

http:/frazier.wood.free.fr/ztest.avi

It's not an https link, so some webbrowsers don't accept this kind of link, but no danger at all, it's just an old site web.

M.

Justin · Post by **Justin** » Tue Mar 25, 2025 5:09 pm

I think the best option is to use libvlc, this works with your file but you will have to figure out how to embeb a player in a container gadget, i think there are some examples in this forum.

Download libvlc:
https://www.nuget.org/packages/VideoLAN ... ows/3.0.21
Rename it to .zip and unzip the contents.

In the folder "build\x64", place the following file and run it, that should work:

Code: Select all

;vlc_test.pb

;https://www.nuget.org/packages/VideoLAN.LibVLC.Windows/3.0.21
;https://videolan.videolan.me/vlc/index.html

EnableExplicit

;- libvlc_video_adjust_option_t
Enumeration
	#libvlc_adjust_Enable = 0
	#libvlc_adjust_Contrast
	#libvlc_adjust_Brightness
	#libvlc_adjust_Hue
	#libvlc_adjust_Saturation
	#libvlc_adjust_Gamma
EndEnumeration

Import "libvlc.lib"
	libvlc_new(argc.i, argv.i)
	
	libvlc_media_player_new.i(libInst.i)
	libvlc_media_player_new_from_media.i(media.i)
	libvlc_media_new_path.i(libInst.i, path.p-utf8)
	
	libvlc_video_set_adjust_int(player.i, option.l, value.i)
	libvlc_video_set_adjust_float(player.i, optiom.l, value.f)
	libvlc_media_player_play(player.i)
EndImport

Procedure main()
	Protected.i vlcInst, media, player
	Protected.s file
	
	vlcInst = libvlc_new(0, 0)
	
	If vlcInst = 0 ;error
		ProcedureReturn 
	EndIf 
	
; 	file = "E:\purebasic\Directshow\ztest.avi"
	file = OpenFileRequester("", "", "", 0)
	media = libvlc_media_new_path(vlcInst, file)
	Debug media
	
	player = libvlc_media_player_new_from_media(media)
	Debug player
	libvlc_media_player_play(player)
	Delay(1000)
	
	libvlc_video_set_adjust_int(player, #libvlc_adjust_Enable, 1)
	libvlc_video_set_adjust_float(player, #libvlc_adjust_Brightness, 0.5)

	Delay(10000)
EndProcedure

main()

dige · Post by **dige** » Wed Mar 26, 2025 2:39 pm

Thx Justin!

Code: Select all

; Inspired by Justin
; Small extension with GUI, created with chatgpt 4o
; https://www.purebasic.fr/english/viewtopic.php?t=75564&start=30

EnableExplicit

;--- LibVLC Binding
Import "libvlc.lib"
  libvlc_new.i(argc.i, argv.i)
  libvlc_release(inst.i)

  libvlc_media_new_path.i(inst.i, path.p-utf8)
  libvlc_media_release(media.i)

  libvlc_media_player_new_from_media.i(media.i)
  libvlc_media_player_release(player.i)

  libvlc_media_player_play(player.i)
  libvlc_media_player_pause(player.i)
  libvlc_media_player_stop(player.i)

  libvlc_media_player_set_hwnd(player.i, hwnd.i)

  libvlc_media_player_get_length.q(player.i)
  libvlc_media_player_get_time.q(player.i)
  libvlc_media_player_set_time(player.i, time.q)

  libvlc_audio_set_volume(player.i, volume.i)

  libvlc_video_take_snapshot(player.i, num.i, filepath.p-utf8, width.i, height.i)
EndImport

;--- GUI Constants
Enumeration
  #MainWindow
  #VideoOutput
  #Btn_Open
  #Btn_Play
  #Btn_Pause
  #Btn_Stop
  #Btn_Snapshot
  #Slider_Position
  #Slider_Volume
  #Timer_Update
EndEnumeration

;--- Globals
Global vlcInst.i, media.i, player.i
Global filePath.s
Global skipSliderUpdate.i

;--- Init VLC
vlcInst = libvlc_new(0, 0)

;--- Funktionen
Procedure LoadFile()
  filePath = OpenFileRequester("Video auswählen", "", "Videos (*.mp4;*.avi)|*.mp4;*.avi|Alle Dateien|*.*", 0)
  If filePath
    If media  : libvlc_media_release(media) : EndIf
    If player : libvlc_media_player_release(player) : EndIf

    media = libvlc_media_new_path(vlcInst, filePath)
    player = libvlc_media_player_new_from_media(media)
    libvlc_media_player_set_hwnd(player, GadgetID(#VideoOutput))

    libvlc_media_player_play(player)
  EndIf
EndProcedure

Procedure PlayVideo()
  If player : libvlc_media_player_play(player) : EndIf
EndProcedure

Procedure PauseVideo()
  If player : libvlc_media_player_pause(player) : EndIf
EndProcedure

Procedure StopVideo()
  If player : libvlc_media_player_stop(player) : EndIf
EndProcedure

Procedure TakeSnapshot()
  If player
    Define snapFile.s = "snapshot_" + FormatDate("%yyyymmdd_%hh%ii%ss", Date()) + ".png"
    libvlc_video_take_snapshot(player, 0, snapFile, 0, 0)
    MessageRequester("Snapshot", "Gespeichert: " + snapFile)
  EndIf
EndProcedure

Procedure UpdateSlider()
  If player And skipSliderUpdate = 0
    Define length.q = libvlc_media_player_get_length(player)
    Define pos.q    = libvlc_media_player_get_time(player)
    If length > 0
      SetGadgetState(#Slider_Position, pos * 100 / length)
    EndIf
  EndIf
EndProcedure

Procedure ChangePosition()
  If player
    skipSliderUpdate = 1
    Define length.q = libvlc_media_player_get_length(player)
    Define percent.f = GetGadgetState(#Slider_Position)
    Define targetTime.q = Round(percent * length / 100.0, #PB_Round_Nearest)
    libvlc_media_player_set_time(player, targetTime)
    skipSliderUpdate = 0
  EndIf
EndProcedure

Procedure ChangeVolume()
  If player
    Define volume = GetGadgetState(#Slider_Volume)
    libvlc_audio_set_volume(player, volume)
  EndIf
EndProcedure

;--- Main Window
Procedure OpenMainWindow()
  If OpenWindow(#MainWindow, 0, 0, 640, 480, "VLC Powerplayer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    
    CanvasGadget(#VideoOutput, 10, 10, 620, 300, #PB_Canvas_Container)
    CloseGadgetList()

    ButtonGadget(#Btn_Open,     10, 320, 100, 30, "Datei öffnen")
    ButtonGadget(#Btn_Play,    120, 320,  80, 30, "Play")
    ButtonGadget(#Btn_Pause,   210, 320,  80, 30, "Pause")
    ButtonGadget(#Btn_Stop,    300, 320,  80, 30, "Stop")
    ButtonGadget(#Btn_Snapshot,390, 320, 100, 30, "Snapshot")

    TextGadget(#PB_Any,         10, 360, 100, 20, "Position")
    TrackBarGadget(#Slider_Position, 80, 360, 510, 20, 0, 100)

    TextGadget(#PB_Any,         10, 390, 100, 20, "Lautstärke")
    TrackBarGadget(#Slider_Volume, 80, 390, 200, 20, 0, 100)
    SetGadgetState(#Slider_Volume, 80)

    ;--- Event Bindings
    BindGadgetEvent(#Slider_Position, @ChangePosition())
    BindGadgetEvent(#Slider_Volume,   @ChangeVolume())

    AddWindowTimer(#MainWindow, #Timer_Update, 500)

    ;--- Event Loop
    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Btn_Open    : LoadFile()
            Case #Btn_Play    : PlayVideo()
            Case #Btn_Pause   : PauseVideo()
            Case #Btn_Stop    : StopVideo()
            Case #Btn_Snapshot: TakeSnapshot()
          EndSelect

        Case #PB_Event_Timer
          If EventTimer() = #Timer_Update
            UpdateSlider()
          EndIf

        Case #PB_Event_CloseWindow
          Break
      EndSelect
    ForEver
  EndIf
EndProcedure

;--- Start
OpenMainWindow()

;--- Cleanup
If player : libvlc_media_player_release(player) : EndIf
If media  : libvlc_media_release(media) : EndIf
If vlcInst: libvlc_release(vlcInst)     : EndIf

dige · Post by **dige** » Thu Mar 27, 2025 9:43 am

That's fun. A few more features...

Code: Select all


; Inspired by Justin
; Small extension with GUI, created with chatgpt 4o
; https://www.purebasic.fr/english/viewtopic.php?t=75564&start=30

EnableExplicit
Import "libvlc.lib"
  libvlc_new.i(argc.i, argv.i)
  libvlc_release(inst.i)
  libvlc_media_new_path.i(inst.i, path.p-utf8)
  libvlc_media_release(media.i)
  libvlc_media_player_new_from_media.i(media.i)
  libvlc_media_player_release(player.i)
  libvlc_media_player_play(player.i)
  libvlc_media_player_pause(player.i)
  libvlc_media_player_stop(player.i)
  libvlc_media_player_set_hwnd(player.i, hwnd.i)
  libvlc_media_player_get_length.q(player.i)
  libvlc_media_player_get_time.q(player.i)
  libvlc_media_player_set_time(player.i, time.q)
  libvlc_audio_set_volume(player.i, volume.i)
  libvlc_video_take_snapshot(player.i, num.i, filepath.p-utf8, width.i, height.i)
EndImport

Enumeration
  #MainWindow
  #VideoOutput
  #Btn_Open
  #Btn_Play
  #Btn_Pause
  #Btn_Stop
  #Btn_Snapshot
  #Btn_Fullscreen
  #Slider_Position
  #Slider_Volume
  #Container_Control
  #Timer_Update
EndEnumeration

Global vlcInst.i, media.i, player.i
Global filePath.s
Global skipSliderUpdate.i
Global fullscreenMode.i = #False
Global oldWinX, oldWinY, oldWinW, oldWinH

Declare ToggleFullscreen()
Declare ResizeUI()


; ==== Video laden und starten ====
Procedure LoadVideoFile(path.s)
  If FileSize(path) > 0
    If media  : libvlc_media_release(media) : EndIf
    If player : libvlc_media_player_release(player) : EndIf

    media = libvlc_media_new_path(vlcInst, path)
    player = libvlc_media_player_new_from_media(media)
    libvlc_media_player_set_hwnd(player, GadgetID(#VideoOutput))
    libvlc_media_player_play(player)
  EndIf
EndProcedure

Procedure LoadFile()
  filePath = OpenFileRequester("Video auswählen", "", "Videos (*.mp4;*.avi)|*.mp4;*.avi|Alle Dateien|*.*", 0)
  If filePath
    LoadVideoFile(filePath)
  EndIf
EndProcedure

Procedure PlayVideo()  : If player : libvlc_media_player_play(player) : EndIf : EndProcedure
Procedure PauseVideo() : If player : libvlc_media_player_pause(player) : EndIf : EndProcedure
Procedure StopVideo()  : If player : libvlc_media_player_stop(player) : EndIf : EndProcedure

Procedure TakeSnapshot()
  If player
    Define snapFile.s = "snapshot_" + FormatDate("%yyyymmdd_%hh%ii%ss", Date()) + ".png"
    libvlc_video_take_snapshot(player, 0, snapFile, 0, 0)
    MessageRequester("Snapshot", "Gespeichert: " + snapFile)
  EndIf
EndProcedure

Procedure UpdateSlider()
  If player And skipSliderUpdate = 0
    Define length.q = libvlc_media_player_get_length(player)
    Define pos.q    = libvlc_media_player_get_time(player)
    If length > 0
      SetGadgetState(#Slider_Position, pos * 100 / length)
    EndIf
  EndIf
EndProcedure

Procedure ChangePosition()
  If player
    skipSliderUpdate = 1
    Define length.q = libvlc_media_player_get_length(player)
    Define percent.f = GetGadgetState(#Slider_Position)
    Define targetTime.q = Round(percent * length / 100.0, #PB_Round_Nearest)
    libvlc_media_player_set_time(player, targetTime)
    skipSliderUpdate = 0
  EndIf
EndProcedure

Procedure ChangeVolume()
  If player
    Define volume = GetGadgetState(#Slider_Volume)
    libvlc_audio_set_volume(player, volume)
  EndIf
EndProcedure

Procedure ToggleFullscreen()
  Debug "ToggleFullscreen()"
  If fullscreenMode = #False
    oldWinX = WindowX(#MainWindow)
    oldWinY = WindowY(#MainWindow)
    oldWinW = WindowWidth(#MainWindow)
    oldWinH = WindowHeight(#MainWindow)
    
    if ExamineDesktops()
      ResizeWindow(#MainWindow, 0, 0, DesktopWidth(0), DesktopHeight(0))
    endif
    SetWindowState(#MainWindow, #PB_Window_Maximize)
    HideGadget(#Container_Control, #True)
    fullscreenMode = #True
  Else
    ResizeWindow(#MainWindow, oldWinX, oldWinY, oldWinW, oldWinH)
    SetWindowState(#MainWindow, #PB_Window_Normal)
    HideGadget(#Container_Control, #False)
    fullscreenMode = #False
  EndIf
  ResizeUI()
EndProcedure

Procedure ResizeUI()
  ResizeGadget(#VideoOutput, 10, 10, WindowWidth(#MainWindow)-20, WindowHeight(#MainWindow)-170)
  ResizeGadget(#Container_Control, 10, WindowHeight(#MainWindow)-150, WindowWidth(#MainWindow)-20, 140)
  ResizeGadget(#Slider_Position, 10, 50, GadgetWidth(#Container_Control)-20, 20)
EndProcedure

Procedure OpenMainWindow()
  vlcInst = libvlc_new(0, 0)

  If OpenWindow(#MainWindow, 0, 0, 800, 600, "VLC Powerplayer", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget )
    CanvasGadget(#VideoOutput, 10, 10, 780, 420, #PB_Canvas_Container)
    CloseGadgetList()

    ContainerGadget(#Container_Control, 10, 440, 780, 140)
      ButtonGadget(#Btn_Open,     10,  10, 110, 30, "📁 Datei öffnen")
      ButtonGadget(#Btn_Play,    130, 10,  80, 30, "▶ Play")
      ButtonGadget(#Btn_Pause,   220, 10,  80, 30, "⏸ Pause")
      ButtonGadget(#Btn_Stop,    310, 10,  80, 30, "⏹ Stop")
      ButtonGadget(#Btn_Snapshot,400, 10, 110, 30, "📸 Snapshot")
      ButtonGadget(#Btn_Fullscreen, 520, 10, 40, 30, "↕")

      TextGadget(#PB_Any,         10, 60, 100, 20, "⏯ Position:")
      TrackBarGadget(#Slider_Position, 120, 60, 650, 20, 0, 100)

      TextGadget(#PB_Any,         10, 90, 100, 20, "🔊 Lautstärke:")
      TrackBarGadget(#Slider_Volume, 120, 90, 200, 20, 0, 100)
      SetGadgetState(#Slider_Volume, 80)
    CloseGadgetList()

    BindGadgetEvent(#Slider_Position, @ChangePosition())
    BindGadgetEvent(#Slider_Volume, @ChangeVolume())

    EnableGadgetDrop(#VideoOutput, #PB_Drop_Files, #PB_Drag_Copy)

    AddWindowTimer(#MainWindow, #Timer_Update, 500)
    

    Repeat
      Select WaitWindowEvent()
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #Btn_Open    : LoadFile()
            Case #Btn_Play    : PlayVideo()
            Case #Btn_Pause   : PauseVideo()
            Case #Btn_Stop    : StopVideo()
            Case #Btn_Snapshot: TakeSnapshot()
            Case #Btn_Fullscreen : ToggleFullscreen()
          EndSelect

        Case #PB_Event_Timer
          If EventTimer() = #Timer_Update : UpdateSlider() : EndIf

        Case #PB_Event_SizeWindow
          ResizeUI()

        Case #PB_Event_Menu
          If EventMenu() = #PB_Shortcut_Escape And fullscreenMode
            ToggleFullscreen()
          EndIf

        Case #PB_Event_GadgetDrop
          If EventGadget() = #VideoOutput
            LoadVideoFile(EventDropFiles())
          EndIf

        Case #PB_Event_CloseWindow
          Break
      EndSelect
    ForEver
  EndIf

  If player : libvlc_media_player_release(player) : EndIf
  If media  : libvlc_media_release(media) : EndIf
  If vlcInst: libvlc_release(vlcInst)     : EndIf
EndProcedure

OpenMainWindow()

Mesa · Post by **Mesa** » Fri Mar 28, 2025 11:51 am

@Justin
Thank you.

M.

infratec · Post by **infratec** » Sat Mar 29, 2025 7:04 pm

@justin & @dige

If you use ImportC you can also use the x86 directory and PB x86

PureBasic Forums - English

Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control

Re: Windows Media Player Control