Trying to port a movie control i wrote some years ago from PowerBASIC to FreeBASIC i run into (maybe COM related) problems i don´t understand. Below is my sample code, which is reduced in size removing all unnecessary things but still demonstrating my problems. As it seems i cannot make use of attachments here, otherwise i would upload a sample movie ("hello.avi") as well. So you must use your own movie file for testing.
It wasn´t to hard to get it running in 32 bit and unicode defined. But if i don´t define unicode in 32 bit, the GraphBuilder object isn´t created, the app shows random behavior and sometimes crashes (in user32.dll or ntdll.dll). For 64 bit the GraphBuilder object is created regardless if unicode is defined or not, but the movie doesn´t run and the app doesn´t end gracefully, it gets stuck when releasing the objects in "resetmovie".
What am i doing wrong ?
Thanks
JK
BTW: The FreeBASIC sample code (examples\win32\COM\MoviePlayer) doesn´t compile, it throws a linker error i don´t understand, so no help either...
main file:
Code: Select all
'#compiler freebasic
'#COMPILE GUI EXE 32
CONST UNICODE = 1 '0
#include once "windows.bi"
#include once "win\commctrl.bi"
#ifdef unicode
#ifndef zstr 'zero terminated unicode string (* bytes)
#define zstr wstring
#endif
#ELSE
#ifndef zstr 'zero terminated ansi string (* bytes)
#define zstr zstring
#endif
#ENDIF
#INCLUDE ONCE "fb_movie2.inc"
declare function fb_main as uinteger
END FB_MAIN
'***********************************************************************************************
'***********************************************************************************************
FUNCTION WindowProc (BYVAL hWnd AS HWND, BYVAL wMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
'***********************************************************************************************
' Main window procedure
'***********************************************************************************************
DIM i AS LONG
dim icc as INITCOMMONCONTROLSEX
DIM ztext AS ZSTR * MAX_PATH
dim r AS tagrect
#ifdef unicode
dim szClassName AS wstring * 64
dim szCaption AS wstring * 64
#ELSE
dim szClassName AS zstring * 64
dim szCaption AS zstring * 64
#ENDIF
dim hwndc AS hwnd
dim wstyle AS DWORD
dim xstyle AS DWORD
STATIC hinst AS hmodule
SELECT CASE wMsg
CASE WM_CREATE 'creation of the main window
hinst = getmodulehandle(BYVAL 0)
icc.dwsize = sizeof(icc)
icc.dwicc = &HFFFF
initcommoncontrolsex(@icc)
movie_init
szClassName = "JK_Movie"
szCaption = "Movie 33"
wstyle = WS_CHILD OR WS_VISIBLE OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN OR MCS_FIXED_SIZE or WS_Border
xstyle = WS_EX_LEFT OR WS_EX_LTRREADING
hwndc = CreateWindowEx(xstyle, szClassName, szCaption, wstyle, 30, 25, 300, 300, hwnd, cast(hmenu, 100), hinst, BYVAL 0)
r.left = 450
r.right = r.left + 360
r.top = 260
r.bottom = r.top + 355
adjustwindowrectex @r, getwindowlongptr(hwnd, GWL_Style), 0, getwindowlongptr(hwnd, GWL_EXStyle)
setwindowpos hwnd, 0, 450, 260, (r.right - r.left), (r.bottom - r.top), SWP_NoZorder
ztext = "hello.avi"
sendmessage hwndc, MCM_Setmovie, 0, cast(wparam, varptr(ztext))
FUNCTION = 0 'success
EXIT FUNCTION
CASE WM_DESTROY 'exit - a good point for cleaning up
PostQuitMessage 0 'exit message loop in MAIN
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam) 'default processing
END FUNCTION
'***********************************************************************************************
FUNCTION FB_MAIN AS uinteger
'***********************************************************************************************
' Main Program entry point
'***********************************************************************************************
dim uMsg AS TAGMSG
dim hinst AS hmodule
dim wce AS WNDCLASSEX
dim szClassName AS ZSTR * 64
dim szCaption AS ZSTR * 64
dim hMenu AS hmenu
dim hwnd AS hwnd
dim wstyle AS DWORD
dim xstyle AS DWORD
hinst = GetModuleHandle(byval 0)
szClassName = "NEWTEST"
wce.cbSize = SIZEOF(wce)
wce.STYLE = CS_HREDRAW OR CS_VREDRAW 'or CS_DBLCLKS
wce.lpfnWndProc = procptr(WindowProc)
wce.hInstance = hInst
wce.hCursor = LoadCursor(NULL, BYVAL IDC_ARROW)
wce.hbrBackground = GetStockObject(WHITE_BRUSH)
wce.lpszClassName = @szClassName
RegisterClassEx @wce
szCaption = " New Layout"
wstyle = WS_POPUP OR WS_BORDER OR WS_DLGFRAME OR WS_SYSMENU OR WS_MAXIMIZEBOX OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN OR WS_VISIBLE OR WS_CAPTION
xstyle = WS_EX_WINDOWEDGE OR WS_EX_LEFT OR WS_EX_LTRREADING OR WS_EX_RIGHTSCROLLBAR
hwnd = CreateWindowEx(xstyle, szClassName, szCaption, wstyle, 0 ,0, 0, 0, hwnd, 0, hinst, byval 0)
ShowWindow hwnd, SW_SHOWDEFAULT 'show main window
UpdateWindow hwnd 'draw main window
DO WHILE GetMessage(@uMsg, BYVAL NULL, 0, 0) 'message loop
TranslateMessage @uMsg
DispatchMessage @uMsg
LOOP
FUNCTION = uMsg.wParam
END FUNCTION
'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************
control: (fb_movie.inc)
Code: Select all
'***********************************************************************************************
' works 32 bit + unicode
' fails 32 bit - unicode (fails to create graphbuilder)
' fails 64 bit + unicode (window + graphbuilder ok, but refuses to run video + fails to release objects)
' fails 64 bit - unicode (window + graphbuilder ok, but refuses to run video + fails to release objects)
'***********************************************************************************************
' (C) 2018 Juergen Kuehlwein
' This code is based on code found in José Rocas WinFBX and FreeBASIC examples mixed with own code.
' you may need to install additional codecs for viewing certain video formats
' like .mp4 - e.g ffdshow or k-lite codec pack
'***********************************************************************************************
' usage:
' movie_init
' ...
' CreateWindowEx(0, "JK_Movie", "", Ws_Child or WS_Visible, 10, 10, 60, 45, _
' hwnd, 1000, hinst, byval 0)
'
' restrictions:
'
' needs a manifest for proper drawing of control panel
'***********************************************************************************************
#IFNDEF JK_Movie_DEFINED
#define JK_Movie_DEFINED
const MCS_FIXED_SIZE = &H00000001
const MCS_FIXED_WIDTH = &H00000002
const MCS_FIXED_HEIGHT = &H00000004
const MCM_SetMovie = WM_User + 1000
const MCM_GetMovieSize = WM_USER + 1001
const MCM_Setstyle = WM_USER + 1002
const MCM_SetBkColor = WM_USER + 1003
const MCM_GetBkColor = WM_USER + 1004
const MCM_Run = WM_USER + 1005
const MCM_Pause = WM_USER + 1006
const MCM_Stop = WM_USER + 1007
const MCM_Controlpanel = WM_USER + 1008
'***********************************************************************************************
' movie adjustment: set style(s) at creation or send MCM_Setstyle, name = caption
' - no style -> fit control size to picture size without background, (keep position)
' + MCS_FIXED_HEIGHT - keep height adjust(expand/shrink) width of control to meet aspect ratio
' + MCS_FIXED_WIDTH - keep width adjust(expand/shrink) height of control to meet aspect ratio
' - both - don´t make control larger, shrink width/height to meet aspect ratio
' - none - original size
' - MCS_FIXED_SIZE -> fit picture to control size, keep aspect ratio, show background
' + PCS_FIXED_WIDTH - keep width/height of control, adjust movie to fit width/height
' + PCS_FIXED_HEIGHT
' - both - stretch to fit (don´t keep aspect ratio)
' - none - keep width/height of control, show picture in original size
' may not fit into control size, if larger. Show centered, if smaller)
'messages:
' MCM_Setmovie - lparam = new movie name, if 0 or "" -> clear movie
' MCM_Getmoviesize - return dx and dy (original movie size)
' MCM_SetBkColor - wparam = new backcolor, return old backcolor
' MCM_GetBkColor - return backcolor
' MCM_Setstyle - change style
' MCM_Run - run current movie
' MCM_Pause - pause movie
' MCM_Stop - stop movie
' MCM_Controlpanel - show/hide contol panel (wparam = 1/0)
'***********************************************************************************************
#include once "windows.bi"
#include once "win/uuids.bi"
#include once "win/strmif.bi"
#include once "win/evcode.bi"
#include once "win/control.bi"
'***********************************************************************************************
' Types/Unions
'*************************************************************************************************
TYPE movie_data
pIGraphBuilder AS IGraphBuilder PTR
pIMediaControl AS IMediaControl PTR
pIVideoWindow AS IVideoWindow ptr
pIMediaPosition AS IMediaPosition ptr
pIBasicAudio AS IBasicAudio PTR
orgdx AS DWORD 'original width of movie
orgdy AS DWORD 'original height of movie
mdx AS LONG 'width of movie
mdy AS LONG 'height of movie
x as long 'x pos of movie
y as long 'y pos ofmovie
bcolor as dword 'background color (RGB)
hbr as hbrush 'background brush
mflag as dword '1 = movie loaded
cflag as dword '1 = show controls
pflag as long '1 = movie is playing
END TYPE
'***********************************************************************************************
' personalized definitions to be independent of include files set (PB/José Roca)
'***********************************************************************************************
const JK_OATRUE = -1
const JK_OAFALSE = 0
const JK_VFW_S_PARTIAL_RENDER = &H00040242&
'$JK_CLSID_FilterGraph = GUID$("{E436EBB3-524F-11CE-9F53-0020AF0BA770}")
'$JK_IID_IBasicAudio = GUID$("{56A868B3-0AD4-11CE-B03A-0020AF0BA770}")
'$JK_IID_IMediaControl = GUID$("{56A868B1-0AD4-11CE-B03A-0020AF0BA770}")
'$JK_IID_IMediaPosition = GUID$("{56A868B2-0AD4-11CE-B03A-0020AF0BA770}")
'$JK_IID_IVideoWindow = GUID$("{56A868B4-0AD4-11CE-B03A-0020AF0BA770}")
'$JK_IID_IGraphBuilder = GUID$("{56A868A9-0AD4-11CE-B03A-0020AF0BA770}")
'
'
'***********************************************************************************************
' reset, load, size movie
'***********************************************************************************************
'***********************************************************************************************
sub resetmovie(c as movie_data ptr)
'***********************************************************************************************
' delete movie and clean up
'***********************************************************************************************
'ods("reset")
IF c->pIMediaControl THEN
'ods("reset1 " + str(c->pIMediaControl))
IMediaControl_Stop (c->pIMediaControl)
'ods("reset11 " + str(c->pIMediaControl))
IMediaControl_Release(c->pIMediaControl)
'ods("reset12 " + str(c->pIMediaControl))
c->pIMediaControl = NULL
end if
IF c->pIVideoWindow THEN
'ods("reset2 " + str(c->pIVideoWindow))
IVideoWindow_Put_Visible(c->pIVideoWindow, JK_OAFALSE)
IVideoWindow_Put_Owner (c->pIVideoWindow, Null)
IVideoWindow_Release(c->pIVideoWindow)
c->pIVideoWindow = NULL
end if
IF c->pIMediaPosition THEN
'ods("reset3 " + str(c->pIMediaPosition))
IMediaPosition_Release(c->pIMediaPosition)
c->pIMediaPosition = NULL
end if
IF c->pIBasicAudio THEN
'ods("reset4 " + str(c->pIBasicAudio))
IBasicAudio_Release(c->pIBasicAudio)
c->pIBasicAudio = NULL
end if
IF c->pIGraphBuilder THEN
'ods("reset5 " + str(c->pIGraphBuilder))
IGraphBuilder_Release(c->pIGraphBuilder)
'ods("reset51 " + str(c->pIGraphBuilder))
c->pIGraphBuilder = NULL
end if
'ods("reset6")
c->orgdx = 0 'original width of movie
c->orgdy = 0 'original height of movie
c->mdx = 0 'width of movie
c->mdy = 0 'height of movie
c->x = 0 'x pos of movie
c->y = 0 'y pos ofmovie
c->bcolor = 0 'background color (RGB)
c->hbr = 0 'background brush
c->mflag = 0 '1 = movie loaded
c->cflag = 0 '1 = show controls
c->pflag = 0 '1 = movie is playing
end sub
'***********************************************************************************************
sub loadmovie(hwnd as handle, c as movie_data ptr, ztext as zstr)
'***********************************************************************************************
' load movie from file
'***********************************************************************************************
DIM zext as ZSTR * 16
DIM wtext as wstring * MAX_PATH
DIM hr AS HRESULT
c->mflag = 0
if len(ztext) then
wtext = ztext
hr = IGraphBuilder_QueryInterface(c->pIGraphBuilder, @IID_IMediaControl, @c->pIMediaControl)
IF hr <> S_OK THEN
resetmovie(c)
exit sub
end if
hr = IGraphBuilder_QueryInterface(c->pIGraphBuilder, @IID_IVideoWindow, @c->pIVideoWindow)
IF hr <> S_OK THEN
resetmovie(c)
exit sub
end if
hr = IGraphBuilder_QueryInterface(c->pIGraphBuilder, @IID_IMediaPosition, @c->pIMediaPosition)
IF hr <> S_OK THEN
resetmovie(c)
exit sub
end if
hr = IGraphBuilder_QueryInterface(c->pIGraphBuilder, @IID_IBasicAudio, @c->pIBasicAudio)
IF hr <> S_OK THEN
resetmovie(c)
exit sub
end if
' hr = c->pIMediaControl->lpvtbl->RenderFile(pIMediaControl, @wszFileName)
' hr = IGraphBuilder _RenderFile(c->pIGraphBuilder, @wtext, NULL)
hr = IMediaControl_RenderFile(c->pIMediaControl, @wtext)
'ods("after load " + str(hr))
IF (hr <> S_OK) AND (hr <> JK_VFW_S_PARTIAL_RENDER) THEN
c->mflag = 0
else
c->mflag = 1
END IF
IVideoWindow_Put_Visible(c->pIVideoWindow, JK_OAFALSE)
IVideoWindow_Get_width(c->pIVideoWindow, @c->orgdx)
IVideoWindow_Get_height(c->pIVideoWindow, @c->orgdy)
IVideoWindow_Put_Owner(c->pIVideoWindow, cast(oahwnd, hwnd)) 'Set the window owner and style
IVideoWindow_Put_WindowStyle(c->pIVideoWindow, WS_CHILD) 'OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN
IBasicAudio_Put_Volume(c->pIBasicAudio, -2000)
IVideoWindow_Put_MessageDrain(c->pIVideoWindow, cast(oahwnd, hwnd))
else
loadfail:
'ods("loadfail")
end if
end sub
'***********************************************************************************************
sub sizemovie(hwnd as handle, c as movie_data ptr, r as rect, rc as rect)
'***********************************************************************************************
' size movie according to style settings
'***********************************************************************************************
DIM wstyle as UINTEGER
DIM xstyle as UINTEGER
DIM fixedsize as UINTEGER
DIM wflag as UINTEGER
DIM hflag as UINTEGER
DIM cx AS uinteger 'x
DIM cy AS uinteger 'y
DIM p AS uinteger 'percentage
DIM w AS uinteger 'width
DIM h AS uinteger 'height
wstyle = GetWindowLongPtr(hwnd, GWL_Style) 'get style
xstyle = GetWindowLongPtr(hwnd, GWL_ExStyle) 'get extended style
fixedsize = ((wstyle and MCS_FIXED_SIZE) = MCS_FIXED_SIZE)
wflag = ((wstyle and MCS_FIXED_WIDTH) = MCS_FIXED_WIDTH)
hflag = ((wstyle and MCS_FIXED_HEIGHT) = MCS_FIXED_HEIGHT)
IF fixedsize then 'MCS_FIXED_SIZE style
r = rc
IF (wflag = 0) and (hflag = 0) then 'original size
IF c->orgdx < (rc.Right - rc.Left) THEN 'if image width is smaller than control
cx = ((rc.Right - rc.Left) - c->orgdx) / 2 'center it (otherwise cut)
END IF
IF c->orgdy + c->cflag * 50 < (rc.Bottom - rc.Top) THEN 'if image height is smaller than control
cy = ((rc.Bottom - rc.Top) - c->orgdy - c->cflag * 50) / 2 'center it (otherwise cut)
END IF
c->mdx = c->orgdx
c->mdy = c->orgdy
c->x = cx
c->y = cy
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEIF (wflag > 0) and (hflag > 0) THEN 'stretch/shrink to client area
c->mdx = rc.Right - rc.Left
c->mdy = rc.Bottom - rc.Top - c->cflag * 50
c->x = 0
c->y = 0
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEIF wflag > 0 THEN 'keep width, adjust height, keep aspect ratio
adjustheight:
if c->orgdx <> rc.Right - rc.Left then
p = ((rc.Right - rc.Left) * 100) / c->orgdx
w = rc.Right - rc.Left
h = c->orgdy * p / 100 + c->cflag * 50
else
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
IF h > (rc.Bottom - rc.Top) THEN goto adjustwidth 'doesn´t fit -> must change width
IF h < (rc.Bottom - rc.Top) THEN
cy = ((rc.Bottom - rc.Top) - h) / 2
END IF
c->mdx = w
c->mdy = h - c->cflag * 50
c->x = 0
c->y = cy
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEif hflag > 0 then 'keep height, adjust width, keep aspect ratio
adjustwidth:
IF c->orgdy + c->cflag * 50 <> rc.Bottom - rc.Top THEN
p = ((rc.Bottom - rc.Top - c->cflag * 50) * 100) / c->orgdy
h = rc.Bottom - rc.Top
w = c->orgdx * p / 100
ELSE
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
IF w > (rc.Right - rc.Left) THEN goto adjustheight 'doesn´t fit -> must change height
IF w < (rc.Right - rc.Left) THEN
cx = ((rc.Right - rc.Left) - w) / 2
END IF
c->mdx = w
c->mdy = h - c->cflag * 50
c->x = cx
c->y = 0
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
END IF
else 'autosize control
IF (wflag = 0) and (hflag = 0) then 'original size
setrect @r, 0, 0, c->orgdx, c->orgdy + c->cflag * 50
if ((c->orgdx = rc.right - rc.left) and (c->orgdy + c->cflag * 50 = rc.bottom - rc.top)) then goto exitnewsize
c->mdx = c->orgdx
c->mdy = c->orgdy
c->x = cx
c->y = cy
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEIF (wflag > 0) and (hflag > 0) THEN 'fit into client area
if c->orgdx <> rc.Right - rc.Left then
p = ((rc.Right - rc.Left) * 100) / c->orgdx
w = rc.Right - rc.Left
h = c->orgdy * p / 100 + c->cflag * 50
else
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
IF h > (rc.Bottom - rc.Top) + c->cflag * 50 THEN
IF c->orgdy + c->cflag * 50 <> rc.Bottom - rc.Top THEN
p = ((rc.Bottom - rc.Top) * 100) / c->orgdy
h = rc.Bottom - rc.Top + c->cflag * 50
w = c->orgdx * p / 100
ELSE
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
end if
setrect @r, 0, 0, w, h
if ((w = rc.right - rc.left) and (h = rc.bottom - rc.top)) then goto exitnewsize
c->mdx = w
c->mdy = h - c->cflag * 50
c->x = 0
c->y = 0
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEIF wflag > 0 THEN 'keep width, adjust height, keep aspect ratio
if c->orgdx <> rc.Right - rc.Left then
p = ((rc.Right - rc.Left) * 100) / c->orgdx
w = rc.Right - rc.Left
h = c->orgdy * p / 100 + c->cflag * 50
else
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
setrect @r, 0, 0, w, h
if ((w = rc.right - rc.left) and (h = rc.bottom - rc.top)) then goto exitnewsize
c->mdx = w
c->mdy = h - c->cflag * 50
c->x = 0
c->y = 0
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
ELSEif hflag > 0 then 'keep height, adjust width, keep aspect ratio
IF c->orgdy + c->cflag * 50 <> rc.Bottom - rc.Top THEN
p = ((rc.Bottom - rc.Top - c->cflag * 50) * 100) / c->orgdy
h = rc.Bottom - rc.Top
w = c->orgdx * p / 100
ELSE
h = c->orgdy + c->cflag * 50
w = c->orgdx
END IF
setrect @r, 0, 0, w, h
if ((w = rc.right - rc.left) and (h = rc.bottom - rc.top)) then goto exitnewsize
c->mdx = w
c->mdy = h - c->cflag * 50
c->x = 0
c->y = 0
IVideoWindow_SetWindowPosition(c->pIVideoWindow, c->x, c->y, c->mdx, c->mdy) 'set the window position
END IF
end if
exitnewsize:
end sub
'***********************************************************************************************
FUNCTION MovieProc(BYVAL hwnd AS handle, BYVAL wMsg AS UINT, BYVAL wParam AS wparam, BYVAL lParam AS lparam) AS Lresult
'*************************************************************************************************
' movie control callback
'*************************************************************************************************
DIM x AS dword
DIM hdc AS hdc 'device context handle
DIM c AS movie_data PTR 'pointer to control data
DIM ps AS PAINTSTRUCT 'PAINTSTRUCT structure
DIM ztext as ZSTR * MAX_PATH
DIM pn as ZSTR ptr
DIM hbr as hbrush 'brush
DIM wstyle as dword
DIM cx AS LONG 'x
DIM cy AS LONG 'y
DIM rc AS RECT 'client area
DIM r AS RECT 'window rect
DIM hinst as hmodule
DIM wndpos as windowpos ptr
dim hr as hresult
SELECT CASE wMsg
CASE WM_CREATE
hinst = getmodulehandle(byval 0)
c = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, SIZEOF(@c)) 'allocate memory for data
wstyle = GetWindowLongPtr(hwnd, GWL_Style) 'get style
wstyle = wstyle or WS_Clipchildren or WS_Clipsiblings or WS_Child 'ensure these styles
setWindowLongPtr hwnd, GWL_Style, wstyle
IF c THEN
SetWindowLongPtr hwnd, 0, cast(uinteger, c) 'save data pointer
DIM hr AS HRESULT
hr = coinitialize(0)
'ods("coinit hr: " + str(hr))
'***********************************************************************************************
c->pIGraphBuilder = 0
c->pIMediaControl = 0
c->pIVideoWindow = 0
c->pIMediaPosition = 0
c->pIBasicAudio = 0
c->orgdx = 0
c->orgdy = 0
c->mdx = 0
c->mdy = 0
c->x = 0
c->y = 0
c->bcolor = 0
c->hbr = 0
c->mflag = 0
c->cflag = 0
c->pflag = 0
'***********************************************************************************************
ELSE
FUNCTION = -1 'abort
END IF
EXIT FUNCTION
CASE WM_windowposchanging 'without MCS_Fixedsize, the controls sizes itself to keep
wndpos = cast(windowpos ptr, lparam) 'aspect, therefore calculate the correct size here before
'setting this size (reduces flicker)
c = cast(movie_data ptr, GetWindowLongPtr(hwnd, 0)) 'get pointer to control data
if c then
rc.left = wndpos->x 'get current size
rc.top = wndpos->y
rc.right = wndpos->x + wndpos->cx
rc.bottom = wndpos->y + wndpos->cy
IF c then
if c->mflag then 'if a movie is loaded
if (wndpos->cx <> 0) and (wndpos->cy <> 0) then
sizemovie(hwnd, c, r, rc) 'calculate
wndpos->cx = r.right - r.left 'set (new) size
wndpos->cy = r.bottom - r.top
end if
end if
end if
end if
exit function
'***********************************************************************************************
' control specific messages
'***********************************************************************************************
case MCM_SetMovie 'load and run new movie
c = cast(movie_data ptr, GetWindowLongPtr(hwnd, 0)) 'get pointer to control data
IF c THEN
killtimer hwnd, 111
IF c->pIMediaControl <> 0 THEN
IMediaControl_Stop(c->pIMediaControl) 'stop video
end if
pn = cast(zstr ptr, lparam)
'ods("pn: " +str(pn))
if pn = 0 then
goto do_exit
end if
ztext = *pn
'ods(ztext)
if len(ztext) = 0 then 'if = "" -> reset
'ods("do_exit")
do_exit:
resetmovie(c)
InvalidateRect hwnd, BYVAL NULL, 0 'redraw after loading
UpdateWindow hwnd
exit function
end if
x = c->cflag
resetmovie(c)
c->cflag = x 'keep control panel setting
hr = CoCreateInstance(@CLSID_FilterGraph, NULL, CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, cast(PVOID ptr, @c->pIGraphBuilder))
'ods("create graphbuilder hr " + str(hr))
IF hr <> S_OK THEN
c->pIGraphBuilder = 0
EXIT FUNCTION
end if
loadmovie(hwnd, c, ztext) 'load new movie
'ods("mflag: " + str(c->mflag))
if c->mflag then
getclientrect hwnd, @rc
sizemovie(hwnd, c, r, rc) 'calculate
setwindowpos hwnd, 0, 0, 0, r.right - r.left, r.bottom - r.top, SWP_NoZorder or SWP_NoMove
hr = IVideoWindow_put_Visible(c->pIVideoWindow, JK_OATRUE) 'make it visible
'ods("hr show " + str(hr))
hr = IMediaControl_Run(c->pIMediaControl) 'run movie
'ods("hr run " + str(hr))
end if
c->pflag = 1 'set playflag to "play"
InvalidateRect hwnd, BYVAL NULL, 0 'redraw after loading
UpdateWindow hwnd
function = -1 'return success
end if
exit function
CASE WM_PRINTCLIENT
c = cast(movie_data ptr, GetWindowLongPtr(hwnd, 0)) 'get pointer to control data
hdc = cast(hdc, wParam)
GetClientRect hwnd, @rc 'always draw entire client area
fillrect hdc, @rc, c->hbr
EXIT FUNCTION
CASE WM_PAINT
c = cast(movie_data ptr, GetWindowLongPtr(hwnd, 0)) 'get pointer to control data
'ods("draw")
hdc = BeginPaint(hwnd, @ps)
GetClientRect hwnd, @rc 'always draw entire client area
fillrect hdc, @rc, c->hbr
EndPaint hwnd, @ps
EXIT FUNCTION
CASE WM_ENABLE
InvalidateRect hwnd, BYVAL NULL, 0 'Redraws the control
UpdateWindow hwnd
EXIT FUNCTION
CASE WM_ERASEBKGND
FUNCTION = 1 'don't let DefWindowProc erase background
EXIT FUNCTION '(this avoids flicker)
CASE WM_DESTROY
c = cast(movie_data ptr, GetWindowLongPtr(hwnd, 0)) 'get pointer to control data
killtimer hwnd, 111 'stop updating
IF c then
resetmovie(c) 'clean up
deleteobject c->hbr
HeapFree(GetProcessHeap(), 0, BYVAL c) 'free memory used for data
SetWindowLongPtr hwnd, 0, 0 'reset data pointer
end if
couninitialize
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam) 'default processing
end function
'***********************************************************************************************
FUNCTION Movie_init as long
'***********************************************************************************************
' register class
'***********************************************************************************************
DIM wce AS WNDCLASSEX 'WNDCLASSEX structure
DIM szClassName AS ZSTR * 32
szClassName = "JK_Movie"
wce.cbSize = SIZEOF(wce)
wce.style = CS_HREDRAW OR CS_VREDRAW ' OR CS_GLOBALCLASS
wce.lpfnWndProc = cast(wndproc, procptr(MovieProc))
wce.cbWndExtra = 8 'pointer to movie_data structure
wce.hInstance = GetModuleHandle(BYVAL NULL)
wce.hbrBackground = GetStockObject(WHITE_BRUSH)
wce.hCursor = LoadCursor(NULL, BYVAL IDC_ARROW)
wce.lpszClassName = VARPTR(szClassName)
function = RegisterClassEx(@wce)
END FUNCTION
#ENDIF
'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************