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
113 lines
3.3 KiB
Fortran
5 years ago
|
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
|