clock.for

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

!-------------------------------------------------------------------------------
!
!  PROGRAM    : clock.for
!
!  PURPOSE    : To give a demonstration on the use of a timer in a windows
!               application.
!
!  PROCEDURES : HourHandPos  - Computes the hour hand position based on
!                              both the hour and minute values.
!
!               VertEquiv    - Computes the raster line equivalent to the
!                              given pixel value.
!
!               HorzEquiv    - Computes the pixel equivalent to the given
!                              raster line value.
!
!               About        - Dialog function for the About Dialog.
!
!               ClockWndProc - Window function for the application.
!
!               CreateTools  - Creates brushes and pens to coincide with
!                              the current system colors.
!
!               DeleteTools  - Destroys the brushes and pens created by
!                              CreateTools.
!
!               ClockCreate  - Performs the necessary initialization for
!                              drawing the clock correctly and gets the
!                              initial time to be displayed by the clock.
!
!               ClockSize    - Resize the clock to the largest possible
!                              circle that will fit in the client area.
!
!               ClockTimer   - Update the clock to reflect the most recent
!                              time.
!
!               ClockPaint   - Paint the clock to display the most recent
!                              time.
!
!               DrawFace     - Draws the clock face.
!
!               DrawHand     - Draws a thin hand with the specified brush
!                              in the specified hand position.
!
!               DrawFatHand  - Draws a fat hand with the specified brush
!                              in the specified hand position.
!
!               CircleClock  - Resizes clock rectangle to keep clock
!                              circular.
!
!               WinMain      - Calls the initialization function, creates
!                              the main application window, and enters the
!                              message loop.
!
!               ClockInit    - Registers the application window class and
!                              initializes the circle values for the clock
!                              face.
!
!-------------------------------------------------------------------------------

c$include winapi.fi

!-------------------------------------------------------------------------------
!
!  FUNCTION : strlen
!
!  PURPOSE  : length of NULL-terminated string
!
!-------------------------------------------------------------------------------

        integer*4 function strlen( str )

        character*(*) str

        do strlen = 1, len( str )
            if( str(strlen:strlen) .eq. char(0) ) quit
        end do

        strlen = strlen - 1

        end

!-------------------------------------------------------------------------------
!
!  SUBROUTINE : GetTime
!
!  PURPOSE    : Get current time from system
!
!-------------------------------------------------------------------------------

        subroutine GetTime( time )

        include 'clock.fi'

        record /time/ time
        integer*2 tics

        call gettim( time.hour, time.minute, time.second, tics )
        if( time.hour .ge. 12 ) time.hour = time.hour - 12

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : HourHandPos
!
!  PURPOSE  : Computes the hour hand position based on both the hour and
!             minute values in the given time record.
!
!-------------------------------------------------------------------------------

        integer*2 function HourHandPos( time )

        include 'clock.fi'

        record /time/ time

        HourHandPos = ( time.hour * 5)  + ( time.minute / 12 )

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : VertEquiv
!
!  PURPOSE  : Computes the raster line (vertical) equivalent to the given
!             pixel (horizontal) value.
!
!-------------------------------------------------------------------------------

        integer*2 function VertEquiv( lengthH )

        integer*2 lengthH

        include 'clock.fi'

        VertEquiv = ( lengthH * AspectV ) / AspectH

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : HorzEquiv
!
!  PURPOSE  : Computes the pixel (horizontal) equivalent to the given
!             raster line (vertical) value.
!
!-------------------------------------------------------------------------------

        integer*2 function HorzEquiv( lengthV )

        integer*2 lengthV

        include 'clock.fi'

        HorzEquiv = ( lengthV * AspectH ) / AspectV

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : About
!
!  PURPOSE  : Dialog function for the "About..." menu item dialog.
!
!-------------------------------------------------------------------------------

c$pragma aux (callback) About parm( value, value, value, value )

        integer*4 function About( hDlg, message, wParam, lParam )

        integer*2 hDlg
        integer*2 message
        integer*2 wParam
        integer*4 lParam

        include 'clock.fi'
        include 'winmsgs.fi'
        include 'windlg.fi'

        select case( message )
        case( WM_COMMAND )
            call EndDialog( hDlg, 1 )
            About = 1
        case( WM_INITDIALOG )
            About = 1
        case default
            About = 0
        end select

        end


