IPB

Здравствуйте, гость ( Вход | Регистрация )

 
Ответить в эту темуОткрыть новую тему
> откомпилировать исходник в паскале
den3537
сообщение 1.12.2010, 16:15
Сообщение #1


Пользователь


Группа: Пользователи
Сообщений: 1
Регистрация: 1.12.2010
Пользователь №: 23 419



я в программировании ноль.есть программа в дос при запуске в хр выдает ошибку runtaim error 200
есть исходник этой программы помогите откомпилировать

Uses Crt, Graph, Dos; Label 1001, 1002;
Var S1, S2: Array [0..256,0..1] of Longint; St: String;
th,tl,t1,t2,D,D1,I,J:Word; drv,rg,ds: Integer;
fur,fil,dir: Boolean; Ch1,Ch2: char;

Procedure Ek; {процедура первоначальной прорисовки экрана}
Begin ClearDevice; SetColor(15); SetLineStyle(0,0,1);
For j:=0 to 6 do begin Str(j,St); OutTextXY(j*80+37,448,St); end;
Rectangle(0,0,560,479); SetLineStyle(4,$0101,1);
For j:=1 to 5 do Line(24,j*80,543,j*80);
For j:=1 to 7 do Line(j*80-40,32,j*80-40,441);
SetLineStyle(4,$0101,3);Line(280,32,280,441);Line(24,240,543,240);
SetColor(14); SetLineStyle(0,0,1);
OutTextXY(570,10,'"Esc"'); OutTextXY(570,20,' exit');
OutTextXY(570,50,'"F"'); OutTextXY(570,60,' filtr');
OutTextXY(570,80,'"S"'); OutTextXY(570,90,' spektr');
if fil then Rectangle(565,45,630,70); if fur then Rectangle(565,75,630,100);
end;

Procedure Fft; {процедура быстрого преобразования Фурье на 256 точек}
Var ReX, ImX: Array [1..256] of Real; P, ReW, ReT, ImW, ImT, Wp, Arg: Real;
Itt, Nx, Nx2, M, Mx, I, J, J1, J2, K: Integer;
Begin Nx2:=256; J:=1;
For I:=1 to 256 do begin ReX[I]:=S1[I-1,1]; ImX[I]:=0 end;
For Itt:=1 to 8 do begin Nx:=Nx2; Nx2:=trunc(Nx/2); Wp:=3.141592/Nx2;
For M:=1 to Nx2 do begin Arg:=(M-1)*Wp; ReW:=cos(arg); ImW:=-sin(arg);
For Mx:=1 to trunc(256/Nx) do begin J1:=Mx*Nx-Nx+M; J2:=J1+Nx2;
ReT:=ReX[J1]-ReX[J2]; ImT:=ImX[J1]-ImX[J2];
ReX[J1]:=ReX[J1]+ReX[J2]; ImX[J1]:=ImX[J1]+ImX[J2];
ReX[J2]:=ReT*ReW-ImT*ImW; ImX[J2]:=ReT*ImW+ImT*ReW; end; end; end;
For I:=1 to 255 do begin If I < J then begin ReT:=ReX[J]; ImT:=ImX[J];
ReX[J]:=ReX[I]; ImX[J]:=ImX[I]; ReX[I]:=ReT; ImX[I]:=ImT; end; K:=128;
While K < J do begin J:=J-K; K:=trunc(K/2); end; J:=J+K; end;
{результаты преобразования в массиве Х}
For I:=1 to 128 do begin {определение амплитуд гармоник и их нормирование}
S2[I*2-2,1]:=trunc(sqrt(ReX[I]*ReX[I]+ImX[I]*ImX[I]));
S2[I*2-1,1]:=S2[I*2-2,1]; end; S2[0,1]:=0; S2[1,1]:=S2[2,1];
J:=1; For I:=0 to 256 do begin if S2[I,1]>J then J:=S2[I,1]; end;
For I:=0 to 255 do begin S2[I,1]:=trunc(S2[I,1]/J*250); end; end;

