home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / compiler / win_for / fortwin.for < prev    next >
Encoding:
Text File  |  1991-11-11  |  12.6 KB  |  349 lines
  1. $DEFINE KERNEL
  2. $DEFINE GDI
  3. $DEFINE USER
  4. $DEFINE CTLMGR
  5. $DEFINE MSG
  6. $DEFINE MENUS
  7. $DEFINE RASTEROPS
  8. $DEFINE WINMESSAGES
  9. $DEFINE WINSTYLES
  10.       INCLUDE 'FORTWIN.FI'
  11.       INCLUDE 'WINDOWS.FI'
  12. C
  13. C-------------------------------------------------------------------------------
  14. C
  15. C    PROGRAM: FORTWIN.FOR
  16. C
  17. C    PURPOSE: Generic MS-Fortran template for Windows 3.0 applications
  18. C
  19. C    FUNCTIONS:
  20. C
  21. C    WinMain() - calls initialization function, processes message loop
  22. C    InitApplication() - initializes window data and registers window
  23. C    InitInstance() - saves instance handle and creates main window
  24. C    MainWndProc() - processes messages
  25. C    About() - processes messages for "About" dialog box
  26. C
  27. C    COMMENTS:
  28. C
  29. C        Windows can have several copies of your application running at the
  30. C        same time when they are written in C. The variable hInst keeps track
  31. C        of which instance this application is so that processing will be to
  32. C        the correct window. A Microsoft Fortran application can only be invoked
  33. C        once (you cannot run more than one copy at a time). The reason for this
  34. C        does not appear to be given in the manual.
  35. C
  36. C-------------------------------------------------------------------------------
  37. C
  38. C    FUNCTION: WinMain(HANDLE, HANDLE, LPSTR, int)
  39. C
  40. C    PURPOSE: calls initialization function, processes message loop
  41. C
  42. C    COMMENTS:
  43. C
  44. C        Windows recognizes this function by name as the initial entry point 
  45. C        for the program.  This function calls the application initialization 
  46. C        routine, if no other instance of the program is running, and always 
  47. C        calls the instance initialization routine.  It then executes a message 
  48. C        retrieval and dispatch loop that is the top-level control structure 
  49. C        for the remainder of execution.  The loop is terminated when a WM_QUIT 
  50. C        message is received, at which time this function exits the application 
  51. C        instance by returning the value passed by PostQuitMessage(). 
  52. C
  53. C        If this function must abort before entering the message loop, it 
  54. C        returns the conventional value NULL.
  55. C
  56. C        The WinMain function must be declared PASCAL and FAR.
  57. C
  58. C-------------------------------------------------------------------------------
  59. C
  60.  
  61.       FUNCTION WinMain[PASCAL,FAR] (hInstance,hPrevInstance,
  62.      *                                               IpCmdLine,nCmdShow)
  63.       IMPLICIT NONE
  64.  
  65.       INTEGER*2 WinMain
  66.       INTEGER*2 hInstance     ! current instance
  67.       INTEGER*2 hPrevInstance ! previous instance
  68.       INTEGER*4 IpCmdLine     ! command line
  69.       INTEGER*2 nCmdShow      ! show-window type (open/icon)
  70.  
  71.       INCLUDE 'WINDOWS.FD'
  72.       INTEGER*2 InitApplication [EXTERN,FAR]
  73.       INTEGER*2 InitInstance [EXTERN,FAR]
  74.       INCLUDE 'FORTWIN.FD'
  75.  
  76.       INTEGER*4 STATUS
  77.  
  78.       RECORD /MSG/ Wmsg                          ! message
  79.  
  80.       IF(hPrevInstance.EQ.0)THEN                 ! Other instances of app running?
  81.          IF(InitApplication(hInstance).EQ.0)THEN ! Initialize shared things
  82.         WinMain=0                            ! Exits if unable to initialize
  83.             RETURN
  84.          ENDIF
  85.       ENDIF
  86. C
  87. C Perform initializations that apply to a specific instance
  88. C
  89.       HINST=HINSTANCE
  90.       IF(InitInstance(hInstance,nCmdShow).EQ.0)THEN
  91.           WinMain=0
  92.           RETURN
  93.       ENDIF
  94.  
  95. C
  96. C Acquire and dispatch messages until a WM_QUIT message is received.
  97. C
  98.       DO WHILE (GetMessage(Wmsg,       ! message structure
  99.      *        NULL,               ! handle of window receiving the message
  100.      *        NULL,               ! lowest message to examine
  101.      *        NULL).ne.0)               ! highest message to examine
  102.          STATUS=TranslateMessage(Wmsg) ! Translates virtual key codes
  103.      STATUS=DispatchMessage(Wmsg)  ! Dispatches message to window
  104.       ENDDO
  105.       WinMain=Wmsg.wParam          ! Returns the value from PostQuitMessage
  106.       RETURN
  107.       END
  108.  
  109. C
  110. C-------------------------------------------------------------------------------
  111. C
  112. C    FUNCTION: InitApplication(HANDLE)
  113. C
  114. C    PURPOSE: Initializes window data and registers window class
  115. C
  116. C    COMMENTS:
  117. C
  118. C        This function is called at initialization time only if no other 
  119. C        instances of the application are running.  This function performs 
  120. C        initialization tasks that can be done once for any number of running 
  121. C        instances.  
  122. C
  123. C        In this case, we initialize a window class by filling out a data 
  124. C        structure of type WNDCLASS and calling the Windows RegisterClass() 
  125. C        function.  Since all instances of this application use the same window 
  126. C        class, we only need to do this when the first instance is initialized.  
  127. C
  128. C
  129. C-------------------------------------------------------------------------------
  130. C
  131.       FUNCTION InitApplication(hInstance)
  132.       IMPLICIT NONE
  133.  
  134.       INTEGER*2 InitApplication
  135.       INTEGER*2 hInstance             ! Current instance
  136.  
  137.       INCLUDE 'WINDOWS.FD'
  138.       INTEGER*4 MainWndProc [EXTERN,PASCAL,FAR]
  139.       INCLUDE 'FORTWIN.FD'
  140.  
  141.       RECORD /WNDCLASS/ wc
  142.  
  143. C
  144. C Fill in window class structure with parameters that describe the
  145. C main window. NOTE the difference in the LoadCursor for user named and
  146. C internal resources.
  147. C
  148.       wc.style=NULL                                 ! Class style(s).
  149.       wc.lpfnWndProc=LOCFAR(MainWndProc)            ! Function to retrieve messages for
  150.                                                     ! windows of this class.
  151.       wc.cbClsExtra=0                               ! No per-class extra data.
  152.       wc.cbWndExtra=0                               ! No per-window extra data.
  153.       wc.hInstance=hInstance                        ! Application that owns the class.
  154.       wc.hIcon=LoadIcon(hInstance,'FortWinIcon'C)   ! Loads icon for Minmise Box
  155.       wc.hCursor=LoadCursor_A(NULL, IDC_ARROW)
  156. C      wc.hCursor=LoadCursor(hInstance,'FortWinCursor'C)
  157.       wc.hbrBackground=GetStockObject(WHITE_BRUSH)
  158.       wc.lpszMenuName=LOCFAR('GenericFortranMenu'C) ! Name of menu resource in .RC file.
  159.       wc.lpszClassName=LOCFAR('GenericWClass'C)     ! Name used in call to CreateWindow.
  160.  
  161. C
  162. C Register the window class and return success/failure code.
  163. C
  164.       InitApplication=RegisterClass(wc)
  165.       RETURN
  166.       END
  167.  
  168. C
  169. C-------------------------------------------------------------------------------
  170. C
  171. C    FUNCTION:  InitInstance(HANDLE, int)
  172. C
  173. C    PURPOSE:  Saves instance handle and creates main window
  174. C
  175. C    COMMENTS:
  176. C
  177. C        This function is called at initialization time for every instance of 
  178. C        this application.  This function performs initialization tasks that 
  179. C        cannot be shared by multiple instances.  
  180. C
  181. C        In this case, we save the instance handle in a static variable and 
  182. C        create and display the main program window.  
  183. C        
  184. C-------------------------------------------------------------------------------
  185. C
  186.       FUNCTION InitInstance(hInstance,nCmdShow)
  187.       IMPLICIT NONE
  188.  
  189.       INTEGER*2 InitInstance
  190.       INTEGER*2 hInstance          ! Current instance identifier.
  191.       INTEGER*2 nCmdShow           ! Param for first ShowWindow() call.
  192.  
  193.       INTEGER*2 hWnd               ! Main window handle.
  194.       INTEGER*2 STATUS
  195.  
  196.       INCLUDE 'WINDOWS.FD'
  197.       INCLUDE 'FORTWIN.FD'
  198.  
  199. C
  200. C Save the instance handle in static variable, which will be used in 
  201. C many subsequence calls from this application to Windows.
  202. C
  203.       hInst=hInstance
  204.  
  205. C
  206. C Create a main window for this application instance.
  207. C
  208.       hWnd=CreateWindow(
  209.      *        'GenericWClass'C,              ! See RegisterClass() call.
  210.      *        'Sample Fortran Application'C, ! Text for window title bar.     
  211.      *        WS_OVERLAPPEDWINDOW,           ! Window style.                  
  212.      *        CW_USEDEFAULT,                 ! Default horizontal position.    
  213.      *        CW_USEDEFAULT,                 ! Default vertical position.      
  214.      *        CW_USEDEFAULT,                 ! Default width.                  
  215.      *        CW_USEDEFAULT,                 ! Default height.                   
  216.      *        NULL,                          ! Overlapped windows have no parent.
  217.      *        NULL,                          ! Use the window class menu.       
  218.      *        hInstance,                     ! This instance owns this window.   
  219.      *        NULLSTR)                       ! Pointer not needed.            
  220.  
  221. C
  222. C If window could not be created, return "failure"
  223. C
  224.       IF(hWnd.EQ.0)THEN
  225.          InitInstance=0
  226.       ELSE
  227. C
  228. C Make the window visible; update its client area; and return "success"
  229. C
  230.          STATUS=ShowWindow(hWnd,nCmdShow) ! Show the window               
  231.          CALL UpdateWindow(hWnd)          ! Sends WM_PAINT message          
  232.          InitInstance=1                   ! Returns the value from PostQuitMessage
  233.       ENDIF
  234.       RETURN
  235.       END
  236.  
  237. C
  238. C-------------------------------------------------------------------------------
  239. C
  240. C    FUNCTION: MainWndProc(HWND, unsigned, WORD, LONG)
  241. C
  242. C    PURPOSE:  Processes messages
  243. C
  244. C    MESSAGES:
  245. C
  246. C    WM_COMMAND    - application menu (About dialog box)
  247. C    WM_DESTROY    - destroy window
  248. C
  249. C    COMMENTS:
  250. C
  251. C    To process the IDM_ABOUT message, call MakeProcInstance() to get the
  252. C    current instance address of the About() function.  Then call Dialog
  253. C    box which will create the box according to the information in your
  254. C    generic.rc file and turn control over to the About() function.    When
  255. C    it returns, free the intance address.
  256. C
  257. C       Functions called by Windows must be decalared PASCAL,FAR.
  258. C
  259. C-------------------------------------------------------------------------------
  260. C
  261.       FUNCTION MainWndProc[PASCAL,FAR] (hWnd,message,wParam,lParam)
  262.       IMPLICIT NONE
  263.  
  264.       INTEGER*4 MainWndProc
  265.       INTEGER*2 hWnd         ! Window handle
  266.       INTEGER*2 message      ! Type of message
  267.       INTEGER*2 wParam       ! Additional information
  268.       INTEGER*4 lParam       ! additional information
  269.  
  270.       INTEGER*4 lpProcAbout  ! Pointer to the "About" function
  271.  
  272.       INTEGER*2 STATUS
  273.       INCLUDE 'WINDOWS.FD'
  274.       EXTERNAL ABOUT [PASCAL,FAR]
  275.       INCLUDE 'FORTWIN.FD'
  276.  
  277.       SELECT CASE (message)
  278.          CASE (WM_COMMAND)   ! Message: command from application menu
  279.             IF(wParam.EQ.IDM_ABOUT)THEN
  280.                lpProcAbout=MakeProcInstance(About,hInst)
  281.                STATUS=DialogBox(hInst,        ! Current instance
  282.      *                        'AboutBox'C,    ! Resource to use
  283.      *                        hWnd,           ! Parent handle
  284.      *                        lpProcAbout)    ! About() instance address
  285.                CALL FreeProcInstance(lpProcAbout)
  286.                MainWndProc=NULL
  287.             ELSE                              ! Lets Windows process it
  288.                MainWndProc=DefWindowProc(hWnd,message,wParam,lParam)
  289.                RETURN
  290.             ENDIF
  291.  
  292.          CASE (WM_DESTROY)      ! message: window being destroyed
  293.             CALL PostQuitMessage(0)
  294.          CASE DEFAULT           ! Passes it on if unproccessed
  295.             MainWndProc=DefWindowProc(hWnd,message,wParam,lParam)
  296.       END SELECT
  297.       RETURN
  298.       END
  299.  
  300. C
  301. C-------------------------------------------------------------------------------
  302. C
  303. C    FUNCTION: About(HWND, unsigned, WORD, LONG)
  304. C
  305. C    PURPOSE:  Processes messages for "About" dialog box
  306. C
  307. C    MESSAGES:
  308. C
  309. C    WM_INITDIALOG - initialize dialog box
  310. C    WM_COMMAND    - Input received
  311. C
  312. C    COMMENTS:
  313. C
  314. C    No initialization is needed for this particular dialog box, but TRUE
  315. C    must be returned to Windows.
  316. C       
  317. C    Wait for user to click on "Ok" button, then close the dialog box.
  318. C
  319. C-------------------------------------------------------------------------------
  320. C
  321.       FUNCTION About[PASCAL,FAR] (hDlg,message,wParam,lParam)
  322.       IMPLICIT NONE
  323.  
  324.       INTEGER*2 About
  325.       INTEGER*2 hDlg                      ! window handle of the dialog box
  326.       INTEGER*2 message                   ! type of message
  327.       INTEGER*2 wParam                    ! message-specific information
  328.       INTEGER*4 lParam
  329.  
  330.       INCLUDE 'WINDOWS.FD'
  331.  
  332.       SELECT CASE (message)
  333.          CASE (WM_INITDIALOG)           ! message: initialize dialog box
  334.         About=1
  335.             RETURN
  336.  
  337.          CASE (WM_COMMAND)           ! message: received a command
  338.         IF(wParam.EQ.IDOK.OR.          ! "OK" box selected?
  339.      *         wParam.EQ.IDCANCEL)THEN     ! System menu close command?
  340.                CALL EndDialog(hDlg,1)      ! Exits the dialog box
  341.                About=1
  342.                RETURN
  343.             ENDIF
  344.       END SELECT
  345.  
  346.       About=0                       ! Didn't process a message
  347.       RETURN
  348.       END
  349.