clock.for

开放源码的编译器open watcom 1.6.0版的源代码

        ! select pen for hand
        call SelectObject( hDC, hPen )

        ! Draw thin hand
        call MoveTo( hDC, ClockCenter.x, ClockCenter.y )
        allocate( lpCirTab(0:HANDPOSITIONS-1), location=CirTab )
        call LineTo( hDC, ClockCenter.x +
     &               ((lpCirTab(pos).x * radius) / CIRTABSCALE),
     &               ClockCenter.y +
     &               ((lpCirTab(pos).y * radius) / CIRTABSCALE) )
        deallocate( lpCirTab )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTEINE : DrawFatHand
!
!  PURPOSE     : Draws a fat hand with the specified pen in the specified
!                hand position.
!
!-------------------------------------------------------------------------------

        subroutine DrawFatHand( hDC, pos, hPen, _hHand )
        integer*2       hDC     ! device context to be used when drawing hand
        integer*2       pos     ! hand position index into the circle table
        integer*2       hPen    ! pen to be used when drawing hand
        logical         _hHand  ! TRUE if drawing hour hand; FALSE otherwise

        include 'clock.fi'
        include 'windattr.fi'
        include 'windtool.fi'
        include 'winline.fi'

        record /POINT/  lpCirTab(:)
        record /POINT/  ptTip   ! coordinates for the tip of the hand
        record /POINT/  ptTail  ! coordinates for the tail of the hand
        record /POINT/  ptSide  ! coordinates for the side of the hand
        integer         index   ! position index into the circle table
        integer*4       scale   ! ClockRadius percentage to scale drawing to

c$pragma array lpCirTab far

        ! set pattern mode for hand
        call SetROP2( hDC, 13 )

        ! select pen for hand
        call SelectObject( hDC, hPen )

        allocate( lpCirTab(0:HANDPOSITIONS-1), location=CirTab )

        ! compute coordinates for the side of the hand
        if( _hHand )then
            scale = ( ClockRadius * HOURSIDE ) / 100
        else
            scale = ( ClockRadius * MINUTESIDE ) / 100
        end if
        index = mod( pos + SIDESHIFT, HANDPOSITIONS )
        ptSide.y = (lpCirTab(index).y * scale) / CIRTABSCALE
        ptSide.x = (lpCirTab(index).x * scale) / CIRTABSCALE

        ! compute coordinates for the tip of the hand
        if( _hHand )then
            scale = ( ClockRadius * HOURTIP ) / 100
        else
            scale = ( ClockRadius * MINUTETIP ) / 100
        end if
        ptTip.y = (lpCirTab(pos).y * scale) / CIRTABSCALE
        ptTip.x = (lpCirTab(pos).x * scale) / CIRTABSCALE

        ! compute coordinates for the tail of the hand
        if( _hHand )then
            scale = ( ClockRadius * HOURTAIL ) / 100
        else
            scale = ( ClockRadius * MINUTETAIL ) / 100
        end if
        index = mod( pos + TAILSHIFT, HANDPOSITIONS )

        ptTail.y = (lpCirTab(index).y * scale) / CIRTABSCALE
        ptTail.x = (lpCirTab(index).x * scale) / CIRTABSCALE

        deallocate( lpCirTab )

        ! Draw tip of hand
        call MoveTo( hDC, ClockCenter.x + ptSide.x,
     &               ClockCenter.y + ptSide.y )
        call LineTo( hDC, ClockCenter.x +  ptTip.x,
     &               ClockCenter.y +  ptTip.y )
        call MoveTo( hDC, ClockCenter.x - ptSide.x,
     &               ClockCenter.y - ptSide.y )
        call LineTo( hDC, ClockCenter.x +  ptTip.x,
     &               ClockCenter.y +  ptTip.y )

        ! Draw tail of hand
        call MoveTo( hDC, ClockCenter.x + ptSide.x,
     &               ClockCenter.y + ptSide.y )
        call LineTo( hDC, ClockCenter.x + ptTail.x,
     &               ClockCenter.y + ptTail.y )
        call MoveTo( hDC, ClockCenter.x - ptSide.x,
     &               ClockCenter.y - ptSide.y )
        call LineTo( hDC, ClockCenter.x + ptTail.x,
     &               ClockCenter.y + ptTail.y )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : CircleClock