Procedure Video; {процедура отображения графиков на экране}
Begin
{линии сетки}
SetColor(15); Rectangle(0,0,560,479); SetLineStyle(4,$0101,1);
For j:=1 to 5 do Line(24,j*80,543,j*80);
For j:=1 to 7 do Line(j*80-40,32,j*80-40,441); SetLineStyle(4,$0101,3);
Line(280,32,280,441);Line(24,240,543,240); SetLineStyle(0,0,1);
{индикатор синхронизации}
if (Port[$379] and 64) <> 64 then SetColor(0) else SetColor(15);
OutTextXY(580,400,'Sync'); Rectangle(585,410,605,430);
{дополнительная графика при прямом счете}
SetColor(0); if dir then SetColor(14); OutTextXY(570,110,'"1".."0"');
OutTextXY(570,120,' mS/D'); if dir then SetColor(11); OutTextXY(37,20,'0');
{преобразование Фурье (определение спектра)}
if fur then begin Fft;
For j:=1 to 256 do S1[j,1]:=S2[j,1]; Str(trunc(300/ds),St);
OutTextXY(110,20,St); OutTextXY(140,20,'Hz');end else begin
Str(ds*10,St); OutTextXY(110,20,St); OutTextXY(135,20,'mS'); end;
{фильтр}
if fil then For j:=1 to 256 do begin
S1[j,1]:=trunc(0.2*S1[j,1]+0.8*S1[j,0]);
S2[j,1]:=trunc(0.2*S2[j,1]+0.8*S2[j,0]); end;
{графики сигналов}
For j:=1 to 250 do begin i:=j*2+40;
{стереть старые}
SetColor(0); Line(i,420-trunc(S2[j,0]*1.5),i+1,420-trunc(S2[j+1,0]*1.5));
Line(i,420-trunc(S1[j,0]*1.5),i+1,420-trunc(S1[j+1,0]*1.5));
{нарисовать новые}
SetColor(12); Line(i,420-trunc(S2[j,1]*1.5),i+1,420-trunc(S2[j+1,1]*1.5));
SetColor(10); Line(i,420-trunc(S1[j,1]*1.5),i+1,420-trunc(S1[j+1,1]*1.5));
S1[j,0]:=S1[j,1]; S2[j,0]:=S2[j,1]; end;
S1[251,0]:=S1[251,1]; S2[251,0]:=S2[251,1];
end;

Procedure MessV(Var Y1, Y2: Longint); {процедура измерения напряжения}
Var i,j,pY1,pY2,P: byte; Begin i:=128; pY1:=0; pY2:=0;
Port[$37A]:=2; {установить вход "D" триггера формирователя импульсов = "0"}
{последовательное приближение 1 канала}
For j:= 1 to 8 do begin P:=pY1+i; Port[$378]:=not(P);
if (Port[$379] and 8) = 8 then pY1:=P; case j of 1:i:=64; 2:i:=32;
3:i:=16; 4:i:=8; 5:i:=4; 6:i:=2; 7:i:=1; 8:i:=128; end; end;
{последовательное приближение 2 канала}
For j:= 1 to 8 do begin P:=pY2+i; Port[$378]:=not(P);
if (Port[$379] and 16) = 16 then pY2:=P; case j of 1:i:=64; 2:i:=32; 3:i:=16;
4:i:=8; 5:i:=4; 6:i:=2; 7:i:=1; 8:i:=128; end; end; Y1:=pY1; Y2:=pY2; end;

