Power-Programmierung/CD1.mdf/fortran/compiler/win_for/wndproc.for

Text File | 1991-11-11 | 12.7 KB | 305 lines

$DEFINE KERNEL
$DEFINE GDI
$DEFINE USER
$DEFINE CTLMGR
$DEFINE MB
$DEFINE MENUS
$DEFINE RASTEROPS
$DEFINE WINMESSAGES
      INCLUDE 'WINDOWS.FI'
      FUNCTION FWClockWndProc[PASCAL,FAR] (hWnd2,message,wParam,lParam)
      IMPLICIT NONE
C
C Author       : Kevin B Black
C Date written : 23-Oct-1991
C Abstract     :
C
C Function to process Windows messages for FWClock
C

      INTEGER*4 FWClockWndProc
      INTEGER*2 hWnd2             ! Window handle, as passed by Windows
      INTEGER*2 message           ! Type of message
      INTEGER*2 wParam            ! Additional information
      INTEGER*4 lParam            ! additional information

      INTEGER*4 lpProcAbout       ! Pointer to the "About" function

      INCLUDE 'WINDOWS.FD'        ! Include windows functions and parameters
      EXTERNAL ABOUT [PASCAL,FAR] ! The About Box dialog procedure
      INCLUDE 'FWCLOCK.FD'        ! Include FWClocks variables and parameters

C
C Set a default return value
C
      FWClockWndProc=NULL
C
C See if this is a message that we process, unrecognised messages are passed
C to the Windows default message handler, DefWindowProc.
C
      SELECT CASE (message)
C
C Command
C
         CASE (WM_COMMAND)                    ! Message: command from application menu
            SELECT CASE (wParam)
C
C User has selected the chimes option from the menu. Swap chimes state, if
C chimes state is being enabled, then chime now. Update Chimes keyword
C in FWClocks profile file.
C
               CASE (IDM_CHIMES)
                  IF(CHIMES)THEN
                     CHIMES=.FALSE.
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                     MF_UNCHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'Chimes'C,
     *                                                 NULLSTR,
     *                                                 'FWCLOCK.INI'C)
                  ELSE
                     CHIMES=.TRUE.
                     CALL MessageBeep(0)
                     CALL MessageBeep(0)
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                       MF_CHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'Chimes'C,
     *                                                 '1'C,
     *                                                 'FWCLOCK.INI'C)
                  ENDIF
C
C User has clicked on the Solid Hands menu option, this allows the user
C to change between `solid' hands and outlines. The menu item is checked
C if solid hands are selected. The new selection is written to the
C FWClock profile file. After the hand type has changed, a pain message is
C posted to the window, if it is `open', so that the new hands are drawn.
C
               CASE (IDM_SOLIDHANDS)
                  IF(SOLIDHANDS)THEN
                     SOLIDHANDS=.FALSE.
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                     MF_UNCHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'SolidHands'C,
     *                                                 NULLSTR,
     *                                                 'FWCLOCK.INI'C)
                  ELSE
                     SOLIDHANDS=.TRUE.
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                       MF_CHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'SolidHands'C,
     *                                                 '1'C,
     *                                                 'FWCLOCK.INI'C)
                  ENDIF
                  IF(.NOT.IMANICON)WSTATUS=
     *                                   PostMessage(hWnd2,WM_PAINT,0,0)
C
C The user has clicked on the Second hand in Icon menu option. This allows
C the user to enable/disable a second hand when the window is in the iconic
C state. The new selection is written to the FWClock profile file. A paint
C message is issued, if the window is in the iconic state, to update the
C clock face.
C
               CASE (IDM_SECONDSICON)
                  IF(SECONDSICON)THEN
                     SECONDSICON=.FALSE.
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                     MF_UNCHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'SecondsInIcon'C,
     *                                                 NULLSTR,
     *                                                 'FWCLOCK.INI'C)
                  ELSE
                     SECONDSICON=.TRUE.
                     WSTATUS=CheckMenuItem(GetMenu(hWnd2),wparam,
     *                                                       MF_CHECKED)
                     WSTATUS=WritePrivateProfileString('FWClock'C,
     *                                                 'SecondsInIcon'C,
     *                                                 '1'C,
     *                                                 'FWCLOCK.INI'C)
                  ENDIF
                  IF(IMANICON)WSTATUS=PostMessage(hWnd2,WM_PAINT,0,0)
