BudushiyISP Posted August 23, 2008 Posted August 23, 2008 Я относительно силен в физике, но вот стоит задача по определению плотности потока энергии и напряженности магнитного поля на "n" расстоянии от базовой станции. Нашел на просторах Интернета некий реферат c программным кодом на Паскаль. Программа помогает определять напряженность магнитного поля , достаточно ввести данные. Установил Паскаль, попытался скомпилировать, но не фига не получилось. Может у кого есть подобные готовые программы или поможете скомпилировать данный код? ПРИЛОЖЕНИЕ Приложение 1 – программа расчета напряженности поля. uses crt,graph,omenu; const f_fi= 1; NBg = {blue}1; NFg = {white}15; HBg = {white}15; HFg = {black}0; BC = {black}0; SC = {lightcyan}11; col = 200; delta_rm =90; var vf :text; VMenu :OVMenu; HMenu :OHMenu; HVMenu :OHVMenu; p,d,hb,em :real; i,j,choice,errc, a,x,Hmenu_choice,len :integer; rm :longint; ord :array[1..col] of real; del :array[1..10] of real; delstr,si,AStr,vstr :string; ch,rk :char; input_is :boolean; {Процедуры ввода данных} procedure input_value(xi,yi:integer; var zn:real); begin vstr:=''; while rk<>#13 DO begin rk:=readkey; if (((rk>#47)and(rk<#58))or(rk=#46))and(len<10) then begin vstr:=vstr+rk; len:=length(vstr); gwritexy(xi+len,yi+1,rk,3,2); end; end; val(vstr,zn,errc); end; procedure input; begin gwritexy(1,5,'Мощность: ',3,2); input_value(11,4,p); readln; gwritexy(1,6,'К. у. антенны: ',3,2); input_value(1,6,d); readln; gwritexy(1,7,'Высота передающей антенны: ',3,2); input_value(1,7,hb); readln; end; {Функция выводит осн. меню на экран и возвращает номер выбранного пункта меню} Function ddt:integer; begin HVMenu.init; gwritexy(0,1,'',0,0); HVMenu.SetHorItems(00,00,80,01,NBg, NFg,HBg,HFg,BC,SC,1,1,BorderOn,ShadowOff,' File | Антенна '); HVMenu.SetVerItems(01,00,01,10,03,NBg,NFg,HBg,HFg,BC,SC,4,1,BorderOn,ShadowOff,' Данные | Выход '); HVMenu.SetVerItems(2,6,01,29,04,NBg,NFg,HBg,HFg,BC,Sc, 4,1,BorderOn,ShadowOff, ' Ант. решетка №1 - 1,3 | Ант. решетка №2 - 2 | Диполь '); HMenu.EraseOK:=False; X:=HVMenu.MenuResult(false,true); ddt:=x; end; {Функции расчета напряженности} function f_alfa:real; begin case choice of 1: f_alfa:=(1+2*cos(1.3*pi*sin(arctan((hb)/rm))))/3; 2: f_alfa:=(1+2*cos(2*pi*sin(arctan((hb)/rm))))/3; 3: f_alfa:=(cos(pi/2*sin(arctan((hb)/rm)))/cos(arctan((hb)/rm))); end; end; function Rb:real; begin rb:=rm/sin(arctan(hb/rm)); end; function E2:real; begin E2:=30*p*d*sqr(f_alfa)*sqr(f_fi)/sqr(Rb); end; {Заполнение массива ординат} procedure ordinates; begin rm:=1; for i:=1 to col do begin rm:=rm+delta_rm; ord:=1000*SQRT(E2); {х1000, т.к. ед. изм. - мВ/м} end; end; {Максимальное значение напряженности} procedure E_maximum; var i:integer; max:real; begin Max:=ord[1]; if col>1 then for i:=2 to col do if ord>Max then Max:=ord; if max=0 then max:=1; Em:=max; end; {Сохранение результатов расчета в файл "results.txt"} procedure ToFile; begin assign(vf,'results.txt'); rewrite(vf); rm:=0; for i:=1 to col do begin rm:=rm+delta_rm; writeln(vf,rm,' m',' - ',ord:0:5,' mV/m'); end; end; {Инициализация графики} procedure grinit; var grDriver: Integer; grMode: Integer; ErrCode: Integer; begin grDriver := Detect; InitGraph(grDriver, grMode,'c:\bp\bgi'); ErrCode := GraphResult; if ErrCode <> 0 then Writeln('Graphics error:', GraphErrorMsg(ErrCode)); end; procedure drawcoords; {Оси координат} begin setcolor(darkgray); {Oy} line(100,445,100,30); line(99,445,99,30); line(99,30,96,35); line(100,30,103,35); outtextxy(25,23,' Е, мВ/м'); {Ox} line(95,440,515,440); line(95,441,515,441); line(515,440,510,437);line(515,441,510,444); outtextxy(525,445,'R, м'); end; procedure drawgrid;{Сетка} begin setcolor(lightgray); {Горизонтальная} j:=40; for i:=1 to 10 do begin line(100,440-j,500,440-j); j:=j+40 end; {Вертикальная} j:=round(80/ln(1.91)); for i:=1 to 6 do begin line(100+round(j),440,100+round(j),40); j:=j+round(80/ln(i+1.8)) end; end; procedure values;{Разметка сетки} begin {По вертикали} del[1]:=em/10; {Цена деления} for i:=2 to 10 do del:=del[1]+del[i-1]; setcolor(darkgray); outtextxy(90,445,'0'); j:=40; for i:=1 to 10 do begin str(del:0:1,delstr); outtextxy(90-length(delstr)*8,438-j*i,delstr) end; {По горизонтали} j:=95+round(80/ln(1.91)); outtextxy(j,445,'3'); j:=j+round(80/ln(2.8)); outtextxy(j,445,'6'); j:=j+round(80/ln(3.8)); outtextxy(j,445,'9'); j:=j+round(80/ln(4.8)); outtextxy(j,445,'12'); j:=j+round(80/ln(5.8)); outtextxy(j,445,'15'); j:=j+round(80/ln(6.8)); outtextxy(j,445,'18'); end; { Построение графика } procedure drawgrafic; var dlt:integer; x1,x2,y1,y2:integer; begin setcolor(choice+1); x1:=100-round(2/ln(1.91));; for i:=1 to col do begin y1:=440-round(400*ord/em); y2:=440-round(400*ord[i+1]/em); if (i>=1)and(i<40) then begin x1:=x1+round(2/ln(1.91)); x2:=x1+round(2/ln(1.91)); end; if (i>=40)and(i<80) then begin x1:=x1+round(2/ln(3.71)); x2:=x1+round(2/ln(3.71)); end; if (i>=80)and(i<120) then begin x1:=x1+round(2/ln(5.51)); x2:=x1+round(2/ln(5.51)); end; if (i>=120)and(i<160) then begin x1:=x1+round(3/ln(7.31)); x2:=x1+round(3/ln(7.31)); end; if (i>=160)and(i<=200) then begin x1:=x1+round(4/ln(9.11)); x2:=x1+round(4/ln(9.11)); end; line(x1,y1,x2,y2); line(x1,y1-1,x2,y2-1); line(x1,y1-2,x2,y2-2); delay(20); end; end; {Графические процедуры} procedure drawing1st; {Инициализирует графику, подготавливает экран} begin grinit; setbkcolor(15); cleardevice; setcolor(darkgray); rectangle(10,10,getmaxx-10,getmaxy-10); drawgrid; drawcoords; end; procedure drawing2nd; {Выводит график на экран} begin drawgrafic; readln; closegraph; end; begin ClrScr; { Input;}p:=100; d:=8; hb:=127; grinit; repeat cleardevice; i:=2; repeat a:=ddt; until a<>0; Hmenu_choice:=a div 100; Case Hmenu_choice of 1: begin choice:=a mod 100; if choice=2 then break else begin input; input_is:=true; end; end; 2: if not(input_is) then begin gwritexy(17,10,'! Сначала необходимо ввести даннные !',5,1); ch:=readkey; continue; {end else begin choice:=a mod 100; Drawing1st; Ordinates; E_Maximum; ToFile; Values; Drawing2nd; } end; end; until false; HVMenu.Done; cleardevice; closegraph; write(p:1:2,' ',d:1:2,' ',hb:1:2); end. Вставить ник Quote
BudushiyISP Posted August 23, 2008 Author Posted August 23, 2008 а где ошибку пишет?При компиляции пишет нет файлы omenu.tpuПопробуй сам компиляцию сделать ежели не трудно, и увидишь. Вставить ник Quote
Britney Posted August 23, 2008 Posted August 23, 2008 (edited) omenu.tpu это по идее самодельный модуль (по крайней мере я такого ни разу не видел), в котором описаны часть объектов, которые здесь используются и браться он должен там же, где и сама программа Edited August 23, 2008 by Britney Вставить ник Quote
BudushiyISP Posted August 23, 2008 Author Posted August 23, 2008 omenu.tpu это по идее самодельный модуль (по крайней мере я такого ни разу не видел), в котором описаны часть объектов, которые здесь используются и браться он должен там же, где и сама программа Простите я нельзя как-то подправить код, чтобы без этого файла обойтись ? Вставить ник Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.