draw.f90

边界元程序,供力学工作者参考,希望对大家有所帮助

MODULE XYPlot
USE DFLIB
IMPLICIT NONE

LOGICAL mbDownUp
INTEGER mhDC, mhWnd
INTEGER mxScale, myScale
INTEGER mleft, mright, mtop, mbottom
DOUBLE PRECISION mxmax, mxmin, mymax, mymin
DOUBLE PRECISION xstep, ystep

DATA mxmax/-1.0D8/, mxmin/1.0D8/, mymax/-1.0D8/, mymin/1.0D8/
INTEGER * 4, PARAMETER, PRIVATE :: GRIDCOLOR = 16#01000006
INTEGER * 4, PARAMETER, PRIVATE :: LINECOLOR = 16#01000005
INTEGER * 4, PARAMETER, PRIVATE :: ERASCOLOR = 16#01050505

CONTAINS
	SUBROUTINE SetHandles( hDC, hWnd )
	IMPLICIT NONE
	INTEGER hDC, hWnd
	mhDC = hDC
	mhWnd = hWnd
	END SUBROUTINE SetHandles

	SUBROUTINE SetDownUp( bDownUp )
	IMPLICIT NONE
	LOGICAL bDownUp
	mbDownUp = bDownUp
	END SUBROUTINE SetDownUp

	SUBROUTINE SetWindowBoundary( left, right, top, bottom )
	use dfwina
    USE User32
	IMPLICIT NONE
	LOGICAL bRet
	type(T_RECT) wndRect
	DOUBLE PRECISION left, right, top, bottom

	IF( right .GT. 1 .AND. bottom .GT. 1 ) THEN
		mtop = INT( top )
		mleft = INT( left )
		mright = INT( right )
		mbottom = INT( bottom )
	ELSE
        bRet = GetClientRect( mhWnd, wndRect )
		mtop = wndRect%top + INT( top * ( wndRect%bottom - wndRect%top ) )
		mbottom = wndRect%top + INT( bottom * ( wndRect%bottom - wndRect%top ) )
		mright = wndRect%left + INT( right * ( wndRect%right - wndRect%left ) )
		mleft = wndRect%left + INT( left * ( wndRect%right - wndRect%left ) )
	END IF
	END SUBROUTINE SetWindowBoundary

	SUBROUTINE SetXYBoundary( xmin, xmax, ymin, ymax )
	IMPLICIT DOUBLE PRECISION( a-h, o-z )
	IMPLICIT INTEGER( i-n )
	LOGICAL bRet

    bRet = .TRUE.
    IF( xmin .LT. mxmin ) bRet = .FALSE.
    IF( xmax .GT. mxmax ) bRet = .FALSE.
    IF( ymin .LT. mymin ) bRet = .FALSE.
    IF( ymax .GT. mymax ) bRet = .FALSE.
	IF( bRet ) RETURN

	mxmin = xmin
	mxmax = xmax
	mymin = ymin
	mymax = ymax

	nx = 0
	xl = DABS( mxmax - mxmin )
	xstep = xl / 5.0D0
	DO WHILE( xstep .LT. 1.0D0 )
	  xstep = xstep * 10.0D0
	  nx = nx - 1
	END DO
	DO WHILE( xstep .GE. 10.0D0 )
	  xstep = xstep / 10.0D0
	  nx = nx + 1
	END DO
	mxScale = nx
	xstep = INT( xstep + 0.5D0 )
	xstep = xstep * 10.0D0 ** nx
	mxmin = INT( mxmin / xstep - 0.9D0 ) * xstep
	mxmax = INT( mxmax / xstep + 2.0D0 ) * xstep

	ny = 0
	yl =   DABS( mymax - mymin )
	ystep = yl / 5.0D0
	DO WHILE( ystep .LT. 1.0D0 )
	  ystep = ystep * 10.0D0
	  ny = ny - 1
	END DO
	DO WHILE( ystep .GE. 10.0D0 )
	  ystep = ystep / 10.0D0
	  ny = ny + 1
	END DO
	myScale = ny
	ystep = INT( ystep + 0.5D0 )
	ystep = ystep * 10.0D0 ** ny
	mymin = INT( mymin / ystep - 2.0D0 ) * ystep
	mymax = INT( mymax / ystep + 2.0D0 ) * ystep

	CALL InitPlot()
	END SUBROUTINE SetXYBoundary

	INTEGER FUNCTION GetScreenX( x )
	DOUBLE PRECISION x
	GetScreenX = INT( mleft + ( mright - mleft ) * ( x - mxmin) / ( mxmax - mxmin ) )
	END FUNCTION GetScreenX

	INTEGER FUNCTION GetScreenY( y )
	DOUBLE PRECISION y
	IF( mbDownUp ) THEN
		GetScreenY = INT( mbottom + ( mtop - mbottom ) * ( y - mymin) / ( mymax - mymin ) )
	ELSE
		GetScreenY = INT( mtop + ( mbottom - mtop ) * ( y - mymin) / ( mymax - mymin ) )
	END IF
	END FUNCTION GetScreenY

	SUBROUTINE DrawAxis
	use dfwina
	USE User32
	IMPLICIT DOUBLE PRECISION( a-h, o-z )
    CHARACTER * 30 str
	INTEGER hGridPen, hAxisPen
	INTEGER ix, iy, Ret, lRet, ichar
	LOGICAL bRet

	type(T_RECT) wndRect

	hGridPen = CreatePen( PS_SOLID, 1, GRIDCOLOR )
	hAxisPen = CreatePen( PS_SOLID, 2, GRIDCOLOR )
	Ret  = SelectObject( mhDC, hGridPen )

	DO y = mymin, mymax + ystep / 2.0D0, ystep
		iy = GetScreenY( y )
		ix = GetScreenX( mxmin )
		bRet = MoveToEx( mhDC, ix, iy, NULL_POINT )
		ix = GetScreenX( mxmax )
		bRet = LineTo( mhDC, ix, iy )
		IF( y .GE. 0.0D0 ) ichar = INT( y / 10.0D0 ** myScale + 0.5D0 )
		IF( y .LT. 0.0D0 ) ichar = INT( y / 10.0D0 ** myScale - 0.5D0 )
		WRITE( str, '(I3)' ) ichar
		str = TRIM( ADJUSTL( str ) )
		CALL TextOut( mhDC, ix + 8, iy - 8, str, 3 )
	END DO

	DO x = mxmin, mxmax + xstep / 2.0D0, xstep
		ix = GetScreenX( x )
		iy = GetScreenY( mymin )
		bRet = MoveToEx( mhDC, ix, iy, NULL_POINT )
		iy = GetScreenY( mymax )
		bRet = LineTo( mhDC, ix, iy )
		IF( x .GE. 0.0D0 ) ichar = INT( x / 10.0D0 ** mxScale + 0.5D0 )
		IF( x .LT. 0.0D0 ) ichar = INT( x / 10.0D0 ** mxScale - 0.5D0 )
		WRITE( str, '(I3)' ) ichar
		str = TRIM( ADJUSTL( str ) )
		CALL TextOut( mhDC, ix - 10, iy - 20, str, 3 )
	END DO

	iy = GetScreenY( mymin ) + 50
	ix = GetScreenX( ( mxmin + mxmax ) / 2.0D0 ) - 100
	WRITE( str, '( "横坐标×10E", I2, "，纵坐标×10E", I2 )' ) mxScale, myScale
	str = TRIM( ADJUSTL( str ) )
	CALL TextOut( mhDC, ix - 10, iy - 16, str, 30 )

	bRet = DeleteObject( hGridPen )
	bRet = DeleteObject( hAxisPen )
	END SUBROUTINE DrawAxis

	SUBROUTINE InitPlot()
	use dfwina
	USE User32
	LOGICAL bRet
	INTEGER lRet
	INTEGER hErasPen
	type(T_RECT) wndRect
	type(T_PAINTSTRUCT) ps

    bRet = GetClientRect( mhWnd, wndRect )
	hErasPen = CreatePen( PS_SOLID, 1, ERASCOLOR )
	lRet = SelectObject( mhDC, hErasPen )
	lRet = Rectangle( mhDC, wndRect%left + 1, wndRect%top + 1, wndRect%right - 1, wndRect%bottom - 1 )
	lRet = FloodFill( mhDC, wndRect%left + 3, wndRect%top + 3, ERASCOLOR )

	bRet = DeleteObject( hErasPen )
	END SUBROUTINE InitPlot

	SUBROUTINE DrawCurve( xp, yp, np )
	use dfwina
	LOGICAL bRet
	INTEGER hLinePen, Ret
	INTEGER ix, iy, ip, np
	DOUBLE PRECISION xp( np ), yp( np )

	IF( np .LE. 1 ) RETURN
	hLinePen = CreatePen( PS_SOLID, 2, LINECOLOR )
	Ret  = SelectObject( mhDC, hLinePen )

	ix = GetScreenX( xp( 1 ) )
	iy = GetScreenY( yp( 1 ) )
	bRet = MoveToEx( mhDC, ix, iy, NULL_POINT )

	DO ip = 2, np
	  ix = GetScreenX( xp( ip ) )
	  iy = GetScreenY( yp( ip ) )
	  bRet = LineTo( mhDC, ix, iy )
	END DO

	bRet = DeleteObject( hLinePen )

	END SUBROUTINE DrawCurve

	SUBROUTINE AddLine( x1, y1, x2, y2 )
	use dfwina
	INTEGER ix, iy
	INTEGER hLinePen, Ret
	DOUBLE PRECISION x1, y1, x2, y2
	LOGICAL bRet

	hLinePen = CreatePen( PS_SOLID, 2, LINECOLOR )
	Ret  = SelectObject( mhDC, hLinePen )

	ix = GetScreenX( x1 )
	iy = GetScreenY( y1 )
	bRet = MoveToEx( mhDC, ix, iy, NULL_POINT )

	ix = GetScreenX( x2 )
	iy = GetScreenY( y2 )
	bRet = LineTo( mhDC, ix, iy )

	bRet = DeleteObject( hLinePen )

	END SUBROUTINE AddLine
END MODULE XYPlot