Здравствуйте, гость ( Вход | Регистрация )
![]() ![]() |
| 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 попробовать найти и то не факт... -------------------- |
![]() ![]() |
|
Текстовая версия | Сейчас: 20.5.2012, 23:48 |