You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

113 lines
3.3 KiB
Fortran

SUBROUTINE RESETREG
USE WINTERACTER
INCLUDE 'TXFRM.COM'
INCLUDE 'BFILES.I90'
CHARACTER*1 IFLAG
XORIGMIN=BFMINMAX(NBKFL,1)
YORIGMIN=BFMINMAX(NBKFL,2)
XORIGMAX=BFMINMAX(NBKFL,3)
YORIGMAX=BFMINMAX(NBKFL,4)
CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to stretch/move using current screen? (YES)'//char(13)//&
'Or apply coordinate shift (NO)'//&
CHAR(13)//' ','REGISTRATION OPTION')
!
! If answer 'No', return
!
IF (WInfoDialog(4).EQ.2) THEN
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Click on start point','CHOOSE START')
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
XORGG = XTEMP*TXSCAL - XS
YORGG = YTEMP*TXSCAL - YS
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Click on end point','CHOOSE START')
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
XFING = XTEMP*TXSCAL - XS
YFING = YTEMP*TXSCAL - YS
XSHIFT=XFING-XORGG
YSHIFT=YFING-YORGG
BFMINMAX(NBKFL,1)=BFMINMAX(NBKFL,1)+XSHIFT
BFMINMAX(NBKFL,2)=BFMINMAX(NBKFL,2)+YSHIFT
BFMINMAX(NBKFL,3)=BFMINMAX(NBKFL,3)+XSHIFT
BFMINMAX(NBKFL,4)=BFMINMAX(NBKFL,4)+YSHIFT
GO TO 100
ENDIF
! get reference point
! xrefpt
! yrefpt
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Fixed Reference point','CHOOSE REFERENCE')
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
XREFPT = XTEMP*TXSCAL - XS
YREFPT = YTEMP*TXSCAL - YS
! get start move point
! xlocs
! ylocs
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Starting point','CHOOSE START')
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
XLOCS = XTEMP*TXSCAL - XS
YLOCS = YTEMP*TXSCAL - YS
! get finish move point
! xlocf
! ylocf
CALL WMessageBox(OKOnly,ExclamationIcon,CommonOK,'Select Finishing point','CHOOSE FINISH')
CALL XYLOC(XTEMP,YTEMP,IFLAG,IBOX)
XLOCF = XTEMP*TXSCAL - XS
YLOCF = YTEMP*TXSCAL - YS
! establish x moves
stscal=(xlocf-xrefpt)/(xlocs-xrefpt)
xnewmin=xrefpt-(xrefpt-xorigmin)*stscal
xnewmax=xrefpt+(xorigmax-xrefpt)*stscal
! establish y moves
stscal=(ylocf-yrefpt)/(ylocs-yrefpt)
ynewmin=yrefpt-(yrefpt-yorigmin)*stscal
ynewmax=yrefpt+(yorigmax-yrefpt)*stscal
BFMINMAX(NBKFL,1)=xnewmin
BFMINMAX(NBKFL,2)=ynewmin
BFMINMAX(NBKFL,3)=xnewmax
BFMINMAX(NBKFL,4)=ynewmax
100 CONTINUE
CALL CLSCRN
CALL PLOTOT(1)
CALL WMessageBox(YesNo,QuestionIcon,CommonOK,'Do you wish to use and save'//&
CHAR(13)//'this registration?','CHOOSE REGISTRATION?')
!
! If answer NO revert
!
IF (WInfoDialog(4) .EQ. 2) then
BFMINMAX(NBKFL,1)=XORIGMIN
BFMINMAX(NBKFL,2)=YORIGMIN
BFMINMAX(NBKFL,3)=XORIGMAX
BFMINMAX(NBKFL,4)=YORIGMAX
CALL CLSCRN
CALL PLOTOT(1)
else
!
! otherwise SAVE
CALL SAVORG(NBKFL,2)
END IF
!
RETURN
END