!-------------------------------------------------------------------------------
!
!  FUNCTION : ClockWndProc
!
!  PURPOSE  : Window function for the application.
!
!-------------------------------------------------------------------------------

c$pragma aux (callback) ClockWndProc parm( value, value, value, value )

        integer*4 function ClockWndProc( hWnd, msg, wParam, lParam )

        include 'clock.fi'
        include 'win386.fi'
        include 'winmsgs.fi'
        include 'winmsg.fi'
        include 'winpaint.fi'
        include 'windlg.fi'
        include 'wincreat.fi'
        include 'wininput.fi'
        include 'windisp.fi'
        include 'winutil.fi'
        include 'winmodul.fi'

        integer*2       hWnd
        integer*2       msg
        integer*2       wParam
        integer*4       lParam

        integer*4               cbp
        record /RECT/           rc
        record /PAINTSTRUCT/    ps
        external                About
        integer*4               About

        select case( msg )
        case( WM_SYSCOMMAND )
            if( wParam .eq. IDM_ABOUT )then
                ! Draw and handle messages for the "About..." Dialog
                cbp = GetProc16( About, GETPROC_CALLBACK )
                call DialogBox( hInst, MAKEINTRESOURCE( 1 ),
     &                          hWnd, MakeProcInstance( cbp, hInst ) )
                call ReleaseProc16( cbp )
            else
                ! Perform the default window processing
                ClockWndProc = DefWindowProc( hWnd, msg, wParam,lParam )
                return
            end if
        case( WM_SIZE )
            ! Resize clock based on window size and redraw
            call ClockSize( hWnd, LOWORD( lParam ), HIWORD( lParam ),
     &                      wParam )
            call UpdateWindow( hWnd )
        case( WM_DESTROY )
            ! Destroy clock's timer and tools before exiting
            call KillTimer( hWnd, TimerID )
            call DeleteTools()
            call PostQuitMessage( 0 )
        case( WM_PAINT )
            ! Paint clock displaying current time
            call InvalidateRect( hWnd, NULL_POINTER, .TRUE. )
            call BeginPaint( hWnd, ps )
            call ClockPaint( hWnd, ps.hdc, PAINTALL )
            call EndPaint( hWnd, ps )
        case( WM_TIMECHANGE, WM_TIMER )
            ! Update clock to display new time
            call ClockTimer( hWnd )
        case( WM_SYSCOLORCHANGE )
            ! Change tools to coincide with system window colors
            call DeleteTools()
            call CreateTools()
        case( WM_ERASEBKGND )
            ! Paint over the entire client area
            call GetClientRect( hWnd, rc )
            call FillRect( wParam, rc, hbrBackgnd )
        case default
            ! Perform the default window processing
            ClockWndProc = DefWindowProc( hWnd, msg, wParam, lParam )
            return
        end select

        ClockWndProc = 0

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : CreateTools
!
!  PURPOSE    : Creates brushes and pens to coincide with the current
!               system colors.
!
!-------------------------------------------------------------------------------

        subroutine CreateTools()

        include 'clock.fi'
        include 'windtool.fi'
        include 'winsysm.fi'

        hbrForegnd = CreateSolidBrush( GetSysColor( COLOR_WINDOWTEXT ) )
        hbrBackgnd = CreateSolidBrush( GetSysColor( COLOR_WINDOW ) )
        hpenForegnd = CreatePen( 0, 1, GetSysColor( COLOR_WINDOWTEXT ) )
        hpenBackgnd = CreatePen( 0, 1, GetSysColor( COLOR_WINDOW ) )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : DeleteTools
!
!  PURPOSE    : Destroys the brushes and pens created by CreateTools.
!
!-------------------------------------------------------------------------------

        subroutine DeleteTools()

        include 'clock.fi'
        include 'windtool.fi'

        call DeleteObject( hbrForegnd )
        call DeleteObject( hbrBackgnd )
        call DeleteObject( hpenForegnd )
        call DeleteObject( hpenBackgnd )

        end


!-------------------------------------------------------------------------------
!
!  SUBROUTINE : ClockCreate
!
!  PURPOSE    : First, for drawing the clock, ClockCreate computes the