: - . . ( . .)

:

: 1157


4.

 

4.1. . 3.1 (

Standard Graphic Application)

 

use msflib ! 1

integer(2) st

type (xycoord) pos

call setlinestyle(#0FFF)

do i = 1,15

st = setcolor(i)

do t = 0,6.28,0.0314

call moveto (400,300,pos)

call sleepqq(4)

st = lineto(int((300-15*i)*sin(t))+400,int((300-15*i)*cos(t))+300)

enddo

enddo

nd

 

use msflib ! 2

integer(2) st

real(8) xmin,ymin,xmax,ymax,x,y

type (windowconfig) wc

type (wxycoord) pos

dimension x(100),y(100)

t = 0

do i= 1,100

x(i) =38*cos(t)+7*cos(19*t); y(i) =38*sin(t)-7*sin(19*t); t = t+0.0628

enddo

xmin=minval(x); xmax=maxval(x); ymin=minval(y); ymax=maxval(y)

CALL SETVIEWPORT (0, 0, 320, 240)

st = setwindowconfig(wc)

st = setwindow(.true.,2*xmin,2*ymin,2*xmax,2*ymax)

st =setcolor(12)

call moveto_w(x(1),y(1),pos)

do i=1,100

st=lineto_w(x(i),y(i))

call sleepqq(50)

enddo

end

 

use msflib ! 3

integer(4) color,st

color=1

do r=4,500

do t=0,6.28,6.28/720

st=setcolorrgb(color)

st=setpixel(int(r*sin(t)**2),int(r+cos(t)))

color=color+10*int(r*sin(t))+20*int(r*cos(2*t))

enddo

color=mod(color,500)

enddo

end

 

use msflib ! 4

integer*4 color,st

color=1

do r=4,500,1

do t=0,6.28,6.28/720.

 

st=setcolorrgb(color)

 

st=setpixel(int(r*sin(t)**5+400),int(r*cos(t)+300))

color=color+10*int(r*sin(t))+20*int(r*cos(2*t)**3)

enddo

color=mod(color,64000)+2

enddo

end

 

USE MSFLIB ! 5

INTEGER(2) status

TYPE (xycoord) poly(12)

dimension K(24)

data K/50,80,85,35,185,35,150,80,50,80,50,180,150,&

180,185,135,185,35,150,80,150,180,150,80/

do i=1,12

poly(i).xcoord=K(2*i-1)

poly(i).ycoord=K(2*i)

enddo

do i=1,10

call clearscreen($gclearscreen)

status = SETCOLOR(14)

status = POLYGON($GBORDER, poly, INT2(12))

status=setcolor(i)

status=floodfill(51,81,14)

call sleepqq(100)

status=setcolor(i+1)

status=floodfill(60,70,14)

call sleepqq(100)

status=setcolor(i+2)

status=floodfill(155,80,14)

call sleepqq(100)

enddo

end

 

USE MSFLIB ! 6

INTEGER(2) fontnum, numfonts

INTEGER(4) oldcolor, deg

TYPE (xycoord) pos

numfonts = INITIALIZEFONTS ( )

fontnum = SETFONT ('t''Arial''h25w15i')

deg=0

do i=1,36

 

CALL SETGTEXTROTATION(deg*100)

oldcolor = SETCOLOR(mod(i,16))

CALL MOVETO (320, 240, pos)

CALL OUTGTEXT('TEXT ROTATION')

deg = deg+1

call sleepqq(100)

call beepqq(i*30,50)

enddo

END

 

USE MSFLIB 7

INTEGER(1) style(8,8)

data style(1,:) /24,60,90,159,24,24,24,24/

data style(2,:) /24,36,66,129,129,66,36,24/

data style(3,:) /1,2,4,8,16,32,64,128/

data style(4,:) /128,64,32,16,8,4,2,1/

data style(5,:) /145,211,82,82,52,52,24,24/

data style(6,:) /1,3,5,9,25,37,67,129/

data style(7,:) /254,128,128,254,1,1,1,254/

data style(8,:) /16,32,64,255,64,32,16,8/

do i=1,8

st=setcolor(i)

call setfillmask(style(i,:))

st=rectangle($gfillinterior,i*70,i*70,i*70+70,i*70+70)

enddo

end

 

4.2. . 3.2 (

Console Application)

 

1

program var1 ! ࠠ

character(10) name

write (*,*) 'Input your name:'

read (*,10) name

10 format (a10)

call hello(name)

write (*,*) 'input number:'

read(*,*) x

write (*,*) 'input degree:'

read (*,*) y

write (*,*) x,' in degree of ',y,' = ',deg(x,y)

end

 

subroutine hello(input) !

character(10) input

write(*,*) '***************'

write (*,*) 'Hello,',input,'!'

write (*,*) '**************'

end

function deg(z1,z2) !

real z1,z2

deg=z1**z2

return

end

2

program var2 !

dimension a(4,4)

write (*,*) 'Input matrix 4x4:'

read (*,*) ((a(i,j),j=1,4),i=1,4)

write (*,*) 'Factorials of elements:'

write (*,*) ((f1(a(i,j)),j=1,4),i=1,4)

stop

end

function f1(var) !

f1=1

do i=1,var

f1=f1*i

enddo

return

end

3

program var3 !

dimension b(5,5)

write (*,*) 'Input matrix 5x5:'

read (*,*) ((b(i,j),j=1,5),i=1,5)

write (*,*) 'Row sum:'

do i=1,5

write (*,*) 'N row=',i,' Sum=',summa(b(i,:),5)

enddo

write (*,*) 'Column sum:'

do i=1,5

write (*,*) 'N col=',i,' Sum=',summa(b(:,i),5)

enddo

stop

end

function summa(name,n) !

real name(n)

summa=0

do i=1,n

summa=summa+name(i)

enddo

return

end

4

module attent !

type dan

character(20) famil

character(15) name

integer age

end type

end module

program var4 !

call formular

stop

end

subroutine formular !

use attent

type (dan):: card(3)

do i=1,3

write (*,*) 'Input famil:'

read(*,*) card(i)\%famil

write (*,*) 'Input name:'

read (*,*) card(i)\%name

write (*,*) 'Input age:'

read (*,*) card(i)\%age

enddo

write (*,*) 'DATA:'

do i=1,3

write (*,*) '**** Surname*********** Name********** Age *****'

write (*,100) card(i)

100 format('*****',a20,2x,a15,2x,i2,'*****')

enddo

end

5

program var5 !

real a1,b1,c1

write (*,*) 'Input koef. a,b,c:'

read (*,*) a1,b1,c1

call korni(a1,b1,c1,x1,x2)

write (*,*) 'Roots = ',x1,x2

stop

end

subroutine korni(a,b,c,x3,x4) !

real x3,x4

d=b**2-4*a*c

if (d.gt.0) then

x3=(-b+sqrt(d))/(2*a)

x4=(-b-sqrt(d))/(2*a)

else

if (d.eq.0) then

x3=(-b+sqrt(d))/(2*a)

x4=x3

else

x3=-0; x4=-0

write (*,*) 'no roots'

endif

endif

end

6

program var6 !

real m(3,3),v(3),s(3)

rite (*,*) 'Solving of linear system 3x3'

write (*,*) 'Input matrix 3x3:'

read (*,*) ((m(i,j),j=1,3),i=1,3)

write (*,*) 'Input vector 3:'

read (*,*) v

call def(m,v,s)

write (*,*) 'x1=',s(1),' x2=',s(2),' x3=',s(3)

end

 

subroutine def(matrix,vector,sol) !

real matrix(3,3),vector(3),sol(3),temp(3,3)

main = det(matrix)

do i =1,3

 

temp(1:3,1:3)=matrix(1:3,1:3)

do j=1,3

temp(j,i)=vector(j)

enddo

sol(i)=det(temp)/main

enddo

end

function det(matrix) !

real matrix(3,3)

det=matrix(1,1)*matrix(2,2)*matrix(3,3)+&

matrix(1,2)*matrix(2,3)*matrix(3,1)+matrix(2,1)*matrix(3,2)*matrix(1,3)-&

matrix(1,3)*matrix(2,2)*matrix(1,3)-atrix(1,2)*matrix(2,1)*matrix(1,3)-&

matrix(2,3)*matrix(3,2)*matrix(1,3)

return

end

7

program var7 !

character*24 filename

character*40 string

write (*,*) ' Creating of new file'

write (*,'(A)') ' Enter file name: '

read (*,'(A)') filename

OPEN (7, FILE = filename, ACCESS = 'SEQUENTIAL', STATUS = 'UNKNOWN')

write (*,*) ' Input 5 strings:'

do i=1,5

read (*,*) string

write (7,*) string

enddo

close(7)

call outfile(filename)

end

subroutine outfile(name) !

character name*24,string*40

OPEN (25, FILE = name,STATUS = 'UNKNOWN')

do i=1,5

read (25,'(40a)') string

write (*,'(40a)') string

enddo

close(25)

end

 

4.3. . 3.3

 

1

:.

.

Y:.

Y.

Y.

: \% Y.

2

:.

.

:.

.

3

:.

.

Y:.

Y.

: Y .

4

:.

.

:.

N.

XN .

5

A, B, C, D:.

A, B, C, D.

AB+CD, .

6

:.

.

2, 3, 4, 5 X^2=, X^3=, X^4=, X^5=.

7

R:.

R.

.

 

| |