! This software MMPLAYER.F90 is part of the Visual Fortran kit.
! 
! This software is provided as an example that demonstrates a particular
! feature/function of the licensed product. The software is not intended to
! provide a complete solution to any application problem but rather is provided
! as a teaching mechanism.
! 
! Users may incorporate any part of this sample into their own source after 
! making appropriate changes to make it suitable for the intended application.
!
! This sample program demonstrates a Dialog-based Fortran Windows application 
! using the Visual Fortran Dialog Procedures.  It uses an ActiveMovie
! control in the main window of the application.  The ActiveMovie control
! is installed with Internet Explorer.  If Internet Explorer is not installed,
! this sample will not run.
!
! The basic structure of this application was generated using the Fortran
! Windows Application project wizard.
!
!  FUNCTIONS:
!   WinMain()      - Entry point for the application;
!                    displays the main window; processes the message loop
!   mmplayerSub()  - Callback routine for the main dialog box
!   mmplayerOpen() - Callback routine for the Open button
!   mmplayerAbout()- Callback routine for the About button
!   mmplayerChangeSize() - Positions the controls in the dialog box
!   mmplayerResize() - Resizes the dialog box
!   ActiveMovie_StateChange() - Event handler called when the current
!                    state of the movie has changed
!   ActiveMovie_ReadyStateChange() - Event handler called when the 
!                    property of the ActiveMovie Control has changed
!   PadStrFor()    - Pads out a null terminated string (C string to F90 string)
!

!****************************************************************************
!
!  FUNCTION: WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!
!  PURPOSE:  Entry point for the application
!
!  COMMENTS: Displays the main window and processes the message loop
!
!****************************************************************************

