Задача По Паскалю!

[capta1n]

вот функция к первой задаче

function sr ( item : dataitem; n1 : byte; k1 : real ) : byte;
var
 i,j,count : byte;
 sum : real;
begin

  count:=0;
  for i:=1 to n1 do
  begin
    sum:=0;
    for j:=1 to n1+1 do sum:=sum+item[i,j];
    sum:=sum/(n+1);
    if sum<k1 then inc(count)
  end;
  sr:=count

end;

обращение может быть любое - я написал допустим в конце вот так:

write ('Vvesti veli4inu: '); readln(c1);
  writeln ('Kolvo= ',sr(a,n,c1));

Не забудьте отзыв оставить, а то мне иногда обидно - столько стараешься, ломаешь голову, а тебе даже отзыв не оставят и не поблагодарят

[capta1n]

Вот тут лучше написать Zap_i:=0; потому что записей пока нет

begin
Zap_i:=1;
Ex:=false;
Repeat
ClrScr;

а вот дальше в процедуре надо написать строчку inc(Zap_i) перед всем текстом процедуры ( сразу после begin ), чтобы при очередной записи процедура повышала счетчик записей, а она у вас все время записывает в одну и туже запись, то есть перезаписывает снова и снова - в этом и проблема

Procedure Enter_Dan;
begin
ClrScr;
Write('Enter start name mar: ');
ReadLn(RoUte[Zap_i].NameSt);
Write('Enter end name mar: ');
ReadLn(RoUte[Zap_i].NameKon);
Write('Enter number mar: ');
ReadLn(RoUte[Zap_i].NumbMar);
end;

[capta1n]

Procedure Enter_Dan;
var
 i,j,k : byte;
 c1,c2 : string;
 c3 : integer;
begin
  clrscr;
  Write('Enter start name mar: ');
  ReadLn(RoUte[Zap_i].NameSt);
  Write('Enter end name mar: ');
  ReadLn(RoUte[Zap_i].NameKon);
  Write('Enter number mar: ');
  ReadLn(RoUte[Zap_i].NumbMar);

  for i:=1 to Zap_i-1 do
  begin
    j:=i;
    for k:=i to Zap_i do if Route[k].NumbMar < Route[j].NumbMar then j:=k;
    with Route[i] do
    begin
      c1:=NameSt;
      c2:=NameKon;
      c3:=NumbMar;
      NameSt:=route[j].NameSt;
      NameKon:=route[j].NameKon;
      NumbMar:=route[j].NameMar
    end;
    with route[j] do
    begin
      NameSt:=c1;
      NameKon:=c2;
      NumbMar:=c3
    end
  end
end;

Протестите сортировку

[Sergeo_89]

Отзыв Я тебе обязательно оставлю) даже спросить хотел как тебе репутацию поднять
Вот Только не пойму по первой задаче получается в итоге это ведь? :

program capta1n;
const
n = 3;
type
DataItem = array [1..n,1..n+1] of real;
var
i,k,m : byte;
a : DataItem;
x : real;

procedure matr ( var b : DataItem; n1 : byte );
var
j,h,m : byte;
begin

for j:=1 to n1-1 do
for h:=j to n1-1 do
begin
x:=(-1)*b[h+1,j]/b[j,j];
for m:=j to n1+1 do b[h+1,m]:=b[h+1,m]+x*b[j,m]
end

end;

begin

writeln ('Vvedite koefficienti: ');
for i:=1 to n do
begin
for k:=1 to n+1 do
begin
write ('a[',i,',',k,']= ');
readln (a[i,k]);
end
end;

matr (a,n);

for i:=1 to n do
begin
for k:=1 to n+1 do write (a[i,k]:0:1,' ');
writeln
end;
readln
end;
function sr ( item : dataitem; n1 : byte; k1 : real ) : byte;
var
i,j,count : byte;
sum : real;
begin

count:=0;
for i:=1 to n1 do
begin
sum:=0;
for j:=1 to n1+1 do sum:=sum+item[i,j];
sum:=sum/(n+1);
if sum<k1 then inc(count)
end;
sr:=count

end;
write ('Vvesti veli4inu: '); readln(c1);
writeln ('Kolvo= ',sr(a,n,c1));
end.

А не Работает

[capta1n]

нет не это в итоге получается - я же написал через функцию и написал как я вывел - сча напишу полностью код
PS : можно вопрос - вы в паскале разбираетесь? ну если честно?

program capta1n;
const
  n = 3;
type
 DataItem = array [1..n,1..n+1] of real;
var
  i,k,m : byte;
  a : DataItem;
  x,c1 : real;

procedure matr ( var b : DataItem; n1 : byte );
var
 j,h,m : byte;
begin

  for j:=1 to n1-1 do
   for h:=j to n1-1 do
   begin
     x:=(-1)*b[h+1,j]/b[j,j];
     for m:=j to n1+1 do b[h+1,m]:=b[h+1,m]+x*b[j,m]
   end
