Главная » Контрольные

Pascal. Контрольная работа Технологии программирования

Задачи Pascal

1. type myfile = file of char;
Опишите процедуру delete (f), удаляющую из файла f все литеры '+' и '-'.

 

program zadanie1;
uses crt;
type myfile = file of char;
var
  s:string;
  f,f2:text;
  n,i:integer;

Procedure delete;
 begin
 assign(f2,'file2.txt');
 rewrite(f2);
 reset(f);
  while  not eof(f) do
  begin
    readln(f,s);
    for i:=1 to length(s) do
     if (s[i]='+') or (s[i]='-')then
     delete(s,i,1);
     writeln(f2,s);
  end;
  close(f2);
 readkey;
 end;

begin
 clrscr;
 writeln('vvedite kol-vo strok');
 readln(n);
 assign(f,'file.txt');
  rewrite(f);
  for i:=1 to n do
   begin
    writeln('vvedite ',i,' stroku');
    readln(s);
    writeln(f,s);
   end;
 delete;
 close(f);
end.

 

 

2. Файл f содержит записи следующей структуры:
- имя студента;
- пол;
- рост;
- оценки по трем экзаменам.

Написать функцию TASK_3_1 (f), проверяющую, есть ли среди девушек круглые отличницы

 

program zadanie2;
 uses crt;
 const n=3; {количество студентов 3-это для проверки программы, возьмешь больше}

 type f=record {тип запись с полями}
  fam:string[15]; {фамилия}
  pol:string;
  oc:array[1..5]of byte;{массив оценок}
  sr:real;{средний балл}
 end;

var sp:array[1..n] of f;{массив записей-список студентов}
i,j,k:integer;

 Function TASK:integer;
 var k : integer;
 begin
    readln;
    writeln('Krugliy oylichnik:');
    k :=0;
    for i:=1 to n do
    if ((sp[i].sr=5) and ((sp[i].pol='ж') or (sp[i].pol='Ж') or (sp[i].pol='д') or (sp[i].pol='Д'))) then
       begin
         k:=K+1;
         writeln(sp[i].fam);
       end;{если ср. балл=5, круглый отличник}
    Task :=K;
 end;

 begin
  clrscr;
  for i:=1 to n do
   begin
    writeln('Student ',i); {вводим данные}
    write('Familia: ');readln(sp[i].fam);
    write('Pol(М/Ж): ');  {РУССКИЕ БУКВЫ вводить надо либо в условии что выше заменить их на латинские}
    readln(sp[i].pol);
    sp[i].sr:=0;

    for j:=1 to 5 do
     begin
      repeat
      write('Ocenka ',j,'=');
      readln(sp[i].oc[j]);
      until sp[i].oc[j] in [2..5];
      sp[i].sr:=sp[i].sr+sp[i].oc[j];
     end;
    sp[i].sr:=sp[i].sr/5;{считаем и запоминаем средний балл}
   end;

   clrscr;
   writeln('Spisok studentov:');{посмотрим весь список}
   for i:=1 to n do
    begin
     write(sp[i].fam,' ');
     write(sp[i].pol,' ');
     for j:=1 to 5 do
     write(sp[i].oc[j],' ');
     write('sr ball=',sp[i].sr:0:2);
     writeln;
    end;
    begin
   If TASK=0 then WriteLn('Среди девушек нет отличниц');
   readln;
end;
end.

 

 

3. Задан текстовый файл 'a.txt'. Написать программу, которая меняет местами в словах, являющимися вещественными числами, целую и дробную часть.

 

Program zadanie3;
uses crt;
var
 f: text;
 s,ch : string;
 p:integer;
 
begin
 assign(f,'Z6.txt');
  rewrite(f);
  clrscr;
  readln(s);
  p:=pos('.', s);
  ch:=copy(s, p+1, length(s));
  ch:=ch+'.'+copy(s, 0, p-1);
  writeln(ch);
  close(f);
  readkey;
end.

 

4. Описать процедуру, которая меняет местами первый и последний элементы списка L.

type te = integer;
sp = ^el;
el = record d :te; n :sp; end;
var L : sp; E : te;
program zadanie4; uses crt; type te = integer; sp=^el; el=record te:integer; d:te; n:sp end; var l:sp; procedure createList(var d:sp;c:integer); var b:sp; begin while c>0 do begin new(b); b^.te:=random(20); b^.n:=d; d:=b; dec(c); end; end; procedure outputList(b:sp); begin while b<>nil do begin write(b^.te:4); b:=b^.n; end; end; procedure modifyList(var b:sp); var c:sp; e:te; begin c:=b; {ищем конец списка} while c^.n^.n<>nil do c:=c^.n; {закольцовываем его исключая первый элемент} c^.n^.n:=b^.n; {устанавливаем первый элемент перед последним} b^.n:=c^.n; {переключаем связи} c^.n:=b; {сохраняем голову списка и разрываем кольцо} b:=b^.n; c^.n^.n:=nil; end; procedure deleteList(var b:sp); var c:sp; begin repeat c:=b; b:=b^.n; dispose(c); until b=nil; end; begin {создаем список} l:=nil; createList(l,10); {выводим исходный список} outputList(l); writeln; {изменяем список} modifyList(l); {выводим результат и освобождаем память} outputList(l); deleteList(l); readln; end.

5. Описать процедуру, которая создает новый список, в котором все элементы списка L расположены в обратном порядке.

 

type te = integer;
sp = ^el;
el = record d :te; n :sp; end;
var L : sp; E : te;
 
program zadanie4var7;

uses Crt;
const
 n = 10;    {количество элементов в списке,можно поменять на большее}
 
type //te = integer;
sp = ^el;
el = record
te :integer;
n :sp;
end;
var
 L : sp;
 E,t : sp;
 
 procedure InputData;   {процедура ввода массива случайными числами}
  var
   i: integer;
  begin
   New(t);
   t^.n:=nil;
   t^.te:=random(100);
   l:=t;
   e:=t;
   for i:=1 to n do
    begin
     New(t^.n);
     t:=t^.n;
     t^.n:=nil;
     t^.te:=random(100);
     e:=t;
    end;
  end;

 procedure OutputData;     {процедура вывода массива}
  begin
   t:=l;
   while t <> nil do
    begin
     write(t^.te,' ');
     t:=t^.n;
   end;
  end;

Procedure povorot(var p:sp);  {процедура обратного порядка}
begin
  if p^.n<>nil then
  begin
    povorot(p^.n);
    p^.n^.n:=p;
  end;
end;

begin
 ClrScr;
 Randomize;   {заполняем случайным порядком}
 InputData;    {вызаваем процедуру ввода массива}
 OutputData;     {вызываем процедуру вывода массива}
 povorot(l);   {вызываем процедуру обратного порядка}
 l^.n:=nil;
 t:=l;
 l:=e;
 e:=t;
 writeln;
 OutputData;
 readkey;
end.

 

kann man levitra in der apotheke kaufen achat viagra en ligne canada buy cialis canada no prescription kamagra jelly apotheke sildenafil billig bestellen