!  VFAdder.f90 
!
!  FUNCTIONS:
!   WinMain()      - Entry point for the application;
!                    displays the main window; processes the message loop
!   VFAdderSub()  - Callback routine for the main dialog box
!   VFAdderAdd()  - Callback routine for the Add button
!   VFAdderClear()- Callback routine for the Clear button
!

!****************************************************************************
!
!  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 user32
    use kernel32
    use dflogm
    use dfcom
    use dfauto
    use VFAdderGlobals
    use AddingMachine

    implicit none

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

    include 'resource.fd'

    external VFAdderSub
    external VFAdderAdd
    external VFAdderClear

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

    ! Initialize
    ghInstance = hInstance
    ghModule = GetModuleHandle(NULL)
    ghwndMain = NULL
    gAddingMachine = NULL
    call COMINITIALIZE(ret)
    call COMCREATEOBJECTBYGUID (CLSID_AddingMachine, CLSCTX_ALL, IID_IAdd, gAddingMachine, status)
    call Check_Status(status, " Unable to create AddingMachine object")

    lret = DlgInit(IDD_VFADDER_DIALOG, gdlg)
    if (lret == .FALSE.) goto 99999
    lret = DlgSetSub(gdlg, IDD_VFADDER_DIALOG, VFAdderSub)
    lret = DlgSetSub(gdlg, IDC_ADD, VFAdderAdd)
    lret = DlgSetSub(gdlg, IDC_CLEAR, VFAdderClear)
    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)
    if (gAddingMachine /= NULL) then
       ret = COMReleaseObject(gAddingMachine)
    endif
    call COMUNINITIALIZE()

    WinMain = mesg.wParam
    return

99999 &

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

end 

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

SUBROUTINE VFAdderSub( dlg, id, callbacktype )

  use user32
  use dflogm
  use dfcom
  use dfauto

  implicit none

  type (dialog) dlg
  integer id, callbacktype

  if (callbacktype == dlg_destroy) then
    call PostQuitMessage(0)
  endif

  END SUBROUTINE VFAdderSub

!****************************************************************************
!
!  SUBROUTINE: VFAdderAdd ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for Add button
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE VFAdderAdd( dlg, id, callbacktype )

  use dflogm
  use dfcom
  use dfauto
  use VFAdderGlobals
  use AddingMachine

  implicit none

  include 'resource.fd'

  type (dialog) dlg
  integer id, callbacktype

  logical       lret
  integer(4)    status
  real(4)       addend
  real(4)       value
  character(32) text

  if (callbacktype == dlg_clicked) then
    !  Call the AddingMachine Add method
    lret = DlgGet(dlg, IDC_EDIT_ADDEND, text)
    read(text, *) addend
    status = $IAdd_Add(gAddingMachine, addend)
    call Check_Status(status, " Add method returned failure status")

    !  Set the Current Value text field
    status = $IAdd_GetValue(gAddingMachine, value)
    write(text, *) value
    call Check_Status(status, " GetValue method returned failure status")
    lret = DlgSet(dlg, IDC_CURRENTVALUE, text)

    !  Clear the addend field for the next value
    lret = DlgSet(dlg, IDC_EDIT_ADDEND, "")
  endif

  END SUBROUTINE VFAdderAdd

!****************************************************************************
!
!  SUBROUTINE: VFAdderClear ( dlg, id, callbacktype )
!
!  PURPOSE:  Dialog box callback for Clear button
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE VFAdderClear( dlg, id, callbacktype )

  use dflogm
  use dfcom
  use dfauto
  use VFAdderGlobals
  use AddingMachine

  implicit none

  include 'resource.fd'

  type (dialog) dlg
  integer id, callbacktype

  logical       lret
  integer(4)    status
  real(4)       value
  character(32) text

  if (callbacktype == dlg_clicked) then
    !  Call the AddingMachine Clear method
    status = $IAdd_Clear(gAddingMachine)
    call Check_Status(status, " Clear method returned failure status")

    !  Set the Current Value text field
    status = $IAdd_GetValue(gAddingMachine, value)
    write(text, *) value
    call Check_Status(status, " GetValue method returned failure status")
    lret = DlgSet(dlg, IDC_CURRENTVALUE, text)
  endif

  END SUBROUTINE VFAdderClear

!****************************************************************************
!
!  SUBROUTINE: CheckStatus( olestatus, errorMsg )
!
!  PURPOSE:  Check the status return value of a COM call
!
!  COMMENTS:
!
!****************************************************************************

SUBROUTINE Check_Status(status, errorMsg)
  use dfcom
  use user32
  use VFAdderGlobals
  use AddingMachine

  implicit none

  integer(4) status
  character (LEN = *) :: errorMsg

  integer(4) ret
  character (LEN = 512) :: Msg

  if (status >= 0) then
      return
  endif

! Error handling code
  if (gAddingMachine /= NULL) then
    ret = COMReleaseObject(gAddingMachine)
  endif

  write (Msg, '(A, "; OLE error status = 0x", Z8.8, "; Aborting")') TRIM(errorMsg), status
  ret = MessageBox(NULL, TRIM(Msg)//""c, "Error", MB_ICONSTOP)  
  call EXIT(-1)

  END SUBROUTINE
