ЛИСТИНГ ПРОГРАММЫ

uses graph, crt;

function arcsin (x: real): real; {возвращает арксинус угла}

begin

if (x=1) then arcsin: = PI/2 else

if (x=-1) then arcsin: = - 1*PI/2 else

if (x>0) then

arcsin: =arctan(sqrt((x*x) /(1-x*x))) else

arcsin: =-arctan(sqrt((x*x) /(1-x*x)));

end;

function ReCalc(n: real; n1: real; alpha: real): real; {высчитывает угол преломления}

var

radalpha, radalpha1: real; {углы в радианах}

begin

radalpha: =alpha*PI/180;

if ((n*sin(radalpha) /n1) <=1) then

begin

radalpha1: =arcsin(n*sin(radalpha) /n1);

ReCalc: =radalpha1*180/PI;

end

else

begin

ReCalc: =arcsin(1) *180/PI;

end;

end;

procedure Recv; {выводит на экран реквизиты пользователя}

var

f: text; {файл содержащий реквизиты пользователя}

n: integer;

s: string;

begin

n: =0;

{открываем файл для чтения}

assign (f, 'recv. txt');

reset(f);

ClearViewPort;

SetTextStyle(8,0,1);

SetColor (White);

{выводим содержимое файла на экран}

while not eof(f) do

begin

n: =n+15;

readln (f,s);

OutTextXY(0, n, s);

end;

{закрываем файл}

close(f);

repeat until keypressed;

readkey;

ClearViewPort;

end;

function Menu(number: Integer): Integer;

const

Selected = Cyan;

UnSelected = 255;

IV = 20;

var

str1: string;

ch: char;

begin

SetTextStyle(8,0,1);

while (true) do

begin

if (number=1) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 1*IV, 'Информация (F1) ');

if (number=2) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 2*IV, 'Считать данные из файла (L) ');

if (number=3) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 3*IV, 'Изменить показатель преломления в 1-ой среде (1) ');

if (number=4) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 4*IV, 'Изменить показатель преломления во 2-ой среде (2) ');

if (number=5) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 5*IV, 'Изменить угол падения (A) ');

if (number=6) then

SetColor(Selected)

else SetColor (UnSelected);

OutTextXY(0, 6*IV, 'Выход (Esc) ');

SetColor(UnSelected);

ch: =ReadKey;

{если нажали esc - выходим}

