Программа калькулятор (Найти ошибки)

[Victor32101]

Здравствуйте уважаемые программисты. Мне очень нужна ваша помощь. Вкратце у меня курсовая на тему написать программу калькулятор на языке ТБ. Я весь инет обшарил и нашёл только одну такую курсовую.. (похожую)В конце этой курсовой непосредственно листинг программы . и обидное самое она не работает.. Вот код программы. Помогите пожалуйста сделать так чтобы она заработала))

program kurs;
uses crt;
function pow(a,x:longint):longint;
var
t,i:longint;
begin
t:=a;
for i:=1 to x-1 do
t:=t*a;
pow:=t;
end;  {pow}
{----------------------------------------}
procedure DelOstatok;
var
dd:array [1..200] of integer;
R:integer;      {размерность чисел}
i:longint;   {делитель}
k:longint;   {остаток}
D,a,b:longint;   {элементы заданного множества}
SUM:longint; {кол-во эл-ов, удовл условию}
S,T:byte;
q:char;
e,j,l,n:integer;
maxa,minj,maxj:longint;
begin
repeat
begin
writeln('введите ко-во чисел для нахождения НОК делителей');
readln(n);
writeln('введите ',n,' чисел: ');
readln(dd[1]);
maxa:=dd[1];
for i:=2 to n do
begin
readln(dd[i]);
if dd[i]>maxa then maxa:=dd[i];
end;
i:=1;while (dd[i]<>0) and (i<=n) do inc(i);
if i<>n+1 then writeln('НОК не сущ-ет')
else begin
e:=1;
for i:=2 to maxa do
begin
maxj:=0;
for l:=1 to n do
begin
j:=0;
while (dd[l] mod i=0) do
begin
dd[l]:=dd[l] div i;
inc(j);
end;
if (j>maxj) then maxj:=j;
end;
if (maxj<>0) then for l:=1 to maxj do e:=e*i;
end;
writeln('НОК делителей=',e);
end;
end;
i:=e;
write ('введите остаток=');
readln(k);
if ((i<=0) or (k<0)) then       {проверка
{вывод эл-ов на экран}
end; writeln;
end;
writeln('Повторить ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
end; {DelOstatok}
{----------------------------------------}
procedure Factor;
var
numb, powers: array [1..100] of longint;
c:longint;
n:longint;
n1,H:longint;
i:longint;
k,t: longint;
q:char;
begin
repeat
write('Введите число=');
readln(c);
if c<=0 then      {проверка на корр числа}
begin
writeln('число должно быть>0');
readln;
exit;
end
else
{вывод мн-ва делителей}
begin
write('мн-во делителей: D(num)=');
for H:= 1 to c do
if c mod H=0 then
write(H,' ');
end;
{конец вывода делителей}
n:= 1;
n1:= 0;
while c <> 1 do
begin
i:= 2;
while c mod i <> 0 do    {проверка на делимостьс/без остатка}
Inc(i);
Inc(n1);
if n1 = 1 then
begin
numb[n]:= i;
powers[n]:= 1;
end
else
if numb[n] = i then Inc(powers[n])
else
begin
Inc(n);    {увеличение кол-ва простых множителей}
numb[n]:= i;
powers[n]:= 1;
end; {while}
c:= c div i;    {деление числа на простой множитель}
end; {while}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
writeln;
writeln('кол-во простых множителей: ',n);
write('num = ');
k:=1;
t:=1;
writeln('НОД=',k);
if k=1 then writeln('числа взаимно простые');
end;
begin
i:=1;while (b[i]<>0) and (i<=n) do inc(i);
if i<>n+1 then writeln('НОК не сущ-ет')
else begin
d:=1;
for i:=2 to maxa do
begin
maxj:=0;
for l:=1 to n do
begin
j:=0;
while (b[l] mod i=0) do
begin
b[l]:=b[l] div i;
inc(j);
end;
if (j>maxj) then maxj:=j;
end;
if (maxj<>0) then for l:=1 to maxj do d:=d*i;
end;
writeln('НОК=',d);
end;
end;
end;
writeln('Повторить ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
end;{NodNok}
{----------------------------------------}
procedure SuperGorner;
type
vector= array[1..11] of integer;
rvector=array[1..100] of real;
 
var
sum,suma:real;
i,k,j,b,c,a,n:integer;
vec:vector;
vecb:rvector;
veca:rvector;
q:char;
BEGIN
Writeln('Введите степень уравнения (max = 10)');
Readln(n);
if n<=0 then writeln('степень не может быть<=0')
else begin
Inc(n);
writeln('введите его коэффициенты:');
for i := 1 to n do
read(vec[i]);
while vec[i]=0 do
Begin
i:=i-1;
writeln('ответ:0');
End;
k:=1;
b:=vec[i];
for j:=1 to abs(b) do
begin
if (b mod j)=0 then
begin
vecb[k]:=j;
k:=k+1;
procedure AntiExp;
var s: array [1..100] of integer;
a,b,i,n,t:integer;
q:char;
begin
repeat
writeln('введите кол-во эл-ов цепной дроби=');
read(n);
if n<=0 then writeln('кол-во эл-ов не может быть<=0')
else begin
writeln('введите значения этих эл-ов=');
for i:=1 to n do
read(s[i]);
a:=1;b:=s[n];
for i:= n downto 2 do
begin
t:=s[i-1]*b+a;
a:=b;
b:=t;
end;
writeln;
writeln(b,'/',a);
end;
writeln('Повторить ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
end;{AntiExp}

В Paschal ABC пишет Безымянный.jpg



___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Victor32101]

{----------------------------------------}
var
k:integer;
q:char;
begin
writeln('Дискретная математика');
writeln('Курсовая работа, группа 03-119, каф308');
writeln('выполнил: Тузов И.И.');
writeln('руководитель: Гридин А.Н.');
writeln;
writeln('Калькулятор с функциями, описанными ниже');
writeln;
Writeln('Нажмите Enter');
readln;
clrscr;
repeat
writeln('Какую выполнить операцию?');
writeln;
writeln('1-вычисление мн-ва N-значных чисел с заданным делителем и остатком ');
writeln('2-факторизация числа');
writeln('3-нахождение НОД и НОК чисел');
writeln('4-нахождение рационльных корней уравнения с целочисл коэфф');
writeln('5-перевод рациональной дроби в цепную');
writeln('6-перевод цепной дроби в рациональную');
read(k);
делителя и остатка на отриц-сть}
begin
write ('делитель или остаток не могут быть<0 ');
end
else
begin
if i>k then         {проверка на делитель>остатка}
begin
write ('введите размерность=');
readln(R);
if R<=0 then
begin
writeln ('некорректная размерность ');
readln;
end
else begin
if R=1 then
begin a:=1; b:=9; end
else begin
a:=pow(10,(R-1));  {инициализация верх и нижн границ}
b:=pow(10,R);
b:=b-1;
end;
end;
 
if b<i then        {проверка на делимое>делителя}
writeln ('делиоме не может быть < делителя ')
else
begin
SUM:=0;             {обнуление сумы кол-ва эл-ов}
for D:= a to b do
begin
if (D mod i)=k then       {проверка эл-ов на условие}
begin
SUM:=SUM+1;
end;
end;
writeln;
writeln ('кол-во эл-ов с делителем=', i:3, ' и остатком=', k:3, ' равно', SUM:6);
end;   {b<i}
end   {if i>k}
else
write ('остаток не может быть > делителя ');
end;      {if otriz}
{\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
write ('вывести значения на экран?(1-да\0-нет)');
readln(S);
if S=1 then
if SUM=0 then
writeln('нет эл-ов, удовл. условию')
else
begin
for D:= a to b do
if (D mod i)=k then
begin
write(' ',D:4);
{вычисление кол-ва делителей и их мн-ва}
for i:= 1 to n do
begin
write(numb[i], ' ^ ', powers[i]);
k:=k*((pow(numb[i],powers[i]+1) - 1) div (numb[i] - 1));
t:=t*(powers[i]+1);   {кол-во делителей}
if i <> n then write(' * ');
end;
writeln;
writeln('кол-во множителей: tau(num)=',t);
writeln('сумма множителей: sigma(num)=',k);
writeln('Повторить ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
end;{Factor}
{----------------------------------------}
procedure NodNok;
type TArray=array [1..200] of integer;
var a,b:TArray;
i,l,j,maxa,minj,maxj:longint;
k,d:longint;
n:integer;
q:char;
begin
repeat
clrscr;
writeln('введите ко-во чисел для нахождения НОД и НОК');
readln(n);
writeln('введите ',n,' чисел: ');
if n<=0 then writeln('кол-во чисел не может быть<=0')
else begin
readln(a[1]);
b[1]:=a[1];
maxa:=a[1];
for i:=2 to n do
begin
readln(a[i]);
b[i]:=a[i];
if a[i]>maxa then maxa:=a[i];
end;
i:=1;
while (a[i]=0) and (i<=n) do inc(i);
if i=n+1 then writeln('НОД - любое число')
else begin
for j:=1 to n do if a[j]=0 then a[j]:=a[i];
k:=1;
for i:=2 to maxa do
begin
minj:=1000;
for l:=1 to n do
begin
j:=0;
while (a[l] mod i=0) do
begin
a[l]:=a[l] div i;
inc(j);
end;
if (j<minj) then minj:=j;
end;
if (minj<>0) then for l:=1 to minj do k:=k*i;
end;
vecb[k]:=-j;
k:=k+1;
end;
end;
a:=1;
for j:=1 to abs(vec[1]) do
begin
if (vec[1] mod j)=0 then
begin
veca[a]:=j;
a:=a+1;
{  veca[a]:=-j;
a:=a+1;}
End;
end;
b:=a;
for j:=1 to k-1 do
Begin
for a:=1 to b-1 do
Begin
Begin
c:=i;
sum:=0;
for i:=1 to c do
Begin
sum:=sum+vec[i]*pow1(vecb[j]/veca[a],c-i);
if (sum<0.00001) and (sum>-0.00001) then
if vec[a]=1 then writeln('ответ:',round(vecb[j]))
else writeln('ответ:',round(vecb[j]), '/',round(veca[a]));
end;
End;
End;
End;   end;
readln;
end;{SuperGorner}
{----------------------------------------}
procedure Express;
var
a,b,t:integer;
q:char;
begin
repeat
writeln('введите числитель=');
readln(a);
writeln('введите знаменатель=');
readln(b);
if b=0 then writeln('знаменатель не может быть=0')
else begin
write('[');
while (a mod b>0) do
begin
write(a div b,',');
a:=a mod b;
t:=b;
b:=a;
a:=t;
end;
write(a div b, ']');
end;
writeln('Повторить ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
end;{Express}
{----------------------------------------}
case k of
1:DelOstatok;
2:Factor;
3:NodNok;
4:SuperGorner;
5:Express;
6:AntiExp;
else
writeln ('нет операции');
end;{case}
writeln('Повторить выполнение калькулятора ?(Y/N)');
q:=ReadKey;
until q in ['N','n'];
clrscr;
readln;
end.{prog}

Остальная часть программы

[TinMan]

Сообщение от Victor32101

Вкратце у меня курсовая на тему написать программу калькулятор на языке ТБ. Я весь инет обшарил и нашёл только одну такую курсовую.. (похожую)В конце этой курсовой непосредственно листинг программы . и обидное самое она не работает.. Вот код программы. Помогите пожалуйста сделать так чтобы она заработала))

фу-ты ну-ты, опять просят дугих исправить чужой код, чтоб им сдать.. Украсть смог, а использовать - нет? Не стыдно милостыню собирать? "мы сами неместные.." Ты что ли инвалид? так обратись за помощью в соответствующие органы..

Зачем мы будем тебе это делать? Чтоб ты сдал, и стало еще одним "программистом" больше?? А потом удивляемся - почему софт глючный..

Сделай САМ хоть что-то. Я тебе тогда лично обещаю помочь.

[SourZ]

Соглашусь с TinMan. Victor32101, в коде чуть ли не элементарные ошибки, а вы, вместо того, что бы включить мозг и чуть чуть подумать, сразу лезите на форум и просите друих людей, у которых есть свои дела, исправить "ваш код".