Бесплатно создать живой форум для общения, сайта, игр!
Ведущий российский сервис бесплатных форумов ЖивыеФорумы.ру
Удобные, многофункциональные и надёжные форумы бесплатно.

Фавикон: Ftm и этим все сказано

«Ftm и этим все сказано»

Ftm и этим все сказано
Ftm и этим все сказано

Активные темы на форуме «Ftm и этим все сказано»:

Лабораторные работы>>Вариант 21
Последнее сообщение от Slonik в :

Домашнее задание
Составить список компьютеров, находящихся в аудитории. Для каждого компьютера
указать номер, размер монитора, частоту процессора, объем оперативной памяти, размер
жесткого диска, наличие DVD-привода (да, нет).

Код:
program DZ;
uses crt;
type
sp=record
nam:integer;
n:integer;
dr:integer;
gp:integer;
g:integer;
o:string;
  end;
 myfile = file of sp;
procedure show(var f: myfile);
 var a:sp;
  begin
   reset(f);
   while not eof(f) do
    begin
     read(f,a);
     writeln(a.nam:5,a.n:3,a.dr:5,a.gp:5,a.g:5,a.o:5);
    end;
  end;
procedure Vvod(var f:myfile);
 var a:sp;
  begin
    reset(f);
    with a do
     begin
     write('Nomer kompa: '); readln(nam);
     write('Razmer monitora: '); readln(n);
     write('Chastota processora: '); readln(dr);
     write('Obem operativoy pamati: '); readln(gp);
     write('Razmer Goskogo diska: '); readln(g);
     write('Nalichie privoda(da/net): '); readln(o);
   end;
   seek(f,filesize(f));
   write(f,a);
   close(f);
   end;
procedure delete(var f:myfile);
 var c:integer;
     n,i:integer;
     a:sp;
      begin
       reset(f);
       if filesize(f)=0 then
       begin
        write('file pust');
        exit
       end;
   n:=filesize(f);
   write('number zap: ');
   readln(c);
   if (c<0)or(c>n-1) then
   exit;
   n:=n-1;
   for i:=1 to n-1 do
    begin
     seek(f,i+1);
     read(f,a);
     seek(f,i);
     write(f,a);
    end;
   seek(f,n);
   truncate(f);
   close(f);
  end;
procedure savetext(var f: myfile);
 var t:text;
 nam: string;
 a:sp;
  begin
   write('name text: ');
   readln(nam);
   if length(nam)=0 then exit;
   assign(t,nam);
   rewrite(t);
   reset(f);
    begin
     while not eof(f) do begin read(f,a);
     writeln(a.nam:5,a.n:3,a.dr:5,a.gp:5,a.g:5,a.o:5);
    end;
   close(f);
   close(t)
   end;
  end;
procedure savetip(var f: myfile);
 var t: text;
     nam: string;
     z: sp;
  begin
   write('name file: ');
   readln(nam);
   if length(nam)=0 then exit;
   assign(t,nam);
   reset(t);
   rewrite(f);
  while not eof(t) do begin with z do
  readln(t,nam,n,dr,gp,g,o);
  write(f,z);
  end;
  close(f);
  close(t);
 end;
Var f:myfile;
    c:integer;
Begin
 Assign(f,'DZ1S2.bin');
 {$I-}
 Reset(f);
 {$I+}
If IoResult<>0 then
Rewrite(f);
Repeat
 writeln('1-Vivesti dannie');
 writeln('2-Vvesti dannie');
 writeln('3-Udalit dannie');
 writeln('4-Sohranit v text');
 writeln('5-Perepisat v Bin');
 writeln('0-Vihod');
  Repeat
   write('? ');
   readln(c);
  Until (c>=0) and (c<=5);
 case c of
   1: show(f);
   2: Vvod(f);
   3: delete(f);
   4: savetext(f);
   5: savetip(f);
  end;
 readln;
 clrscr;
 until c=0;
END.

Отчет скачать

Лабораторные работы>>Вариант 13
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №2
Имеется информация о 15 ответственных квартиросъемщиках: фамилия, инициалы, адрес (улица, дом, квартира); квартплата в рублях за месяц; месяц, за который внесена квартплата. Напечатать список квартиросъемщиков, имеющих задолженность 1 квартале.

Код:
Program S2Lab2;
uses crt;
type sem=record
     fam:string[20];
     adress:string[20];
     kv:integer;
     mes:integer;
     end;
Var sp:array [1..10] of sem;
    a:string;
    q,i,n,w:integer;
Begin
clrscr;
writeln;
write('Vvedite kol vo zapisey (ot 1 do 15): ');
readln(n);
If n>15 then write('Zap bolshe 15!!!! Nado 15<') Else
Begin
writeln('Vvedite dannb)e');
For i:=1 to n do
 Begin
  write('Familia i iniciali: ');
   readln(sp[i].fam);
  write('Adress: ');
   readln(sp[i].adress);
  write('Kvarplata za mes: ');
   readln(sp[i].kv);
  write('Mesac za kotoriy vnesena kvart plata: ');
   readln(sp[i].mes);
 End;
