clock.for

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

!               aspect ratio and creates the necessary pens and brushes.
!               Then, if this is the first instance of the app running,
!               ClockCreate scales the circle table values according to the
!               aspect ratio. Finally, ClockCreate gets the initial time.
!
!-------------------------------------------------------------------------------

        subroutine ClockCreate()

        include 'clock.fi'
        include 'winpaint.fi'
        include 'windev.fi'
        include 'winmem.fi'

        integer         pos       ! hand position index into the circle table
        integer         _vertSize ! height of the display in millimeters
        integer         _horzSize ! width of the display in millimeters
        integer*2       hDC
        record /POINT/  lpCirTab(:)
        integer*2       VertEquiv
        integer*2       prev_vert

c$pragma array lpCirTab far

        ! Get display size in (pixels X raster lines)
        ! and in (millimeters X millimeters)
        hDC = GetDC( NULL )
        _VertRes = GetDeviceCaps( hDC, VERTRES )
        _HorzRes = GetDeviceCaps( hDC, HORZRES )
        _vertSize = GetDeviceCaps( hDC, VERTSIZE )
        _horzSize = GetDeviceCaps( hDC, HORZSIZE )
        call ReleaseDC( NULL, hDC )

        ! Compute (raster lines / decimeter) and (pixels / decimeter)
        AspectV = (_VertRes * MMPERDM) / _vertSize
        AspectH = (_HorzRes * MMPERDM) / _horzSize

        call CreateTools()

        ! Scale cosines for aspect ratio if this is the first instance
        if( bFirst )then
            allocate( lpCirTab(0:HANDPOSITIONS-1),
     &                location=GlobalLock( hCirTab ) )
            do pos = 0, HANDPOSITIONS - 1
                prev_vert = lpCirTab(pos).y
                lpCirTab(pos).y = VertEquiv( prev_vert )
            end do
            call GlobalUnlock( hCirTab )
            deallocate( lpCirTab )
        end if

        call GetTime( oTime )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : ClockSize
!
!  PURPOSE    : Resize the clock to the largest possible circle that will
!               fit in the client area. If switching from not iconic to
!               iconic, alter the timer to update every minute.  And if
!               switching back to non iconic, restore the timer to update
!               every second.
!
!-------------------------------------------------------------------------------

        subroutine ClockSize( hWnd, newWidth, newHeight, sizeType )
        integer*2       hWnd
        integer*2       newWidth
        integer*2       newHeight
        integer*2       sizeType

        include 'clock.fi'
        include 'winrect.fi'
        include 'wininput.fi'
        include 'winmsgs.fi'

        ! Set ClockRect to bound the largest possible circle in the window
        call SetRect( ClockRect, 0, 0, newWidth, newHeight )
        call CircleClock( newWidth, newHeight )

        if( sizeType .eq. SIZEICONIC )then
            ! Update once every minute in the iconic state
            call KillTimer( hWnd, TimerID )
            call SetTimer( hWnd, TimerID, ICON_TLEN, 0 )
            bIconic = .TRUE.
        else if( bIconic )then
            ! Update every second in the opened state (ignore tiling)
            call KillTimer( hWnd, TimerID )
            call SetTimer( hWnd, TimerID, OPEN_TLEN, 0 )
            bIconic = .FALSE.
        end if

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : ClockTimer
!
!  PURPOSE    : Update the clock to reflect the most recent time.
!
!-------------------------------------------------------------------------------

        subroutine ClockTimer( hWnd )
        integer*2       hWnd

        include 'clock.fi'
        include 'winpaint.fi'

        record /TIME/   nTime
        integer*2       hDC

        call GetTime( nTime )

        ! It's possible to change any part of the system at any time through
        ! the Control Panel. Check for any change in second, minute, or hour
        if( ( nTime.second .ne. oTime.second) .or.
     &      ( nTime.minute .ne. oTime.minute) .or.
     &      ( nTime.hour   .ne. oTime.hour ) )then
            ! The time has changed -- update the clock
            hDC = GetDC( hWnd )
            call ClockPaint( hWnd, hDC, HANDPAINT )
            call ReleaseDC( hWnd, hDC )
        end if

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : ClockPaint
!
!  PURPOSE    : Paint the clock to display the most recent time.
!
!-------------------------------------------------------------------------------

        subroutine ClockPaint( hWnd, hDC, paintType )
        integer*2       hWnd
        integer*2       hDC
        integer         paintType

        include 'clock.fi'
        include 'winmem.fi'
        include 'winpaint.fi'
        include 'windattr.fi'

        record /TIME/   nTime
        integer*2       HourHandPos

        call SetBkMode( hDC, TRANSPARENT )

        CirTab = GlobalLock( hCirTab )
        if( paintType .eq. PAINTALL )then
            ! Paint entire clock -- face and hands
            call FillRect( hDC, ClockRect, hbrBackgnd )
            call DrawFace( hDC )
            call DrawFatHand( hDC, HourHandPos( oTime ), hpenForegnd,
     &                        HHAND )
            call DrawFatHand( hDC, oTime.minute, hpenForegnd, MHAND )
            if( .not. bIconic )then
                ! Erase old second hand
                call DrawHand( hDC, oTime.second, hpenBackgnd,
     &                         SECONDTIP, R2_NOT )
            end if
        else if( paintType .eq. HANDPAINT )then
            call GetTime( nTime )

            if( ( .not. bIconic ) .and.
     &          ( nTime.second .ne. oTime.second ) )then
                ! Second has changed -- erase old second hand
                call DrawHand( hDC, oTime.second, hpenBackgnd,
     &                         SECONDTIP, R2_NOT )
            end if

            if( ( nTime.minute .ne. oTime.minute ) .or.
     &          ( nTime.hour .ne. oTime.hour ) )then
                ! Hour and/or minute have changed -- update hands
                if( bIconic )then
                    ! Erase old minute and hour hands
                    call DrawHand( hDC, oTime.minute, hpenBackgnd,
     &                             MINUTETIP, R2_COPYPEN )
                    call DrawHand( hDC, HourHandPos( oTime ),
     &                             hpenBackgnd, HOURTIP, R2_COPYPEN )

                    ! Draw new minute and hour hands
                    call DrawHand( hDC, nTime.minute, hpenForegnd,
     &                             MINUTETIP, R2_COPYPEN )
                    call DrawHand( hDC, HourHandPos( nTime ),
     &                             hpenForegnd, HOURTIP, R2_COPYPEN )
                else
                    ! Erase old minute and hour fat hands
                    call DrawFatHand( hDC, oTime.minute,
     &                                hpenBackgnd, MHAND )
                    call DrawFatHand( hDC, HourHandPos( oTime ),
     &                                hpenBackgnd, HHAND )

                    ! Draw new minute and hour fat hands
                    call DrawFatHand( hDC, nTime.minute,
     &                                hpenForegnd, MHAND )
                    call DrawFatHand( hDC, HourHandPos( nTime ),
     &                                hpenForegnd, HHAND )
                end if
            end if

            if( ( .not. bIconic ) .and.
     &          ( nTime.second .ne. oTime.second ) )then
                ! second has changed -- draw new second hand
                call DrawHand( hDC, nTime.second, hpenBackgnd,
     &                         SECONDTIP, R2_NOT )
            end if

            ! Store most recent time
            oTime.minute = nTime.minute
            oTime.hour   = nTime.hour
            oTime.second = nTime.second
        end if
        call GlobalUnlock( hCirTab )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : DrawFace