if (ch = #27) then

begin

Menu: = 6;

break;

end;

{f1}

if (ch = #59) then

begin

Menu: = 1;

break;

end;

if ((ch = 'L') or (ch = 'l')) then

begin

Menu: = 2;

break;

end;

if ((ch = 'A') or (ch = 'a')) then

begin

Menu: = 5;

break;

end;

if (ch = '1') then

begin

Menu: = 3;

break;

end;

if (ch = '2') then

begin

Menu: = 4;

break;

end;

{"вверх" и "вниз"}

if (ch = #72) then number: =number-1;

if (ch = #80) then number: =number+1;

if (number = 0) then number: = 6;

if (number = 7) then number: = 1;

{ENTER}

if (ch = #13) then

begin

Menu: = number;

break;

end;

end;

end;

procedure GraphMode;

var

gd,gm: Integer;

begin

{драйвер - VGA, режим - VGAHi (640*480) }

gd: = VGA;

gm: = VGAHi;

InitGraph (gd,gm,''); {инициализация графики}

end;

procedure SaveData(n: real; n1: real; alpha: real); {сохраняет данные в файл}

var

f: text;

alpha1: real;

tempstr: string;

begin

alpha1: =ReCalc(n,n1,alpha);

assign(f, 'result. txt');

rewrite(f);

Str(n: 6: 4, tempstr);

writeln(f,concat('Показатель преломления n=', tempstr));

Str(alpha: 2: 0, tempstr);

writeln(f,concat('Угол падения alpha=', tempstr));

Str(n1: 6: 4, tempstr);

writeln(f,concat('Показатель преломления n1=', tempstr));

Str(alpha1: 2: 0, tempstr);

writeln(f,concat('Угол преломления alpha1=', tempstr));

close(f);

end;

procedure Paint(n: real; n1: real; alpha: real);

var

mx,my: Integer; {максимальные значения экранных координат}

delta,delta1: real;

radalpha, radalpha1, alpha1: real;

tempstr: string;

begin

{находим максимальные значения экранных координат}

mx: =GetMaxX;

my: =GetMaxY;

{пересчитываем угол преломления, находим радианные значения углов}

alpha1: =ReCalc(n, n1, alpha);

radalpha: =alpha*PI/180;

radalpha1: =alpha1*PI/180;

if (cos(radalpha) <>0.0) then

delta: = (my/3) *sqrt(1/sqr(cos(radalpha)) - 1)

else

delta: = 100000; {если косинус равен 0 - луч лежит на границе}

if (cos(radalpha1) <>0.0) then

delta1: = (my/3) *sqrt(1/sqr(cos(radalpha1)) - 1)

else

delta1: =-100000; {если косинус равен 0 - луч лежит на границе}

SetColor(White);

SetTextStyle(8, 0, 1);

{выводим n,alpha,n1,alpha1}

Str(n: 6: 4, tempstr);

OutTextXY(3, round(2*my/3-40), concat('n= ', tempstr));

Str(alpha: 2: 0, tempstr);

OutTextXY(3, round(2*my/3-20), concat('alpha= ', tempstr));

Str(n1: 6: 4, tempstr);

OutTextXY(3, round(2*my/3), concat('n1= ', tempstr));

Str(alpha1: 2: 0, tempstr);

OutTextXY(3, round(2*my/3+20), concat('alpha1= ', tempstr));

{выводим рамку}

SetColor(Yellow);

SetLineStyle(SolidLn, 0, NormWidth);

Line(0, round(my/3), mx, round(my/3));

Line(0, my, mx, my);

Line(0, round(my/3), 0, my);

Line(mx, round(my/3), mx, my);

{выводим границу между средами и нормаль}

SetColor(LightGray);

SetLineStyle(DottedLn, 0, NormWidth);

Line(round(mx/2), round(my/3), round(mx/2), my);

Line(0, round(2*my/3), mx, round(2*my/3));

{выводим стрелочки}

SetLineStyle(SolidLn, 0, NormWidth);

Line(round(mx/2) - 3, round(my/3) +10, round(mx/2), round(my/3));

Line(round(mx/2) +3, round(my/3) +10, round(mx/2), round(my/3));

{выводим падающий луч}

SetColor(Blue);

SetLineStyle(SolidLn, 0, NormWidth);

Line(round(mx/2), round(2*my/3), round(mx/2+delta), round(my/3));

{выводим преломленный луч}

SetColor(Red);

SetLineStyle(SolidLn, 0, NormWidth);

Line(round(mx/2), round(2*my/3), round(mx/2-delta1), round(my));

end;

procedure OutTextChangeAl; {выводит вспомогательный текст при смене значения угла}

begin

SetColor(White);

SetTextStyle(8, 0, 1);

OutTextXY(0,0, 'Значение угла падения меняется клавишами ');

OutTextXY(0, 20, '"вверх" и "вниз"');

OutTextXY(0,40, 'подтверждение - ENTER');

OutTextXY(0,60, 'отмена - ESC');

end;

function ChangeAl(n: real; n1: real; alpha: real): real;

var

ch: char;

alpha0: real;

begin

{запоминаем начальное значение угла на случай отмены}

alpha0: =alpha;

while (true) do

begin

ClearViewPort;

Paint(n,n1,alpha);

OutTextChangeAl;

ch: = readkey;

if (ch = #72) then alpha: =alpha-1;

if (ch = #80) then alpha: =alpha+1;

if (alpha = 90) then alpha: = 89;

if (alpha = - 1) then alpha: = 0;

if (ch = #13) then

begin

SaveData(n,n1,alpha); {сохраняем данные}

ChangeAl: = alpha;

break;

end;

if (ch = #27) then

begin

ChangeAl: = alpha0;

break;

end;

end;

end;

function ChangeN(flag: integer): real;

var

tempstr: string;

ch: char;

n: real;

code: integer;

begin

{переход в текстовый режим}

CloseGraph;

{принимаются только символы 1-9}

while ((ch<'1') or (ch>'9')) do

begin

ClrScr;

str(flag, tempstr);

writeln(concat('Выберите ',tempstr,'-ую среду: '));

writeln('1. Вода');

writeln('2. Глицерин');

writeln('3. Алмаз');

writeln('4. Воздух');

writeln('5. Полиэтилен');

writeln('6. Сапфир');

writeln('7. Хлористый натрий');

writeln('8. Сероуглерод');

writeln('9. Другая среда');

ch: =readkey;

end;

if (ch = '1') then ChangeN: =1.33;

if (ch = '2') then ChangeN: =1.47;

if (ch = '3') then ChangeN: =2.42;

if (ch = '4') then ChangeN: =1.0003;

if (ch = '5') then ChangeN: =1.52;

if (ch = '6') then ChangeN: =1.77;

if (ch = '7') then ChangeN: =1.53;

if (ch = '8') then ChangeN: =1.63;

if (ch = '9') then

begin

repeat

ClrScr;

write('Введите показатель преломления среды: ');

readln(tempstr);

val(tempstr, n, code);

until ((code = 0) and (n<=9) and (n>0));

ChangeN: =n;

end;

GraphMode;

end;

procedure LoadData(var n: real; var n1: real; var alpha: real); {загрузка данных из файла}

var

f: text;

begin

{открываем файл для чтения}

assign (f, 'data. txt');

reset (f);

{считываем по порядку значения n,n1,alpha}

readln(f, n);

readln(f, n1);

readln(f, alpha);

close (f);

SaveData(n,n1,alpha); {сохраняем данные}

end;

procedure Info;

var

f: Text;

n, i: Integer;

s, temp: String;

ch: Char;

priznak: Boolean;

const

st_length = 55;

ch_size = 20;

begin

n: = 0;

priznak: = false;

Assign(f, 'info. txt');

ClearViewPort;

SetTextStyle (1, 0, 1);

Reset (f);

while not Eof(f) do

begin

n: = n + 1;

if not priznak then ReadLn (f, s);

if Length(s) > st_length then

begin

priznak: = true;

temp: = s;

Delete (temp, st_length+1, Length(temp));

OutTextXY(0, ch_size * n, temp);

Delete (s, 1, st_length);

end

else

begin

priznak: = false;

OutTextXY (0, ch_size * n, s);

end;

if (n = 22) or Eof(f) then

begin

OutTextXY (200, 460, 'Нажмите любую клавишу... ');

repeat until keypressed;

ch: = readkey;

n: = 0;

ClearViewPort;

end;

end;

end;

procedure MainCycle; {основной цикл программы}

var

action: Integer;

n,n1,alpha,sinalpha1: real;

begin

{установка начальных значений}

n: =1.0003; {показатель воздуха}

n1: =1.33; {показатель воды}

alpha: =60; {начальное значение угла падения}

SaveData(n,n1,alpha);

action: =1; {курсор установлен на первом пункте меню}

GraphMode; {гр режим. }

ClearViewPort; {очищаем экран}

Recv; {выводим реквизиты пользователя}

SetTextStyle (1, 0, 1);

while (action<>6) do {6=выход}

begin

ClearViewPort; {очищаем экран}

Paint(n,n1,alpha); {выводим график}

action: =Menu(action); {считываем пункт меню}

if (action=1) then Info; {информация}

if (action=2) then LoadData(n,n1,alpha); {считываем из файла}

if (action=3) then

begin

n: = ChangeN(1); {изменяем показатель преломления 1}

SaveData(n,n1,alpha);

end;

if (action=4) then

begin

n1: = ChangeN(2); {изменяем показатель преломления 2}

SaveData(n,n1,alpha);

end;

if (action=5) then alpha: = ChangeAl(n,n1,alpha); {изменяем угол падения}

end;

CloseGraph; {закрываем графический режим}

end;

begin

MainCycle;

end.

ИСПОЛЬЗУЕМАЯ ЛИТЕРАТУРА