writeln('Spisok dolznikov');
For i:=1 to n do
Begin
if sp[i].mes<=3 then
Begin
write(sp[i].fam,'   ');
write(sp[i].adress,'    ');
write(sp[i].kv,'     ');
writeln(sp[i].mes);
End;
End;
End;
readln;
End.
Лабораторные работы>>Вариант 8
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №2
Дан массив записей, содержащий информацию об автовладельцах (фамилия владельца, марка машины, год выпуска автомобиля, регистрационный номер). Определить долю автомобилей, чей возраст превышает 10 лет, а также количество автомобилей заданной марки.

Код:
Program S2Lab2;
uses crt;
type avto=record
     fam:string[20];
     mark:string[20];
     god:integer;
     nomer:string[20];
     end;
Var sp:array [1..10] of avto;
    a:string;
    q,i,n,w:integer;
Begin
clrscr;
writeln;
write('Vvedite kol vo zapisey (ot 1 do 10): ');
readln(n);
If n>10 then write('Zap bolshe 10!!!! Nado 10<') Else
Begin
writeln('Vvedite dannb)e');
For i:=1 to n do
 Begin
  write('Familia vladelca: ');
   readln(sp[i].fam);
  write('Marca mashini: ');
   readln(sp[i].mark);
  write('God vipuska: ');
   readln(sp[i].god);
  write('Reg nomer: ');
   readln(sp[i].nomer);
 End;
writeln('Vvedite marku');
readln(a);
q:=0;
w:=0;
For i:=1 to n do
Begin
if sp[i].god>10 then q:=q+1;
 If sp[i].mark=a then w:=w+1;
End;
writeln('Vsego mashin starshe 10 let: ',q);
writeln('Vsego mashin zadannoy marki: ',w);
End;
readln;
End.
Лабораторные работы>>Вариант 5
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №1
Дана непустая последовательность символов. Среди символов последовательности могут встречаться буквы латинского алфавита, цифры и знаки препинания. С использованием множеств удалить из последовательности встречающиеся в ней знаки препинания.

Код:
program lab1;
var c:string;
a,i:integer;
st:set of ','..'.';
Begin
  write('Vvedite posledovatelnost ');
  readln(c);
a:=length(c);
st:=['.',':',';',',','!'];
  for i:=1 to a do
  if not (c[i] in st) then write (c[i]);
  readln;
  End.
Лабораторные работы>>Вариант 7
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №7
Задан массив, содержащий информацию об автомобилях. Для каждого автомобиля указана марка, тип автомобиля (грузовой, пассажирский, легковой), цвет и год выпуска. Построить круговую диаграмму, отражающую процентный состав автомобилей по признаку «тип автомобиля».

Код:
uses crt, graph;
const r=152;
avto=3;
type
        A = record
                nazvanie: string;
                cvet: string;
                god: integer;
                tip: integer;
        end;
var i : integer ;
ar: array[1..10] of a;
        k,m0,m1,m2,l,l0:integer;
        ro:real;
        Driver, Mode: Integer;
        Xasp, Yasp: Word;
begin
clrscr;
writeln('Kol-vo tipov: 3' ) ;
readln;
for i:=1 to avto do
begin
writeln('Marca: ');
Readln(ar[i].nazvanie);
writeln('Cvet:');
Readln(ar[i].cvet);
ar[i].tip:=random(5);
writeln('Tip:');
ar[i].tip:=random(200);
writeln(ar[i].tip);
end;
writeln('„Ё Ја ¬¬  :');
        for i:=1 to avto do
        k:=k+ar[i].tip;
        ro:=360/k;
        m0:= ar[1].tip*trunc(ro);
        m1:=ar[2].tip*trunc(ro);
        m2:=ar[3].tip*trunc(ro);
        driver:=Detect;
        InitGraph(Driver, Mode, '');
        SetFillStyle(4, 2);
        Sector(GetMaxX Div 2, GetMaxY Div 2, 0, m0, R, R);
        Bar(480, 50, 500, 70);
        outtextxy(504,60,ar[1].nazvanie);
         SetFillStyle(5, 3);
        Sector(GetMaxX Div 2, GetMaxY Div 2, m0, m1+m0, R, R);
        Bar(480, 80, 500, 100);
        outtextxy(504,90,ar[2].nazvanie);

        SetFillStyle(8, 8);
        Sector(GetMaxX Div 2, GetMaxY Div 2, m0+m1, m1+m0+m2, R, R);
        Bar(480, 110, 500, 130);
        outtextxy(504,120, ar[3].nazvanie);
        readln;
   CloseGraph;
end.

Отчет скачать

Лабораторные работы>>Вариант 4
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №3
Информация о товарах содержит: наименование товара, страна, импортирующая товар, объем поставляемой партии в шт. Список товаров не превышает 10. Распечатать список стран, в которые экспортируется данный товар и общий объем экспорта. Исходный массив записей, а также полученный результат записать в текстовый файл.