!
!  PURPOSE    : Draws the clock face.
!
!-------------------------------------------------------------------------------

        subroutine DrawFace( hDC )
        integer*2       hDC ! device context to be used when drawing face

        include 'clock.fi'
        include 'winpaint.fi'

        integer*2       pos       ! hand position index into the circle table
        integer*2       dotHeight ! height of the hour-marking dot
        integer*2       dotWidth  ! width of the hour-marking dot
        record /POINT/  dotCenter ! center point of the hour-marking dot
        record /RECT/   rc
        record /POINT/  lpCirTab(:)
        integer*2       VertEquiv

c$pragma array lpCirTab far

        ! Compute hour-marking dot width, height, and center point
        dotWidth = (MAXDOTWIDTH * (ClockRect.right - ClockRect.left)) /
     &              _HorzRes
        dotHeight = VertEquiv( dotWidth )

        if( dotHeight .lt. MINDOTHEIGHT )then
            dotHeight = MINDOTHEIGHT
        end if

        if( dotWidth .lt. MINDOTWIDTH )then
            dotWidth = MINDOTWIDTH
        end if

        dotCenter.x = dotWidth / 2
        dotCenter.y = dotHeight / 2

        ! Compute the clock center and radius
        call InflateRect( ClockRect, -dotCenter.y, -dotCenter.x )
        ClockRadius = ( ClockRect.right - ClockRect.left ) / 2
        ClockCenter.x = ClockRect.left + ClockRadius
        ClockCenter.y = ClockRect.top +
     &                  ( ClockRect.bottom - ClockRect.top ) / 2
        call InflateRect( ClockRect, dotCenter.y, dotCenter.x )

        ! Draw the large hour-marking dots and small minute-marking dots
        allocate( lpCirTab(0:HANDPOSITIONS-1), location=CirTab )
        do pos = 0, HANDPOSITIONS - 1
            rc.top = (lpCirTab(pos).y * ClockRadius) / CIRTABSCALE +
     &               ClockCenter.y
            rc.left = (lpCirTab(pos).x * ClockRadius) / CIRTABSCALE +
     &                ClockCenter.x
            if( mod( pos, 5 ) .ne. 0 )then
                if( ( dotWidth .gt. MINDOTWIDTH ) .and.
     &              ( dotHeight .gt. MINDOTHEIGHT ) )then
                    ! Draw small minute-marking dot
                    rc.right = rc.left + 1
                    rc.bottom = rc.top + 1
                    call FillRect( hDC, rc, hbrForegnd )
                end if
            else
                ! Draw large hour-marking dot
                rc.right = rc.left + dotWidth
                rc.bottom = rc.top + dotHeight
                call OffsetRect( rc, -dotCenter.x, -dotCenter.y )
                call FillRect( hDC, rc, hbrForegnd )
            end if
        end do
        deallocate( lpCirTab )

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : DrawHand
!
!  PURPOSE  : Draws a thin hand with the specified pen in the specified
!             hand position.
!
!-------------------------------------------------------------------------------

        subroutine DrawHand( hDC, pos, hPen, scale, patMode )
        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
        integer*4       scale   ! ClockRadius percentage to scale drawing to
        integer*4       patMode ! pattern mode to be used when drawing hand

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

        record /POINT/  lpCirTab(:)
        integer*4       radius

c$pragma array lpCirTab far

        ! scale length of hand
        radius = (ClockRadius * scale) / 100

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