Procedure Direct(K: Longint); {процедура работы в реальном времени}
Var I,J,L,L1: Longint; Begin GetTime(th,tl,t1,D); K:=K*100;
Port[$378]:=128; {установить порог компаратора }
Port[$37A]:=0; {убрать сигнал "Reset"}
{повторять, пока не сработает компаратор или не пройдет 0.1 сек.}
Repeat GetTime(th,tl,t2,D); Until (Port[$379]>128) or (t1<t2-1);
For I:=0 to 255 do begin
Port[$37A]:=8; {установить сигнал "Set"}
tl:=Port[$040]; th:=Port[$040]; D:=th*255+tl; {считать системный таймер}
MessV(S1[I,1],S2[I,1]); {измерить напряжение}
Port[$378]:=128; {установить порог компаратора}
Port[$37A]:=1; {установить сигнал "Reset"}
{повторять, пока не пройдет Кx100 мкС с момента считывания таймера}
Repeat tl:=Port[$040]; th:=Port[$040]; D1:=th*255+tl;
L:=D; L1:=D1; J:=L-L1; if J<0 then J:=65536+J; Until J>abs(K);
end; end;

Procedure Sw; {процедура отсчета времени через заряд конденсатора}
Var P,Jmax,P1,P2: Byte;
Begin Jmax:=trunc(256/D);
For I:= 0 to D-1 do begin For J:= 0 to Jmax-1 do begin P:=I+J*D;
Port[$378]:=not(P); {установить порог компаратора}
Port[$37A]:=0; {убрать сигнал "Reset"}
{повторять, пока не сработает компаратор, если нет синхронизации,
установить сигнал "Set"}
While (Port[$379]<128) do if (Port[$379] and 64) <> 64 then Port[$37A]:=8;
MessV(S1[P,1],S2[P,1]); {измерить напряжение}
end;
Port[$37A]:=1; {установить сигнал "Reset"}
delay(trunc(255/D)); {задержка для разряда конденсатора}
end; end;

Procedure Cap; {процедура определения емкости конденсатора}
Begin D:=256; Port[$378]:=D-1; Port[$37A]:=0;
While (Port[$379]<128) do if (Port[$379] and 64) <> 64 then Port[$37A]:=8;
Repeat Port[$378]:=not(D-1); D:=trunc(D/2); Until(Port[$379]>128);
D:=D*8; if D>256 then D:=256; Port[$37A]:=1; delay(1); end;

BEGIN
drv:= detect; InitGraph(drv,rg,'C:\BP\bgi'); fur:=false; fil:=false; ds:=1;
1001: Ek; Repeat Cap; dir:=false;
{если к.12 LPT1 ="0", то работа в реальном времени}
if (Port[$379] and 32) = 32 then Sw
else begin dir:=true;
case ds of 1:Direct(6); 2:Direct(12); 3:Direct(18); 4:Direct(24);
5:Direct(30); 6:Direct(36); 7:Direct(42); 8:Direct(48); 9:Direct(54);
10:Direct(60); end; end;
Video; Until KeyPressed; Ch1:=ReadKey;
case Ch1 of #27:goto 1002; 'f','F','А','а':fil:=not(fil);
's','S','Ы','ы':fur:=not(fur);
'1':ds:=1; '2':ds:=2; '3':ds:=3; '4':ds:=4; '5':ds:=5; '6':ds:=6;
'7':ds:=7; '8':ds:=8; '9':ds:=9; '0':ds:=10;
#0:begin Ch2:=ReadKey; case Ch2 of #75:ds:=ds+1; #77:ds:=ds-1; end; end; end;
if ds<1 then ds:=1; if ds>10 then ds:=10; goto 1001;

1002: CloseGraph; END.
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения
PolPoll
сообщение 23.12.2010, 8:50
Сообщение #2


:)


Группа: Главные администраторы
Сообщений: 5 858
Регистрация: 24.11.2005
Из: Москва
Пользователь №: 5 327



так не dos же.
можно эмулятор dos попробовать найти

и то не факт...


--------------------
Пользователь в офлайнеКарточка пользователяОтправить личное сообщение
Вернуться в начало страницы
+Ответить с цитированием данного сообщения

Ответить в эту темуОткрыть новую тему
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия Сейчас: 20.5.2012, 23:48