home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Windoware
/
WINDOWARE_1_6.iso
/
source
/
f4w3api
/
f4w3api.kit
/
WINDEV
/
FORTRAN
/
FWCLOCK
/
ABOUT.FOR
next >
Wrap
Text File
|
1991-11-09
|
3KB
|
67 lines
$DEFINE GDI
$DEFINE USER
$DEFINE CTLMGR
$DEFINE WINMESSAGES
$DEFINE RASTEROPS
INCLUDE 'FWCLOCK.FI'
INCLUDE 'WINDOWS.FI'
FUNCTION About[PASCAL,FAR] (hDlg,message,wParam,lParam)
IMPLICIT NONE
C
C Author : Kevin B Black
C Date written : 23-Oct-1991
C Abstract :
C
C ABOUT BOX FUNCTION FOR FWCLOCK
C
C This subroutine is the About Box dialog for FWClock. It basically sits
C and waits for the user to `ok' the About Box displayed by windows.
C
INTEGER*2 About
INTEGER*2 hDlg ! Window handle of the dialog box
INTEGER*2 message ! Type of message
INTEGER*2 wParam ! Message-specific information
INTEGER*4 lParam
INCLUDE 'WINDOWS.FD' ! Include windows functions and parameters
INCLUDE 'FWCLOCK.FD' ! Include FWClock variables and parameters
INTEGER*2 MEMHDC,ABOUTBMP,OLDBMP ! Temporary handles for display of bitmap
INTEGER*2 BMPW,BMPH ! Width and height of bitmap
INTEGER*2 BMPI(4) ! To get size of bitmap with GetObject
EQUIVALENCE (BMPI(2),BMPW),(BMPI(3),BMPH)
SELECT CASE (message)
CASE (WM_INITDIALOG) ! Message: Initialize dialog box
RETURN
CASE (WM_PAINT) ! Message: Paint
WSTATUS=BeginPaint(hDlg,FWCPS)
MEMHDC=CreateCompatibleDC(FWCPS.HDC) ! Create a temporary memory context
ABOUTBMP=LoadBitmap(HINST,'FWCAuthor'C) ! Load bitmap to display
WSTATUS=GetObject(ABOUTBMP,8,BMPI) ! Get size of bitmap
OLDBMP=SelectObject(MEMHDC,ABOUTBMP) ! Select bitmap object, save old
IF(OLDBMP.NE.0)THEN
CALL GetClientRect(hDlg,TRECT)
WSTATUS=BitBlt(FWCPS.HDC,
* TRECT.RIGHT-5-BMPW,TRECT.BOTTOM-5-BMPH,
* BMPW,BMPH,MEMHDC,0,0,SRCCOPY) ! Display bitmap
WSTATUS=SelectObject(MEMHDC,OLDBMP) ! Restore old bitmap object
ENDIF
WSTATUS=DeleteObject(ABOUTBMP) ! Finished with bitmap
WSTATUS=DeleteDC(MEMHDC) ! Finished with memory
CALL EndPaint(hDlg,FWCPS)
CASE (WM_COMMAND) ! Message: Received a command
IF(wParam.EQ.IDOK.OR. ! "OK" box selected?
* wParam.EQ.IDCANCEL)THEN! System menu close command?
CALL EndDialog(hDlg,1) ! Exits the dialog box
About=1
RETURN
ENDIF
END SELECT
About=0 ! Didn't process a message
RETURN
END