C
C User has selected time zone change from menu, this facility has not been
C implimented yet, display a message box saying so...
C
               CASE (IDM_TIMEZONE)
                  WSTATUS=MessageBox(hWnd2,
     *                    'FWClock: Time Zone feature not implimented'C,
     *                    'FWClock: Error'C,
     *                      MB_APPLMODAL.OR.MB_ICONEXCLAMATION.OR.MB_OK)
C
C The user has clicked on the Exit menu option or closed the window. The
C timer is killed off, the selected general tools are deleted and then
C quit message is posted to let windows know FWClock has finished.
C
               CASE (IDM_EXIT)
                  WSTATUS=KillTimer(hWnd2,MYTIMER)
                  CALL DOWN_TOOLS
                  CALL PostQuitMessage(0)
C
C The user has clicked on the About FWClock menu item, The About Box
C dialog is created and displayed. The user must `ok' the about dialog
C before the FWClock menu becomes accesssible again.
C
               CASE (IDM_ABOUT)
                  lpProcAbout=MakeProcInstance(About,hInst)
                  WSTATUS=DialogBox(hInst,    ! Current instance
     *                           'AboutBox'C, ! Resource to use
     *                           hWnd2,       ! Parent handle
     *                           lpProcAbout) ! About() instance address
                  CALL FreeProcInstance(lpProcAbout)
C
C If the menu item is not recognized, allow windows to process it. An
C alternative would be to display a message box to inform the user.
C
               CASE DEFAULT                      ! Let Windows process it
                  FWClockWndProc=DefWindowProc(hWnd2,message,
     *                                                    wParam,lParam)
            END SELECT
C
C The erase background message has been received, get the windows bounding
C rectangle and paint it over with the background brush.
C
         CASE (WM_ERASEBKGND)                 ! Erase background
            CALL GetClientRect(hWnd2,TRECT)
            WSTATUS=FillRect(wParam,TRECT,BBRUSH)
C
C The paint message has been received, the whole of the clock must be
C painted.....
C
         CASE (WM_PAINT)
C
C Invalidate the current window contents
C
            CALL InvalidateRect_A(hWnd2,0,1)
C
C Begin paint, this call is important, and it should only be activated in
C response to the WM_PAINT message. It must be matched with a call to the
C EndPaint function, before returning from the programs windows function.
C
            WSTATUS=BeginPaint(hWnd2,FWCPS)
C
C Set background mode and select the tools required
C
            WSTATUS=SetBkMode(FWCPS.HDC,TRANSPARENT)
            WSTATUS=SelectObject(FWCPS.HDC,FPEN)
            WSTATUS=SelectObject(FWCPS.HDC,FBRUSH)
C
C Draw the clock face
C
            WSTATUS=SetROP2(FWCPS.HDC,R2_COPYPEN)
            CALL DRAW_FACE
C
C Put on the minute and hour hands
C
            CALL DRAW_HOURHAND
            CALL DRAW_MINUTEHAND
C
C Put on the second hand. The current screen contents under the second hand
C are inverted so that it always shows up. A second hand is only required
C if the window is open, or the user has enabled it for the windows iconic
C state. In the non-iconic state a `hub' is draw at the centre of the clock
C face (just like a real clock!).
C
            IF(.NOT.IMANICON.OR.SECONDSICON)THEN
               WSTATUS=SetROP2(FWCPS.HDC,R2_NOT)
               CALL DRAW_SECONDHAND
               WSTATUS=SetROP2(FWCPS.HDC,R2_COPYPEN)
               IF(.NOT.IMANICON)CALL DRAW_HUB
            ENDIF