integer*4 function WinMain( hInstance, hPrevInstance, lpszCmdLine, nCmdShow )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_WinMain@16' :: WinMain
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'WinMain' :: WinMain
!DEC$ ENDIF

    use dfwin
    use dflogm
    use dfcom
    use dfauto
    use mmplayerGlobals
	use activemovie

    implicit none

    integer*4 hInstance
    integer*4 hPrevInstance
    integer*4 lpszCmdLine
    integer*4 nCmdShow

    include 'resource.fd'

    external mmplayerSub
    external mmplayerOpen
    external mmplayerAbout
    external mmplayerChangeSize
	external ActiveMovie_StateChange
	!DEC$ ATTRIBUTES STDCALL :: ActiveMovie_StateChange
	external ActiveMovie_ReadyStateChange
	!DEC$ ATTRIBUTES STDCALL :: ActiveMovie_ReadyStateChange

    ! Variables
    type (T_MSG)            mesg
    integer*4               ret
    logical*4               lret


    ghInstance = hInstance
    ghModule = GetModuleHandle(NULL)
    call COMINITIALIZE(ret)

    ! Initialize the dialog box
    lret = DlgInit(IDD_MMPLAYER_DIALOG, gdlg)
    if (lret == .FALSE.) goto 99999
    ! Set up callbacks so that we get control when the dialog box is
    ! created, destroyed, and changes size
    lret = DlgSetSub(gdlg, IDD_MMPLAYER_DIALOG, mmplayerSub)
    lret = DlgSetSub(gdlg, IDD_MMPLAYER_DIALOG, mmplayerChangeSize, &
					 dlg_sizechange)
    ! Set up dialog callbacks for the buttons
    lret = DlgSetSub(gdlg, IDM_OPEN, mmplayerOpen)
    lret = DlgSetSub(gdlg, IDM_ABOUT, mmplayerAbout)
    ! Set up event handlers for certain events that the ActiveMovie
    ! control reports.  The interfaces for these handlers are defined in
    ! the ACTIVEMOVIE.F90 file, that is generated using the Fortran Module 
	! Wizard
    ret = DlgSetCtrlEventHandler(gdlg, IDC_ACTIVEMOVIECONTROL1, &
        ActiveMovie_StateChange, 1, IID_DActiveMovieEvents2)
    ret = DlgSetCtrlEventHandler(gdlg, IDC_ACTIVEMOVIECONTROL1, &
		ActiveMovie_ReadyStateChange, -609, IID_DActiveMovieEvents2)
    ! Display the dialog box (the application's main window)
    lret = DlgModeless(gdlg, nCmdShow)
    if (lret == .FALSE.) goto 99999

    ! Read and process messsages
    do while( GetMessage (mesg, NULL, 0, 0) ) 
       if ( DlgIsDlgMessage(mesg) .EQV. .FALSE. ) then
           lret = TranslateMessage( mesg )
           ret  = DispatchMessage( mesg )
       end if
    end do

    ! Clean up
    call DlgUninit(gdlg)
    call COMUNINITIALIZE()

    WinMain = mesg.wParam
    return

99999 &

    ret = MessageBox(ghwndMain, "Error initializing application mmplayer"C, &
                     "Error"C, MB_OK)
    call COMUNINITIALIZE()
    WinMain = 0

end 

!****************************************************************************
!
!  FUNCTION: mmplayerSub ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for initialization and destroy
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE mmplayerSub( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: mmplayerSub

    use dfwin
    use dflogm
    use dfcom
    use dfauto

    implicit none

    type (dialog) dlg
    integer id, callbacktype

    include 'resource.fd'

    integer obj, iret
    logical lret

    if (callbacktype == dlg_destroy) then
		!  Reset the filename to "" to "close" the current file
        lret = DlgGet(dlg, IDC_ACTIVEMOVIECONTROL1, obj)
        iret = AUTOSETPROPERTY(obj, "FileName", "")
        call PostQuitMessage(0)
    endif

END SUBROUTINE mmplayerSub

!****************************************************************************
!
!  FUNCTION: mmplayerOpen ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for Open button
!
!  COMMENTS: Displays the standard file open dialog box and sets the
!            filename property of the ActiveMovie control
!
!****************************************************************************

SUBROUTINE mmplayerOpen( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: mmplayerOpen

    use dfwin
    use dflogm
    use dfcom
    use dfauto

    implicit none

    type (dialog) dlg
    integer id, callbacktype

    include 'resource.fd'

    type(T_OPENFILENAME) fileinfo
    character * MAX_PATH filename
    character * MAX_PATH filefilter
    integer obj, iret
    logical lret

    if (callbacktype == dlg_clicked) then
        ! Display a file open dialog box to allow the user to choose the
        ! multimedia file to play
        fileinfo % lStructSize = sizeof(fileinfo)
        fileinfo % hwndOwner = dlg % hwnd
        fileinfo % hInstance = 0
		iret = lstrcpy(filefilter, &
			"All files (*.*)|*.*|&
			DirectShow files (*.mpg;*.mpa;*.mpv;*.mov;*.mpeg;*.enc;*.m1v;*.mp2)|&
			*.mpg;*.mpa;*.mpv;*.mov;*.mpeg;*.enc;*.m1v;*.mp2|&
			Audio files (.wav)|*.wav|&
			Video for Windows files (.avi)|*.avi||"C)
		call convertfilterstring(filefilter)
        fileinfo % lpstrFilter = loc(filefilter)
        fileinfo % lpstrCustomFilter = 0
        fileinfo % nMaxCustFilter = 0
        fileinfo % nFilterIndex = 0
        filename = ""C
        fileinfo % lpstrFile = loc(filename)
        fileinfo % nMaxFile = MAX_PATH
        fileinfo % lpstrFileTitle = 0
        fileinfo % nMaxFileTitle = 0
        fileinfo % lpstrInitialDir = 0
        fileinfo % lpstrTitle = 0
        fileinfo % Flags = OFN_HIDEREADONLY
        fileinfo % nFileOffset = 0
        fileinfo % nFileExtension = 0
        fileinfo % lpstrDefExt = 0
        fileinfo % lCustData = 0
        fileinfo % lpfnHook = 0
        fileinfo % lpTemplateName = 0

        lret = GetOpenFileName(fileinfo)
        if (lret .ne. 0) then
            ! Set the "Filename" property of the control
			! Note that the open of the multimedia file is initiated by 
			! setting the filename, but the player is not ready until the
			! ActiveMovie_ReadyStateChange event handler is called
			! with a ready state of amvComplete.
            lret = DlgGet(dlg, IDC_ACTIVEMOVIECONTROL1, obj)
            CALL PadStrFor(filename)
            iret = AUTOSETPROPERTY(obj, "FileName", filename)
			! Set the label with the filename
			lret = DlgSet(dlg, IDC_FILENAME, filename)
        endif
    endif

END SUBROUTINE mmplayerOpen

!****************************************************************************
!
!  FUNCTION: mmplayerAbout ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for About button
!
!  COMMENTS: Calls the ActiveMovie control AboutBox method
!
!****************************************************************************

SUBROUTINE mmplayerAbout( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: mmplayerAbout

    use dfwin
    use dflogm
	use activemovie

    implicit none

    type (dialog) dlg
    integer id, callbacktype

    include 'resource.fd'

    integer obj, iret
    logical lret

    if (callbacktype == dlg_clicked) then
        ! Get the "object pointer" (IDispatch*) of the control
        lret = DlgGet(dlg, IDC_ACTIVEMOVIECONTROL1, obj)
		call IActiveMovie_AboutBox(obj, iret)
    endif

END SUBROUTINE mmplayerAbout

!****************************************************************************
!
!  FUNCTION: mmplayerChangeSize ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for dialog size change
!
!  COMMENTS: Positions the dialog box controls
!            based on the size of the ActiveMovie control.
!
!****************************************************************************

SUBROUTINE mmplayerChangeSize( dlg, id, callbacktype )
!DEC$ ATTRIBUTES DEFAULT :: mmplayerChangeSize

    use dfwin
    use dflogm
	use dfcom
	use dfauto

    implicit none

    type (dialog) dlg
	integer id, callbacktype

    include 'resource.fd'

    integer iret
    integer amWidth, amHeight
	logical lret
	integer spacex, spacey
	integer borderx, bordery, titley
	integer buttonw, buttonh, labelh
	integer dialogx, dialogy, dialogh, dialogw
	integer x, y, w, h, bx
	integer hwndControl
	type (T_RECT) rect

    ! First get the size of the buttons on the title bar - we use this for spacing
    spacex = GetSystemMetrics(SM_CXSIZE) * 3 / 4
    spacey = GetSystemMetrics(SM_CYSIZE) * 3 / 4
    ! Get other sizes
	borderx = GetSystemMetrics(SM_CXBORDER)
    bordery = GetSystemMetrics(SM_CYBORDER)
    titley = GetSystemMetrics(SM_CYSIZE)

    ! Get the size of the dialog box
    lret = GetWindowRect(dlg%hwnd, rect)
	dialogx = rect % left
	dialogy = rect % top
    lret = GetClientRect(dlg%hwnd, rect)
    dialogw = rect % right - rect % left
    dialogh = rect % bottom - rect % top

    ! Get the dimensions of the Open button - this will be the size of all buttons
    hwndControl = GetDlgItem( dlg%hwnd, IDM_OPEN )
    lret = GetWindowRect(hwndControl, rect)
    buttonw = rect % right - rect % left
    buttonh = rect % bottom - rect % top
	bx = dialogw - borderx - spacex - buttonw

    ! Position the buttons
    ! Open Button
    hwndControl = GetDlgItem( dlg%hwnd, IDM_OPEN )
    y = spacey
    lret = MoveWindow(hwndControl, bx, y, buttonw, buttonh, .TRUE.)

    ! About Button
    hwndControl = GetDlgItem( dlg%hwnd, IDM_ABOUT )
    y = (2*spacey) + buttonh
    lret = MoveWindow(hwndControl, bx, y, buttonw, buttonh, .TRUE.)

    ! Exit Button
    hwndControl = GetDlgItem( dlg%hwnd, IDM_EXIT )
    y = dialogh - (spacey + buttonh)
    lret = MoveWindow(hwndControl, bx, y, buttonw, buttonh, .TRUE.)

    ! Position the Label controls
    hwndControl = GetDlgItem( dlg%hwnd, IDC_LABEL )
    lret = GetWindowRect(hwndControl, rect)
    labelh = rect % bottom - rect % top
	x = rect % left - (dialogx + borderx)
    y = dialogh - (spacey + labelh)
    w = rect % right - rect % left
    h = rect % bottom - rect % top
    lret = MoveWindow(hwndControl, x, y, w, h, .TRUE.)
    hwndControl = GetDlgItem( dlg%hwnd, IDC_FILENAME )
    lret = GetWindowRect(hwndControl, rect)
    labelh = rect % bottom - rect % top
	x = rect % left - (dialogx + borderx)
    y = dialogh - (spacey + labelh)
    w = rect % right - rect % left
    h = rect % bottom - rect % top
    lret = MoveWindow(hwndControl, x, y, w, h, .TRUE.)

    ! Position the ActiveMovie control
    hwndControl = GetDlgItem( dlg%hwnd, IDC_ACTIVEMOVIECONTROL1 )
    lret = GetWindowRect(hwndControl, rect)
    amWidth = rect % right - rect % left
    amHeight = rect % bottom - rect % top
    lret = MoveWindow(hwndControl, spacex, spacey, amWidth, amHeight, &
					.TRUE.)


END SUBROUTINE mmplayerChangeSize

!****************************************************************************
!
!  FUNCTION: mmplayerResize ( dlg )
!
!  PURPOSE:  Resizes the dialog box
!
!  COMMENTS: Resizes the dialog box based on the size of the ActiveMovie 
!            control.  The ActiveMovie control resizes itself based upon the 
!            requirements of the current multimedia file.
!
!****************************************************************************

SUBROUTINE mmplayerResize( dlg )

    use dfwin
    use dflogm
	use dfcom
	use dfauto

    implicit none

    type (dialog) dlg

    include 'resource.fd'

	logical lret
    integer iret, uFlags
    integer amWidth, amHeight
	integer spacex, spacey
	integer borderx, bordery, titley
	integer buttonw, buttonh, labelh
	integer mindlgh, dlgh, dlgw
	integer hwndControl
	type (T_RECT) rect

    ! Resize the dialog box to match the dimensions of the 
    ! chosen multimedia file
    hwndControl = GetDlgItem( dlg%hwnd, IDC_ACTIVEMOVIECONTROL1 )
    lret = GetWindowRect(hwndControl, rect)
    amWidth = rect % right - rect % left
    amHeight = rect % bottom - rect % top

	! Determine the needed width and height of the dialog box
    ! First get the size of the buttons on the title bar - we use this for spacing
    spacex = GetSystemMetrics(SM_CXSIZE) * 3 / 4
    spacey = GetSystemMetrics(SM_CYSIZE) * 3 / 4
    ! Get other sizes
    borderx = GetSystemMetrics(SM_CXBORDER)
    bordery = GetSystemMetrics(SM_CYBORDER)
    titley = GetSystemMetrics(SM_CYSIZE)

    ! Get the dimensions of the Open button - this will be the size of all buttons
    hwndControl = GetDlgItem( dlg%hwnd, IDM_OPEN )
    lret = GetWindowRect(hwndControl, rect)
    buttonw = rect % right - rect % left
    buttonh = rect % bottom - rect % top

    ! Get the dimensions of the filename label
    hwndControl = GetDlgItem( dlg%hwnd, IDC_FILENAME )
    lret = GetWindowRect(hwndControl, rect)
    labelh = rect % bottom - rect % top

	! The minimum height is 3 buttons + 4 spacing + title bar + borders
	mindlgh = (3*buttonh) + (4*spacey) + titley + (2*bordery)

	! The height based on the ActiveMovie control is 
	! control + label + 3 spacing + title bar + borders
	dlgh = amHeight + labelh + (3*spacey) + titley + (2*bordery) 
	if (dlgh < mindlgh) dlgh = mindlgh

	! The width is control + button + 3 spacing + borders
	dlgw = amWidth + buttonw + (3*spacex) + (2*borderx) 

	! Change the size of the dialog box - 
	! mmplayerChangeSize will reposition the controls
    uFlags = SWP_NOACTIVATE .OR. SWP_NOOWNERZORDER .OR. SWP_NOMOVE
    lret = SetWindowPos(            &
          dlg % hWnd,               &   ! handle to window
          HWND_TOP,                 &   ! placement-order handle
          0,                        &   ! horizontal position
          0,                        &   ! vertical position
          dlgw,                     &   ! width
          dlgh,                     &   ! height
          uFlags )                      ! window-positioning flags);

END SUBROUTINE mmplayerResize

!****************************************************************************
!
!  FUNCTION: ActiveMovie_StateChange($OBJECT, oldState, newState)
!
!  PURPOSE:  Event handler called when the current state of the movie has 
!            changed
!
!  COMMENTS: Enables/Disables the buttons
!
!****************************************************************************

SUBROUTINE ActiveMovie_StateChange($OBJECT, oldState, newState)
    use dflogm
    use mmplayerGlobals
    use activemovie

    implicit none

    INTEGER*4, INTENT(IN)   :: $OBJECT   ! Object Pointer
    !DEC$ ATTRIBUTES VALUE  :: $OBJECT
    INTEGER*4   :: oldState 
    !DEC$ ATTRIBUTES VALUE  :: oldState
    INTEGER*4   :: newState 
    !DEC$ ATTRIBUTES VALUE  :: newState
	!DEC$ ATTRIBUTES STDCALL :: ActiveMovie_StateChange

    include 'resource.fd'

    logical lret

	if (newState == amvRunning) then
	    lret = DlgSet(gdlg, IDM_OPEN, .FALSE.)
	    lret = DlgSet(gdlg, IDM_ABOUT, .FALSE.)
	    lret = DlgSet(gdlg, IDM_EXIT, .FALSE.)
	else
	    lret = DlgSet(gdlg, IDM_OPEN, .TRUE.)
	    lret = DlgSet(gdlg, IDM_ABOUT, .TRUE.)
	    lret = DlgSet(gdlg, IDM_EXIT, .TRUE.)
	endif
END SUBROUTINE ActiveMovie_StateChange

!****************************************************************************
!
!  FUNCTION: ActiveMovie_ReadyStateChange($OBJECT, ReadyState)
!
!  PURPOSE:  Event handler called when the property of the ActiveMovie Control
!            has changed
!
!  COMMENTS: Resize the dialog box based upon the control size
!
!****************************************************************************

SUBROUTINE ActiveMovie_ReadyStateChange($OBJECT, ReadyState)
    use mmplayerGlobals
	use activemovie

    implicit none

	INTEGER*4, INTENT(IN)	:: $OBJECT	 ! Object Pointer
	!DEC$ ATTRIBUTES VALUE	:: $OBJECT
	INTEGER*4	:: ReadyState	! Void
	!DEC$ ATTRIBUTES VALUE	:: ReadyState
	!DEC$ ATTRIBUTES STDCALL :: ActiveMovie_ReadyStateChange

	if (ReadyState == amvComplete) then
		!  At this point, the control has loaded a file and changed its
		!  size based upon the requirements of the file
		call mmplayerResize(gdlg)
	end if
END SUBROUTINE ActiveMovie_ReadyStateChange

!****************************************************************************
!  PadStrFor
!
!  Pads out a null terminated string (C string to F90 string)
!****************************************************************************
  recursive subroutine PadStrFor( str )
!DEC$ ATTRIBUTES DEFAULT :: PadStrFor
  character*(*), intent(inout) :: str
    integer i
    ! scan up to the terminating null
    i = 1
    do while( i .le. len(str) .and. str(i:i) .ne. char(0) )
      i = i + 1
    end do
    ! pad the rest with blanks
    do while( i .le. len(str) )
      str(i:i) = ' '
      i = i + 1
    end do
  end subroutine PadStrFor
