screen.f90

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

SUBROUTINE CenterWindow( hwndChild, hwndParent )
USE DFWin
IMPLICIT NONE
INTEGER hwndChild, hwndParent
INCLUDE 'Resource.fd'

TYPE(T_RECT)   rChild, rParent
INTEGER         wChild, hChild, wParent, hParent
INTEGER         wScreen, hScreen, xNew, yNew
INTEGER         hdc
INTEGER * 4     retval

! Get the Height and Width of the child window
retval = GetWindowRect( hwndChild, rChild )
wChild = rChild.right - rChild.left
hChild = rChild.bottom - rChild.top

! Get the Height and Width of the parent window
retval = GetWindowRect( hwndParent, rParent )
wParent = rParent.right - rParent.left
hParent = rParent.bottom - rParent.top

! Get the display limits
hdc = GetDC( hwndChild )
wScreen = GetDeviceCaps( hdc, HORZRES )
hScreen = GetDeviceCaps( hdc, VERTRES )
retval = ReleaseDC( hwndChild, hdc )

! Calculate new X position, then adjust for screen
xNew = rParent.left + ( wParent - wChild ) / 2
IF( xNew .LT. 0 ) THEN
  xNew = 0
ELSE IF( xNew + wChild .GT. wScreen ) THEN
  xNew = wScreen - wChild
END IF

! Calculate new Y position, then adjust for screen
yNew = rParent.top  + ( hParent - hChild ) / 2
IF( yNew .LT. 0 ) THEN
  yNew = 0
ELSE IF( yNew + hChild .GT. hScreen ) THEN
  yNew = hScreen - hChild
END IF

! Set it, and return
retval = SetWindowPos( hwndChild, NULL, xNew, yNew, 0, 0,                      &
                       IOR( SWP_NOSIZE , SWP_NOZORDER ) )
END

SUBROUTINE ShowMessage( str )
USE DialogM
USE VFEAPGlobals
INCLUDE 'resource.fd'
CHARACTER * ( * ) str
LOGICAL retlog

retlog = DlgSet( gDlg, IDC_MESSAGE, TRIM( ADJUSTL( str ) ) )

END SUBROUTINE ShowMessage

SUBROUTINE ShowProcess( istep, nstep )
USE DFWin
USE DialogM
USE VFEAPGlobals
INCLUDE 'resource.fd'
CHARACTER * 16 strArrow
LOGICAL retlog

strArrow = '→↗↑↖←↙↓↘'
istr = MOD( istep - 1, 8 ) * 2 + 1
retlog = DlgSet( gDlg, IDC_RUN_PROGRESS, nstep, DLG_RANGE )
retlog = DlgSet( gDlg, IDC_RUN_PROGRESS, istep )
retlog = DlgSet( gDlg, IDC_ROTATE, strArrow(istr:istr+1) )

END SUBROUTINE ShowProcess

SUBROUTINE ShowTitle( str )
USE DialogM
USE VFEAPGlobals
INCLUDE 'resource.fd'
CHARACTER * ( * ) str
LOGICAL retlog

