!  LessonA36.f90 
!
!  FUNCTIONS:
!   WinMain()      - Entry point for the application;
!                    displays the main window; processes the message loop
!   MainWndProc()  - processes messages for the main window
!   CenterWindow() - centers one window over another
!   AboutDlgProc() - processes messages for the about box
!

!****************************************************************************
!
!  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 LessonA36Globals

    implicit none

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

    include 'LessonA36.fi'

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

    character(SIZEOFAPPNAME) lpszClassName
    character(SIZEOFAPPNAME) lpszIconName
    character(SIZEOFAPPNAME) lpszAppName
    character(SIZEOFAPPNAME) lpszMenuName
    character(SIZEOFAPPNAME) lpszAccelName

    ghInstance = hInstance
    ghModule = GetModuleHandle(NULL)
    ghwndMain = NULL

    lpszClassName ="LessonA36"C
    lpszAppName ="LessonA36"C
    lpszIconName ="LessonA36"C  
    lpszMenuName ="LessonA36"C
    lpszAccelName ="LessonA36"C

    !  If this is the first instance of the application, register the
    !  window class(es)
    if (hPrevInstance .eq. 0) then
        !  Main window
         wc%lpszClassName = LOC(lpszClassName)
         wc%lpfnWndProc = LOC(MainWndProc)
         wc%style = IOR(CS_VREDRAW , CS_HREDRAW)
         wc%hInstance = hInstance
         wc%hIcon = LoadIcon( hInstance, LOC(lpszIconName))
         wc%hCursor = LoadCursor( NULL, IDC_ARROW )
         wc%hbrBackground = ( COLOR_WINDOW+1 )
         wc%lpszMenuName = NULL
         wc%cbClsExtra = 0
         wc%cbWndExtra = 0
         if (RegisterClass(wc) == 0) goto 99999
    end if

    ! Load the window's menu and accelerators and create the window
    !
    ghMenu = LoadMenu(hInstance, LOC(lpszMenuName))
    if (ghMenu == 0) goto 99999
    haccel = LoadAccelerators(hInstance, LOC(lpszAccelName))
    if (haccel == 0) goto 99999

    ghwndMain = CreateWindowEx(  0, lpszClassName,                 &
                                 lpszAppName,                      &
                                 INT(WS_OVERLAPPEDWINDOW),         &
                                 CW_USEDEFAULT,                    &
                                 0,                                &
                                 CW_USEDEFAULT,                    &
                                 0,                                &
                                 NULL,                             &
                                 ghMenu,                           &
                                 hInstance,                        &
                                 NULL                              &
                              )
    if (ghwndMain == 0) goto 99999

    lret = ShowWindow( ghwndMain, nCmdShow )

    ! Read and process messsages
    do while( GetMessage (mesg, NULL, 0, 0) ) 
       if ( TranslateAccelerator (mesg%hwnd, haccel, mesg) == 0) then
           lret = TranslateMessage( mesg )
           ret  = DispatchMessage( mesg )
       end if
    end do

    WinMain = mesg.wParam
    return

99999 &

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

end 

!****************************************************************************
!
!  FUNCTION: MainWndProc ( hWnd, mesg, wParam, lParam )
!
!  PURPOSE:  Processes messages for the main window
!
!  COMMENTS:
!
!****************************************************************************