!
!  PURPOSE    : Resizes the clock rectangle to keep the face circular.
!
!-------------------------------------------------------------------------------

        subroutine CircleClock( maxWidth, maxHeight )
        integer*2 maxWidth    ! the maximum width of the clock face
        integer*2 maxHeight   ! the maximum height of the clock face

        include 'clock.fi'

        integer*2 clockHeight ! tallest height that will keep face circular
        integer*2 clockWidth  ! widest width that will keep face circular
        integer*2 VertEquiv
        integer*2 HorzEquiv

        if( maxWidth .gt. HorzEquiv( maxHeight ) )then
            ! too wide -- decrease width to keep face circular
            clockWidth = HorzEquiv( maxHeight )
            ClockRect.left = ClockRect.left +
     &                       ( maxWidth - clockWidth ) / 2
            ClockRect.right = ClockRect.left + clockWidth
        else
            ! too tall -- decrease height to keep face circular
            clockHeight = VertEquiv( maxWidth )
            ClockRect.top = ClockRect.top +
     &                      ( maxHeight - clockHeight ) / 2
            ClockRect.bottom = ClockRect.top + clockHeight
        end if

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : FWinMain
!
!  PURPOSE  : Calls the initialization function, creates the main application
!             window, and enters the message loop.
!
!-------------------------------------------------------------------------------

        integer*2 function FWINMAIN( hInstance,
     &                               hPrev,
     &                               lpszCmdLine,
     &                               cmdShow )
        integer*2 hInstance
        integer*2 hPrev
        integer*4 lpszCmdLine
        integer*2 cmdShow

        include 'clock.fi'
        include 'winresrc.fi'
        include 'winmodul.fi'
        include 'winsysm.fi'
        include 'wincreat.fi'
        include 'wininput.fi'
        include 'winerror.fi'
        include 'winmenu.fi'
        include 'winmsg.fi'
        include 'windisp.fi'

        integer*2     hWnd
        record /MSG/  msg
        integer*2     hMenu
        record /TIME/ nTime
        integer*2     sysWidth  ! width of left and right frames
        integer*2     sysHeight ! height of caption bar and top & bottom frames
        integer*2     width     ! width of entire clock window
        integer*2     height    ! height of entire clock window
        character*40  szTooMany
        logical       ClockInit
        integer*2     VertEquiv

        data bFirst/.TRUE./
        data bIconic/.FALSE./
        data TimerId/1/

        hInst = hInstance

        call LoadString( hInst, IDS_APPNAME, szBuffer, BUFLEN )

        if( .not. ClockInit() )then
            FWinMain = 0
            return
        end if
        if( hPrev .ne. NULL )then
            ! Not first instance -- get circle table and reset bFirst flag
            call GetInstanceData( hPrev, hCirTab, 2 )
            bFirst = .FALSE.
        end if

        call ClockCreate()

        ! compute window height and width
        sysWidth  = GetSystemMetrics( SM_CXFRAME ) * 2
        sysHeight = GetSystemMetrics( SM_CYCAPTION ) +
     &              2 * GetSystemMetrics( SM_CYFRAME )
        width = (_HorzRes / 3) + sysWidth
        height = VertEquiv( width ) + sysHeight

        hWnd = CreateWindow( _class,        ! class name
     &               'Clock'//char(0),      ! window name
     &               WS_TILEDWINDOW,        ! window style
     &               CW_USEDEFAULT,         ! use default positioning
     &               0,                     ! y not used
     &               width,                 ! window width
     &               height,                ! window height
     &               NULL,                  ! NULL parent handle
     &               NULL,                  ! NULL menu/child handle
     &               hInst,                 ! program instance
     &               NULL )                 ! NULL data structure reference

        call GetTime( nTime )
        call GetTime( oTime )
        while( ( nTime.second .eq. oTime.second ) .and.
     &         ( nTime.minute .eq. oTime.minute ) .and.
     &         ( nTime.hour   .eq. oTime.hour ) )do
            call GetTime( oTime )
        end while

        if( SetTimer( hWnd, TimerID, OPEN_TLEN, 0 ) .eq. 0 )then
            ! 16 public timers already in use -- post error and exit
            call LoadString( hInst, IDS_TOOMANY, szTooMany, 40 )
            call MessageBox( NULL, szTooMany, szBuffer,
     &                       MB_OK .or. MB_ICONHAND .or.
     &                       MB_SYSTEMMODAL )
            call DeleteTools()
            FWinMain = 0
            return
        end if

        ! Add the "About..." menu item to the bottom of the system menu
        call LoadString( hInst, IDS_ABOUTMENU, szBuffer, BUFLEN )
        hMenu = GetSystemMenu( hWnd, .FALSE. )
        call ChangeMenu( hMenu, 0, szBuffer, IDM_ABOUT,
     &                   MF_APPEND .or. MF_STRING )

        call ShowWindow( hWnd, cmdShow )

        ! Process messages until program termination
        while( GetMessage( msg, NULL, 0, 0 ) .ne. 0 )do
            call TranslateMessage( msg )
            call DispatchMessage( msg )
        end while


        FWinMain = msg.wParam

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : ClockInit
!
!  PURPOSE  : Registers the applicatoin window class and initializes the
!             circle values for the clock face.
!
!-------------------------------------------------------------------------------

        logical function ClockInit()

        include 'clock.fi'
        include 'win386.fi'
        include 'wincreat.fi'
        include 'winresrc.fi'
        include 'winerror.fi'
        include 'wincurs.fi'

        record /WNDCLASS/       ClockClass
        integer*2               hRes
        character*5             szData
        integer*4               cbp

        external                ClockWndProc
        integer*4               ClockWndProc

        integer*4               strlen
        external                strlen

        cbp = GetProc16( ClockWndProc, GETPROC_CALLBACK )

        write( _class, '(a,i5.5,a)' ) szBuffer(1:strlen(szBuffer)),
     &                                hinst, char(0)
        ClockClass.cbClsExtra    = 0
        ClockClass.cbWndExtra    = 0
        ClockClass.lpszMenuName  = 0
        ClockClass.lpszClassName = loc( _class )
        ClockClass.hbrBackground = NULL
        ClockClass.style         = CS_VREDRAW .or. CS_HREDRAW .or.
     &                             CS_BYTEALIGNCLIENT
        ClockClass.hInstance     = hInst
        ClockClass.lpfnWndProc   = cbp
        ClockClass.hCursor       = LoadCursor( NULL, IDC_ARROW )
        ClockClass.hIcon         = NULL

        if( RegisterClass( ClockClass ) .eq. 0 )then
            ! Error registering class -- return
            ClockInit = .FALSE.
            return
        endif

        ! Load in pre-computed circle table cosine values from resource file
        call LoadString( hInst, IDS_DATA, szData, 5 )
        hRes = FindResource( hInst, szBuffer, szData )
        if( hRes .eq. NULL )then
            ! Could not find circle table resource data -- return
            call MessageBox( NULL, 'No Circle Class'//char(0), char(0),
     &                       MB_OK .or. MB_ICONHAND .or.
     &                       MB_SYSTEMMODAL )
            ClockInit = .FALSE.
            return
        endif

        hCirTab = LoadResource( hInst, hRes )
        call LockResource( hCirTab )

        ClockInit = .TRUE.

        end