retlog = DlgSet( gDlg, IDC_TITLE, '正在分析：' // TRIM( ADJUSTL( str ) ) )

END SUBROUTINE ShowTitle

SUBROUTINE ShowTime( timec )
USE DialogM
USE VFEAPGlobals
IMPLICIT DOUBLE PRECISION( a-h, o-z )
INCLUDE 'resource.fd'
CHARACTER * 25 str
LOGICAL retlog

ichar = 25
WRITE( str, '(F25.10)' ) timec
DO WHILE( ichar .NE. 0 )
  IF( str( ichar:ichar ) .EQ. '0' ) THEN
    str( ichar:ichar ) = ' '
    ichar = ichar - 1
  ELSE IF( str( ichar:ichar ) .EQ. '.' ) THEN
    str( ichar:ichar ) = ' '
    ichar = 0
  ELSE
    ichar = 0
  END IF
END DO

retlog = DlgSet( gDlg, IDC_TIME, '当前时间：' // TRIM( ADJUSTL( str ) ) )

END SUBROUTINE ShowTime

SUBROUTINE ShowPhase( icase )
USE DialogM
USE VFEAPGlobals
IMPLICIT DOUBLE PRECISION( a-h, o-z )
INCLUDE 'resource.fd'
CHARACTER * 10 str
LOGICAL retlog

WRITE( str, '(I10)' ) icase
retlog = DlgSet( gDlg, IDC_PHASE, '当前组合：' // TRIM( ADJUSTL( str ) ) )

END SUBROUTINE ShowPhase


SUBROUTINE ShowError( tolmc, tolcc )
USE DialogM
USE VFEAPGlobals
IMPLICIT DOUBLE PRECISION( a-h, o-z )
INCLUDE 'resource.fd'
CHARACTER * 25 str
LOGICAL retlog

ichar = 25
WRITE( str, '(F25.8)' ) tolmc * 100.0D0
DO WHILE( ichar .NE. 0 )
  IF( str( ichar:ichar ) .EQ. '0' ) THEN
    str( ichar:ichar ) = ' '
    ichar = ichar - 1
  ELSE IF( str( ichar:ichar ) .EQ. '.' ) THEN
    str( ichar:ichar ) = ' '
    ichar = 0
  ELSE
    ichar = 0
  END IF
END DO
retlog = DlgSet( gDlg, IDC_TOL_ERR, '允许误差：' // TRIM( ADJUSTL( str ) ) // '%' )

ichar = 25
WRITE( str, '(F25.8)' ) tolcc * 100.0D0
DO WHILE( ichar .NE. 0 )
  IF( str( ichar:ichar ) .EQ. '0' ) THEN
    str( ichar:ichar ) = ' '
    ichar = ichar - 1
  ELSE IF( str( ichar:ichar ) .EQ. '.' ) THEN
    str( ichar:ichar ) = ' '
    ichar = 0
  ELSE
    ichar = 0
  END IF
END DO
retlog = DlgSet( gDlg, IDC_CAL_ERR, '计算误差：' // TRIM( ADJUSTL( str ) ) // '%' )

END SUBROUTINE ShowError

SUBROUTINE ShowShown( itypc, inodc, idofc )
USE DialogM
USE VFEAPGlobals
IMPLICIT DOUBLE PRECISION( a-h, o-z )
INCLUDE 'resource.fd'
CHARACTER * 10 str
LOGICAL retlog

WRITE( str, '(I10)' ) inodc
retlog = DlgSet( gDlg, IDC_SHOWN_NODE, '显示节点：' // TRIM( ADJUSTL( str ) ) )

IF( itypc .EQ. 0 ) str = '位移'
IF( itypc .EQ. 1 ) str = '位移'
IF( itypc .EQ. 2 ) str = '速度'
IF( itypc .EQ. 3 ) str = '加速度'
retlog = DlgSet( gDlg, IDC_SHOWN_TYPE, '显示类型：' // TRIM( ADJUSTL( str ) ) )

WRITE( str, '(I10)' ) idofc
retlog = DlgSet( gDlg, IDC_SHOWN_DOF, '自由度序：' // TRIM( ADJUSTL( str ) ) )

END SUBROUTINE ShowShown

SUBROUTINE ShowGraph( x, y, flag )
USE DFWin
USE dfwina
USE XYPlot
USE DialogM
USE VFEAPGlobals
IMPLICIT DOUBLE PRECISION( a-h, o-z )
INCLUDE 'resource.fd'

LOGICAL * 4 bRet, bValid
INTEGER hDC, hWnd
INTEGER lRet, flag, np
DOUBLE PRECISION xmin, xmax, ymin, ymax
DOUBLE PRECISION xp( 1024 ), yp( 1024 )
SAVE np, xp, yp, xmin, xmax, ymin, ymax

hWnd = GetDlgItem( ghwndMain, IDC_PICTURE )
hDC = GetDC( hWnd )

SELECT CASE( flag )
  CASE( -1 )
    np = np - 1
	CALL InitPlot()
	CALL DrawAxis()
	CALL DrawCurve( xp, yp, np )
  CASE(  0 )
    np = 0
	xmin = 5.0D8
	xmax =-5.0D8
	ymin = 5.0D8
	ymax =-5.0D8
    CALL SetDownUp( .TRUE. )
    CALL SetHandles( hDC, hWnd )
    CALL SetWindowBoundary( 0.1D0, 0.9D0, 0.1D0, 0.9D0 )
	CALL SetXYBoundary( -5.0D0, 5.0D0, -5.0D0, 5.0D0 )
	CALL InitPlot()
	CALL DrawAxis()
  CASE(  1 )
    np = np + 1
	IF( np .GT. 1024 ) RETURN
	xp( np ) = x
	yp( np ) = y

	bRet = .FALSE.
    IF( x .LT. xmin ) THEN
      xmin = x
      bRet = .TRUE.
    END IF
    IF( x .GT. xmax ) THEN
      xmax = x
      bRet = .TRUE.
	END IF

    IF( y .LT. ymin ) THEN
      ymin = y
      bRet = .TRUE.
    END IF
    IF( y .GT. ymax ) THEN
      ymax = y
      bRet = .TRUE.
	END IF
	IF( np .LT. 2 ) RETURN

	bValid = .TRUE.
	IF( DABS( xmax - xmin ) .LT. 1.0D-8 ) bValid = .FALSE.
	IF( DABS( ymax - ymin ) .LT. 1.0D-8 ) bValid = .FALSE.

	IF( bRet .AND. bValid ) THEN
      CALL SetXYBoundary( xmin, xmax, ymin, ymax )
	  CALL DrawAxis()
	  CALL DrawCurve( xp, yp, np )
	ELSE IF( bValid ) THEN
	  CALL AddLine( xp( np - 1 ), yp( np - 1 ), x, y )
	ELSE IF( bRet ) THEN
      CALL SetXYBoundary( xmin - 0.5D0, xmax + 0.5D0, ymin - 0.5D0, ymax + 0.5D0 )
	  CALL DrawAxis()
	  CALL DrawCurve( xp, yp, np )
    ELSE
	  CALL AddLine( xp( np - 1 ), yp( np - 1 ), x, y )
	END IF
  CASE DEFAULT
END SELECT

lRet = ReleaseDC( hWnd, hDC )
END SUBROUTINE ShowGraph