! Compile & link using FTN95 in DOS box. Run: ! FTN95 factor.f95 /link ! ! For testing, you can download the FTN95 Personal Edition (FTN95PE) version from ! http://silverfrost.com/32/ftn95/ftn95_personal_edition.aspx ! ! ------------------------------------------------------------- ! QT software GmbH Konstanzer Strasse 10 D-10707 Berlin ! Tel. +49(0)30/9290087-0 Fax. -2 eMail: admin@qtsoftware.de ! Info http://www.qtsoftware.de Shop http://www.qtsoftware.com ! ============================================================= WINAPP MODULE CommonVars IMPLICIT NONE INCLUDE INTEGER number CHARACTER*50 str END MODULE CommonVars PROGRAM Factor USE CommonVars IMPLICIT NONE INTEGER, EXTERNAL :: factoriser, about INTEGER ans number=1 str=' ' ans=winio@('%mn[&File[E&xit]]&','EXIT') ans=winio@('%mn[&Help[&About Number Factoriser]]&',about) ans=winio@('%il&',1,2147483647) ans=winio@('Number to be factorised: %rd&',number) ans=winio@('%ta%`^bt[Fac&torise]&',factoriser) ans=winio@('%2nl%ob%42st%cb',str) END PROGRAM Factor INTEGER FUNCTION factoriser() USE CommonVars INTEGER n,k CHARACTER*50 val WRITE(val,'(i11)')number CALL trim@(val) str='The factors of '//val(1:LENG(val))//' are: 1' n=number 1 DO k=2,n IF((n/k)*k.EQ.n)THEN WRITE(val,'(i11)')k CALL trim@(val) CALL append_string@(str,', '//val) n=n/k IF(n.GT.1)GOTO 1 ENDIF END DO CALL window_update@(str) factoriser=1 END FUNCTION factoriser INTEGER FUNCTION about() USE CommonVars IMPLICIT NONE INTEGER ans INTEGER, EXTERNAL:: cbWeb ans=winio@('%ca[About Number Factoriser]&') ans=winio@('%fn[Times New Roman]%ts%bf%cnTutorial&',2.0D0) ans=winio@('%ts%3nl&',1.0D0) ans=winio@('%cnProgram developed to demonstrate%2nl&') ans=winio@('%ts%tc%cn%bfClearWin+&',1.5D0,RGB@(255,0,0)) ans=winio@('%tc%sf%2nl%cnby Salford Software Ltd (modified by QT software GmbH)&',-1) ans=winio@('%2nl%cnClearWin+ is part of FTN95 which is available from&') ans=winio@('%nl%cnwww.qtsoftware.com www.polyhedron.com&') ans=winio@('%2nl%cn%20`bt[OK (Close this window)]&') ans=winio@('%2nl%100.30^wb[http://www.qtsoftware.de/oxShop/en/Compiler-Systems/Fortran/for-Windows/' & // 'FTN95-for-Microsoft-NET-Windows.html]', cbWeb) about=1 END FUNCTION about integer function cbWeb() use clrwin$ character(len=256)::reason, url reason = clearwin_string$("CALLBACK_REASON") url = clearwin_string$("CURRENT_URL") !print*, reason(1:len_trim(reason)), " = ", url(1:len_trim(url)) cbWeb = 2 end function