integer function MainWndProc ( hWnd, mesg, wParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_MainWndProc@16' :: MainWndProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'MainWndProc' :: MainWndProc
!DEC$ ENDIF

    use user32
    use LessonA36Globals

    implicit none

    integer*4 hWnd
    integer*4 mesg
    integer*4 wParam
    integer*4 lParam

    include 'resource.fd'

    interface 
    integer*4 function  AboutDlgProc( hwnd, mesg, wParam, lParam )
    !DEC$ IF DEFINED(_X86_)
    !DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
    !DEC$ ELSE
    !DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
    !DEC$ ENDIF

    integer*4 hwnd 
    integer*4 mesg  
    integer*4 wParam
    integer*4 lParam 
    end function 
    end interface

	interface
	subroutine CreateChart()
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?CreateChart@Classless@@YAXXZ'::CreateChart
	end subroutine CreateChart
	end interface

	interface
	subroutine DestroyChart()
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?DestroyChart@Classless@@YAXXZ'::DestroyChart
	end subroutine DestroyChart
	end interface

	interface
	integer function Attach(hWnd)
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?Attach@Classless@@YAHPAUHWND__@@@Z'::Attach
		!DEC$ATTRIBUTES VALUE::hWnd
		integer hWnd
	end function Attach
	end interface

	interface
	integer*1 function SetType(chartType)
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?SetType@Classless@@YA_NH@Z'::SetType
		!DEC$ATTRIBUTES VALUE::chartType
		integer chartType
	end function SetType
	end interface

	interface
	integer function AddPie(pie)
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?AddPie@Classless@@YAHN@Z'::AddPie
		!DEC$ATTRIBUTES VALUE::pie
		double precision pie
	end function AddPie
	end interface

	interface
	subroutine SetPieTitle(title, pieIndex)
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?SetPieTitle@Classless@@YAXPBDH@Z'::SetPieTitle
		!DEC$ATTRIBUTES VALUE::title, pieIndex
		integer title, pieIndex
	end subroutine SetPieTitle
	end interface

	interface
	subroutine SetTitle(title)
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?SetTitle@Classless@@YAXPBD@Z'::SetTitle
		!DEC$ATTRIBUTES VALUE::title
		integer title
	end subroutine SetTitle
	end interface

	interface
	subroutine ReDraw()
		!DEC$ATTRIBUTES DLLIMPORT,ALIAS:'?ReDraw@Classless@@YAXXZ'::ReDraw
	end subroutine ReDraw
	end interface

    ! Variables
    integer*4           ret
    character(SIZEOFAPPNAME)  lpszName, lpszHelpFileName, lpszContents, lpszMessage
    character(SIZEOFAPPNAME)  lpszHeader

    select case ( mesg )

	! WM_CREATE
	  case (WM_CREATE)
	      call CreateChart()
		  call Attach(hWnd)
		  call SetType(1)

		  call AddPie(3)
		  call AddPie(2)
		  call AddPie(1)
		  call AddPie(6)
		  call AddPie(7)

		  call SetPieTitle(LOC("赵敏"C), 0)
		  call SetPieTitle(LOC("周芷若"C), 1)
		  call SetPieTitle(LOC("殷离"C), 2)
		  call SetPieTitle(LOC("小昭"C), 3)
		  call SetPieTitle(LOC("黄衫女"C), 4)

		  call SetTitle(LOC("Fortran 窗口标题"C))

		  MainWndProc = 0
		  return


    ! WM_DESTROY: PostQuitMessage() is called 
      case (WM_DESTROY)
	      call DestroyChart()
          call PostQuitMessage( 0 )
          MainWndProc = 0
          return

    ! WM_COMMAND: user command
      case (WM_COMMAND)
        select case ( IAND(wParam, 16#ffff ) )
 
            case (IDM_EXIT)
                ret = SendMessage( hWnd, WM_CLOSE, 0, 0 )
                MainWndProc = 0
                return
  
            case (IDM_ABOUT)
                lpszName = "AboutDlg"C
                ret = DialogBoxParam(ghInstance,LOC(lpszName),hWnd,& 
                  LOC(AboutDlgProc), 0)
                MainWndProc = 0
                return

            case (IDM_HELPCONTENTS)  
                lpszHelpFileName ="\\LessonA36.hlp"C
                lpszContents = "CONTENTS"C
                if (WinHelp (hWnd, lpszHelpFileName, HELP_KEY, &
                               LOC(lpszContents)) .EQV. .FALSE.) then
                lpszMessage = "Unable to activate help"C
                lpszHeader = "LessonA36"
                ret = MessageBox (hWnd,                             &
                                 lpszMessage,                       &
                                 lpszHeader,                        &
                                 IOR(MB_SYSTEMMODAL,                &
                                 IOR(MB_OK, MB_ICONHAND)))
                end if
                MainWndProc = 0
                return

            case (IDM_HELPSEARCH)
                lpszHelpFileName ="\\LessonA36.hlp"C
                lpszContents = "CONTENTS"C
                if (WinHelp(hWnd, "LessonA36.hlp"C,            &
                       HELP_PARTIALKEY, LOC(""C)) .EQV. .FALSE.) then
                   lpszMessage = "Unable to activate help"C
                   lpszHeader = "LessonA36"C
                   ret = MessageBox (hWnd,                          &
                                 lpszMessage,                       &
                                 lpszHeader,                        &
                                 IOR(MB_SYSTEMMODAL ,               &
                                 IOR(MB_OK, MB_ICONHAND)))
                end if
                MainWndProc = 0
                return

            case (IDM_HELPHELP)
                if (WinHelp(hWnd, ""C, HELP_HELPONHELP, 0).EQV. .FALSE.)& 
                                                       then
                   lpszMessage = "Unable to activate help"C
                   lpszHeader = "LessonA36"C
                   ret = MessageBox (GetFocus(),                    &
                                 lpszMessage,                       &
                                 lpszHeader,                        &
                                 IOR(MB_SYSTEMMODAL,IOR(MB_OK, MB_ICONHAND)))
                end if
                MainWndProc = 0
                return

            ! All of the other possible menu options are currently disabled

            case DEFAULT
                MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )
                return
        end select

    ! Let the default window proc handle all other messages
      case default
          MainWndProc = DefWindowProc( hWnd, mesg, wParam, lParam )

    end select

end

!****************************************************************************
!
!  FUNCTION: CenterWindow (HWND, HWND)
!
!  PURPOSE:  Center one window over another
!
!  COMMENTS: Dialog boxes take on the screen position that they were designed
!            at, which is not always appropriate. Centering the dialog over a
!            particular window usually results in a better position.
!
!****************************************************************************

subroutine CenterWindow (hwndChild, hwndParent)

    use user32
    use gdi32 
    use LessonA36Globals

    implicit none

    integer         hwndChild, hwndParent

    include 'resource.fd'

    ! Variables
    type (T_RECT)   rChild, rParent
    integer         wChild, hChild, wParent, hParent
    integer         wScreen, hScreen, xNew, yNew
    integer         hdc
    integer*4       retval

    ! Get the Height and Width of the child window
       retval = GetWindowRect (hwndChild, rChild)
       wChild = rChild.right - rChild.left
       hChild = rChild.bottom - rChild.top

    ! Get the Height and Width of the parent window
       retval = GetWindowRect (hwndParent, rParent)
       wParent = rParent.right - rParent.left
       hParent = rParent.bottom - rParent.top

    ! Get the display limits
       hdc = GetDC (hwndChild)
       wScreen = GetDeviceCaps (hdc, HORZRES)
       hScreen = GetDeviceCaps (hdc, VERTRES)
       retval = ReleaseDC (hwndChild, hdc)

    ! Calculate new X position, then adjust for screen
       xNew = rParent.left + ((wParent - wChild) /2)
       if (xNew .LT. 0) then
          xNew = 0
       else if ((xNew+wChild) .GT. wScreen) then
          xNew = wScreen - wChild
       end if

    ! Calculate new Y position, then adjust for screen
       yNew = rParent.top  + ((hParent - hChild) /2)
       if (yNew .LT. 0) then
          yNew = 0
       else if ((yNew+hChild) .GT. hScreen) then
          yNew = hScreen - hChild
       end if

    ! Set it, and return
       retval = SetWindowPos (hwndChild, NULL, xNew, yNew, 0, 0,      &
                      IOR(SWP_NOSIZE , SWP_NOZORDER))
end  

 
!/****************************************************************************
!
!  FUNCTION: AboutDlgProc(HWND, UINT, WPARAM, LPARAM)
!
!  PURPOSE:  Processes messages for "About" dialog box
!
!  COMMENTS: Display version information from the version section of the
!            application resource.  Wait for user to click on "Ok" button,
!            then close the dialog box.
!
!****************************************************************************/

integer*4 function AboutDlgProc( hDlg, message, uParam, lParam )
!DEC$ IF DEFINED(_X86_)
!DEC$ ATTRIBUTES STDCALL, ALIAS : '_AboutDlgProc@16' :: AboutDlgProc
!DEC$ ELSE
!DEC$ ATTRIBUTES STDCALL, ALIAS : 'AboutDlgProc' :: AboutDlgProc
!DEC$ ENDIF

    use kernel32
    use user32
    use gdi32
    use dfwbase
    use version
    use LessonA36Globals

    implicit none

    integer     hDlg        ! window handle of the dialog box
    integer     message     ! type of message
    integer     uParam      ! message-specific information
    integer     lParam

    include 'resource.fd'

    ! Variables
    integer*4   hfontDlg
    save        hfontDlg

    integer     dwVerHnd
    integer     dwVerInfoSize
    integer     uVersionLen
    integer     bRetCode
    integer     i
    character*256   szFullPath
    character*256   szResult
    character*256   szGetName
    character*256   lpversion

    integer*4   lpstrVffInfo
    integer*4   hMem
    integer*4   ret

    select case (message)
      case (WM_INITDIALOG)   ! message: initialize dialog box
         ! Create a font to use
         hfontDlg = CreateFont(14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,& 
                        IOR(INT(VARIABLE_PITCH) , INT(FF_SWISS)), ""C)

         ! Center the dialog over the application window
         call CenterWindow (hDlg, GetWindow (hDlg, GW_OWNER))

         ! Get version information from the application
         ret = GetModuleFileName (INT(ghInstance), szFullPath,     &
                               len(szFullPath))
         dwVerInfoSize = GetFileVersionInfoSize(szFullPath,   &
                                       LOC(dwVerHnd))

         if (dwVerInfoSize .NE. 0) then
            ! If we were able to get the information, process it:
            hMem = GlobalAlloc(GMEM_MOVEABLE, INT(dwVerInfoSize))
            lpstrVffInfo  = GlobalLock(hMem)
            ret = GetFileVersionInfo (szFullPath, dwVerHnd, &
            dwVerInfoSize, lpstrVffInfo)

            ! Walk through the dialog items that we want to replace:
            do i = IDC_VER1, IDC_VER5
               ret = GetDlgItemText(hDlg, i, szResult,      &     
                             len(szResult))
                
               szGetName = "\\StringFileInfo\\040904E4\\"C               
               ret =lstrcat(szGetName,szResult)

               bRetCode  =  VersionQueryValue(lpstrVffInfo,       &
                                            LOC(szGetName),       &
                                            LOC(lpVersion),       &
                                            LOC(uVersionLen))

               if ( bRetCode .NE. 0 ) then
                  ! Replace dialog item text with version info
                  ret = lstrcpy(szResult,lpVersion)
                  ret = SetDlgItemText(hDlg, i,szResult)
                  ret = SendMessage (GetDlgItem (hDlg, i),   &
                                   WM_SETFONT, hfontDlg, TRUE)
               end if
            end do 

            ret = GlobalUnlock(hMem)
            ret = GlobalFree(hMem)
         end if 
         AboutDlgProc = 1
         return
      case (WM_COMMAND)                      ! message: received a command
         if ((IAND(uParam,16#ffff) .EQ. IDOK) & !OK Selected?
            .OR. (IAND(uParam,16#ffff) .EQ. IDCANCEL)) then ! Close command?
            ret = EndDialog(hDlg, TRUE)      ! Exit the dialog
            ret = DeleteObject (hfontDlg)
            AboutDlgProc = 1
            return
         end if
    end select  
    AboutDlgProc = 0 ! Didn't process the message
    return
end 