C
C Finished painting the window, so tell windows.
C
            CALL EndPaint(hWnd2,FWCPS)
C
C The window has been resized, this includes conversions to and from the
C iconic state. Windows should issue a WM_PAINT message after a window
C has been resized, so that should take care of redrawing the window.
C
         CASE (WM_SIZE)                       ! Window re-sized
            CALL RESIZE(hWnd2,lParam,wParam)
C
C The timer has expired, or the system time has been changed by the user.
C The clock face needs to be updated if the time has changed (the timer
C fires more often then the time on the clock face changed, so that the
C motion of the hand, the second hand especially, is smooth).
C
         CASE (WM_TIMER,WM_TIMECHANGE)        ! Timer triggered or system time changed
C
C Get the current time, and see if the clock face needs to be updated.
C
            CALL GETTIM(HOURS,MINS,SECS,WSTATUS)
            IF((OSECS.NE.SECS.AND.(.NOT.IMANICON.OR.SECONDSICON)).OR.
     *          OMINS.NE.MINS.OR.OHOURS.NE.HOURS)THEN
C
C The clock face needs updating, get a handle on the window, and if there
C is a second hand on display, erase it.
C
               FWCPS.HDC=GetDC(hWnd2)
               IF(.NOT.IMANICON.OR.SECONDSICON)THEN
                  WSTATUS=SetROP2(FWCPS.HDC,R2_NOT)
                  CALL DRAW_SECONDHAND        ! Erase old second hand
               ENDIF
C
C If the minute has changed (or the hour, in case the clock was held up
C for an hour (in which case the minute might be the same) then erase
C and redraw the hour and minute hands to `move' them `arround' the clock
C face.
C
               IF(MINS.NE.OMINS)THEN
                  WSTATUS=SetROP2(FWCPS.HDC,R2_COPYPEN)
                  WSTATUS=SelectObject(FWCPS.HDC,BPEN)
                  WSTATUS=SelectObject(FWCPS.HDC,BBRUSH)
                  CALL DRAW_HOURHAND
                  CALL DRAW_MINUTEHAND
                  OHOURS=HOURS
                  OMINS=MINS
C                  WSTATUS=SetROP2(FWCPS.HDC,R2_COPYPEN)
                  WSTATUS=SelectObject(FWCPS.HDC,FPEN)
                  WSTATUS=SelectObject(FWCPS.HDC,FBRUSH)
                  CALL DRAW_HOURHAND
                  CALL DRAW_MINUTEHAND
                  IF(OHOURS.NE.HOURS)THEN
                     CALL MessageBeep(0)
                     CALL MessageBeep(0)
                  ENDIF
               ENDIF
C
C If a second hand should be on display, then put it on. For a non-iconic
C clock face, the hub is redrawn (to erase where the hands have overlapped
C it).
C
               OSECS=SECS
               IF(.NOT.IMANICON.OR.SECONDSICON)THEN
                  WSTATUS=SetROP2(FWCPS.HDC,R2_NOT)
                  CALL DRAW_SECONDHAND     ! Draw new second hand
                  WSTATUS=SetROP2(FWCPS.HDC,R2_COPYPEN)
                  IF(.NOT.IMANICON)CALL DRAW_HUB
               ENDIF
C
C The clock has been updated, release the device contect for the window.
C
               WSTATUS=ReleaseDC(hWnd2,FWCPS.HDC)
            ENDIF
C
C The destroy window message has been received. As with the Exit option
C on the menu, the timer is killed off and the selected general tools are
C deleted. A quit message is then posted to windows to tell it the
C application has finished.
C
         CASE (WM_DESTROY)                    ! message: window being destroyed
            CALL DOWN_TOOLS
            WSTATUS=KillTimer(hWnd2,MYTIMER)
            CALL PostQuitMessage(0)
C
C If the message was not recognized, then let windows have it
C
         CASE DEFAULT                         ! Passes it on if unproccessed
            FWClockWndProc=DefWindowProc(hWnd2,message,wParam,lParam)
      END SELECT
      RETURN
      END