end;

function sr ( item : dataitem; n1 : byte; k1 : real ) : byte;
var
 i,j,count : byte;
 sum : real;
begin

  count:=0;
  for i:=1 to n1 do
  begin
    sum:=0;
    for j:=1 to n1+1 do sum:=sum+item[i,j];
    sum:=sum/(n+1);
    if sum<k1 then inc(count)
  end;
  sr:=count

end;

begin

  writeln ('Vvedite koefficienti: ');
  for i:=1 to n do
  begin
    for k:=1 to n+1 do
    begin
      write ('a[',i,',',k,']= ');
      readln (a[i,k]);
    end
  end;

  matr (a,n);

  for i:=1 to n do
   begin
     for k:=1 to n+1 do write (a[i,k]:0:1,' ');
     writeln
   end;

  readln;
  write ('Vvesti veli4inu: '); readln(c1);
  writeln ('Kolvo= ',sr(a,n,c1));
  readln;
end.

[Sergeo_89]

Честно Нет)) Сложно мне дается этот предмет...Но задачи Требуют....

А если несложно напиши пожалуйста еще что во второй получется

[capta1n]

так погоди - я же написал - а тебе полностью надо? сча попробую
PS: ну я просто сразу вижу, разбирается в языке человек или нет ниче - я тоже когда-то ваще нифига не понимал - у всех спрашивал, че такое массив, ваще ниче не понимал в процедурах - а теперь, как видите, немного вроде и знаю что-то самое главное стараться и учиться - Знание! Уверенность! Успех!

[Sergeo_89]

Полностью с тобой согласен!!! Просто кто-то позже кто-то раньше добивается хороших результатов в предмете) а у тебя видно опыт))Спасибо вообще бы не знал что без твоей помощи делал))Ога напиши полностьюЕсли не сложно, пожалуйста)

[capta1n]

Program Xz;
Uses Crt;
Type
TRoUte=record
NameSt:string;
NameKon:string;
NumbMar:integer;
end;
Var
RoUte:array[1..8] of TRoUte;
Ex:boolean;
Key:Char;
Zap_i:integer;

Procedure Enter_Dan;
var
 i,j,k : byte;
 c1,c2 : string;
 c3 : integer;
begin
  inc(Zap_i);
  clrscr;
  Write('Enter start name mar: ');
  ReadLn(RoUte[Zap_i].NameSt);
  Write('Enter end name mar: ');
  ReadLn(RoUte[Zap_i].NameKon);
  Write('Enter number mar: ');
  ReadLn(RoUte[Zap_i].NumbMar);

  for i:=1 to Zap_i-1 do
  begin
    j:=i;
    for k:=i to Zap_i do if Route[k].NumbMar < Route[j].NumbMar then j:=k;
    with Route[i] do
    begin
      c1:=NameSt;
      c2:=NameKon;
      c3:=NumbMar;
      NameSt:=route[j].NameSt;
      NameKon:=route[j].NameKon;
      NumbMar:=route[j].NumbMar
    end;
    with route[j] do
    begin
      NameSt:=c1;
      NameKon:=c2;
      NumbMar:=c3
    end
  end
end;

Procedure Open_Dan;
var
i:integer;
begin
ClrScr;
for i:=1 to Zap_i do
WriteLn('Mar ',RoUte[i].NumbMar,'.Start name: ',RoUte[i].NameSt,'.End name: ',RoUte[i].NameKon);
readln
end;

Procedure Save_Dan;
Var
SA:Text;
i:integer;
name:string;
begin
ClrScr;
Write('Enter name save file: ');
Read(name);
{$I-}
Assign(SA,name+'.txt');
{$I+}
ReWrite(SA);
for i:=1 to Zap_i do
begin
  WriteLn(SA,RoUte[i].NumbMar);
  WriteLn(SA,RoUte[i].NameSt);
  WriteLn(SA,RoUte[i].NameKon);
  Writeln(SA)
end;
close(sa)
end;

begin
Zap_i:=0;
Ex:=false;
Repeat
ClrScr;
WriteLn('1.Enter Dan.');
WriteLn('2.Open Dan.');
WriteLn('3.Save Dan.');
Key:=ReadKey;
case Ord(Key) of
49:Enter_Dan;
50:Open_Dan;
51:Save_Dan;
27:Exit;
end;
until Ex=true;
end.

Да лана - какой тут талант просто очень нравится этим заниматься не всегда получается с первого раза - очень иногда сильно ругаюсь, когда программа не работает как надо

[Sergeo_89]

Слушай а вот еще вопрос, как добавить в основное меню Кнопку "Выход из программы" наряду с теми Трюмя и как в каждый тех из Трех Сделать панельку "Назад"?))Это вообще возможно в паскале?))

Я тоже иногда Ругаюсь когда что-то не получается) я посмотрел ты на гитаре играешь)) я тоже ниплоха))Самоучка правда) ты на Электро или аккустика?