home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / compiler / win_for / about.for next >
Encoding:
Text File  |  1991-11-09  |  2.6 KB  |  67 lines
  1. $DEFINE GDI
  2. $DEFINE USER
  3. $DEFINE CTLMGR
  4. $DEFINE WINMESSAGES
  5. $DEFINE RASTEROPS
  6.       INCLUDE 'FWCLOCK.FI'
  7.       INCLUDE 'WINDOWS.FI'
  8.       FUNCTION About[PASCAL,FAR] (hDlg,message,wParam,lParam)
  9.       IMPLICIT NONE
  10. C
  11. C Author       : Kevin B Black
  12. C Date written : 23-Oct-1991
  13. C Abstract     :
  14. C
  15. C ABOUT BOX FUNCTION FOR FWCLOCK
  16. C
  17. C This subroutine is the About Box dialog for FWClock. It basically sits
  18. C and waits for the user to `ok' the About Box displayed by windows.
  19. C
  20.  
  21.       INTEGER*2 About
  22.       INTEGER*2 hDlg                  ! Window handle of the dialog box
  23.       INTEGER*2 message               ! Type of message
  24.       INTEGER*2 wParam                ! Message-specific information
  25.       INTEGER*4 lParam
  26.  
  27.       INCLUDE 'WINDOWS.FD'            ! Include windows functions and parameters
  28.       INCLUDE 'FWCLOCK.FD'            ! Include FWClock variables and parameters
  29.       INTEGER*2 MEMHDC,ABOUTBMP,OLDBMP ! Temporary handles for display of bitmap
  30.       INTEGER*2 BMPW,BMPH             ! Width and height of bitmap
  31.       INTEGER*2 BMPI(4)               ! To get size of bitmap with GetObject
  32.       EQUIVALENCE (BMPI(2),BMPW),(BMPI(3),BMPH)
  33.  
  34.       SELECT CASE (message)
  35.          CASE (WM_INITDIALOG)          ! Message: Initialize dialog box
  36.             RETURN
  37.  
  38.          CASE (WM_PAINT)          ! Message: Paint
  39.             WSTATUS=BeginPaint(hDlg,FWCPS)
  40.             MEMHDC=CreateCompatibleDC(FWCPS.HDC)    ! Create a temporary memory context
  41.             ABOUTBMP=LoadBitmap(HINST,'FWCAuthor'C) ! Load bitmap to display
  42.             WSTATUS=GetObject(ABOUTBMP,8,BMPI)      ! Get size of bitmap
  43.             OLDBMP=SelectObject(MEMHDC,ABOUTBMP)    ! Select bitmap object, save old
  44.             IF(OLDBMP.NE.0)THEN
  45.                CALL GetClientRect(hDlg,TRECT)
  46.                WSTATUS=BitBlt(FWCPS.HDC,
  47.      *                TRECT.RIGHT-5-BMPW,TRECT.BOTTOM-5-BMPH,
  48.      *                BMPW,BMPH,MEMHDC,0,0,SRCCOPY) ! Display bitmap
  49.                WSTATUS=SelectObject(MEMHDC,OLDBMP)  ! Restore old bitmap object
  50.             ENDIF
  51.             WSTATUS=DeleteObject(ABOUTBMP)          ! Finished with bitmap 
  52.             WSTATUS=DeleteDC(MEMHDC)                ! Finished with memory
  53.             CALL EndPaint(hDlg,FWCPS)
  54.  
  55.          CASE (WM_COMMAND)          ! Message: Received a command
  56.         IF(wParam.EQ.IDOK.OR.     ! "OK" box selected?
  57.      *         wParam.EQ.IDCANCEL)THEN! System menu close command?
  58.                CALL EndDialog(hDlg,1) ! Exits the dialog box
  59.                About=1
  60.                RETURN
  61.             ENDIF
  62.       END SELECT
  63.  
  64.       About=0                  ! Didn't process a message
  65.       RETURN
  66.       END
  67.