Код:
Program S2Lab2;
uses crt;
type tov=record
     Namtov:string[20];
     SImp:string[20];
     Stuk:integer;
     SExp:string[20];
     end;
Var sp:array [1..10] of tov;
    a:string;
    q,i,n:integer;
    f,f1:text;
Begin
clrscr;
assign(f,'Ser.txt');
Rewrite(f);
writeln;
write('Vvedite kol vo zapisey (ot 1 do 10): ');
readln(n);
If n>10 then write('Zap bolshe 10!!!! Nado 10<') Else
Begin
writeln('Vvedite dannb)e');
For i:=1 to n do
 Begin
  write('Naimen tov: ');
   readln(sp[i].Namtov); write(f,sp[i].Namtov,'    ');
  write('Strana Importer: ');
   readln(sp[i].SImp);   write(f,sp[i].SImp,'    ');
  write('Kol-vo tovara: ');
   readln(sp[i].Stuk);   write(f,sp[i].Stuk,'    ');
  write('Strana Exporter: ');
   readln(sp[i].SExp);   writeln(f,sp[i].SExp,'    ');
 End;
close(f);
write('Vvedite naimen Tovara: ');
readln(a);
  write('|Kol-vo tovara    |');
  writeln('Strana Exporter    ');
q:=0;
assign(f,'Ser.txt');
Rewrite(f);
For i:=1 to n do
Begin
q:=q+sp[i].Stuk;
 If sp[i].Namtov=a then
  Begin
   write('|',sp[i].Stuk);   write('                |'); write(f,sp[i].Stuk,'    ');
   writeln(sp[i].SExp); writeln(f,sp[i].SExp,'    ');
  End;
End;
End;
writeln('Vsego Exporta: ',q); write(f,'Vsego Exporta',q);
close(f);
readln;
End.
Лабораторные работы>>Вариант 3
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №3
Дан массив из 15 записей, содержащий информацию о студентах (фамилия, год рождения, средний балл за сессию). Определить средний балл группы по итогам сессии, а также количество студентов, учащихся на «отлично». Исходный массив записей, а также полученный результат записать в текстовый файл.

Код:
Program S2Lab3;
uses crt;
type stud=record
     fam:string[20];
     god:integer;
     ball:real;
     end;
Var sp:array [1..15] of stud;
    a:real;
    q,i,n,w:integer;
    f:text;
Begin
clrscr;
assign(f,'Vitalik.txt');
Rewrite(f);
writeln;
write('Vvedite kol vo zapisey (ot 1 do 15): ');
readln(n);
If n>15 then write('Zap bolshe 15!!!! Nado 15<') Else
Begin
writeln('Vvedite dannb)e');
For i:=1 to n do
 Begin
  write('Familia studenta: ');
   readln(sp[i].fam); write(f,sp[i].fam,'   ');
  write('God roxdeniya: ');
   readln(sp[i].god); write(f,sp[i].god,'   ');
  write('Sredniy ball za sessiyu: ');
   readln(sp[i].ball); writeln(f,sp[i].ball,'    ');
 End;
a:=0;
w:=0;
For i:=1 to n do
 Begin
  a:=a+sp[i].ball;
  if sp[i].ball=5 then w:=w+1;
 End;
a:=a/n;
writeln('Sredniy ball gruppb): ',a:2:2);
writeln(f,'Sredniy ball gruppb): ',a:2:2);
writeln('Kol-vo studentov uchasihsy na otl: ',w);
writeln(f,'Kol-vo studentov uchasihsy na otl: ',w);
End;
close(f);
readln;
End.
Лабораторные работы>>Вариант 1
Последнее сообщение от Slonik в :

ЛАБОРАТОРНАЯ РАБОТА №2
Дан массив из 20 записей, содержащих информацию о жителях: фамилия, город и адрес (улица, номер дома, номер квартиры). Напечатать фамилии тех жителей, которые живут в разных городах по одинаковому адресу.

Код:
Program S2Lab2;
uses crt;
type ludi=record
     fam:string[20];
     ulica:string[20];
     gorod:string[20];
     namDom:integer;
     namKv:integer;
     end;
Var sp:array [1..20] of ludi;
    i,a:integer;
Begin
clrscr;
writeln;
writeln('Vvedite dannb)e');
For i:=1 to 20 do
 Begin
  write('Familia vladelca: ');
   readln(sp[i].fam);
  write('Gorod: ');
   readln(sp[i].gorod);
  write('Ulica: ');
   readln(sp[i].ulica);
  write('Nomer doma: ');
   readln(sp[i].namDom);
  write('Nomer kvartiri: ');
   readln(sp[i].namKv);
 End;
writeln('Ludi zhivuchie po odnomu adresu v raznih gorodah');
For i:=1 to 20 do
 For a:=1 to 20 do
if (sp[i].gorod<>sp[a].gorod) and (sp[i].ulica=sp[a].ulica) and (sp[i].namDom=sp[a].namDom) and (sp[i].namKv=sp[a].namDom) then
writeln(sp[i].fam);
readln;
End.