IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Множества и записи!
сообщение
Сообщение #1


Гость






Помогите, кто чем может! Во вторник экзамен, а мне нужно ещё несколько заданий доделать. Вроде рагьше писал, похожие программы, а вчера сел и понял, что всё забыл. Задачи такие:
1. На плоскости заданы n точек, определить между какими самое большое растояние. Я найти растояние только между соседними точками, подскажите как проверить все комбинации.
2. Среди работников данного предприятия найти тех, чья з/п ниже средней, а так же распечатать список тех, которые на предприятии более 10 лет с указанием з/п, фамилии, стажа и должности.
3. Дан массив, содержащий информацию об учениках, выяснить на сколько человек в 8-х классах больше чем в 9-х.
4. Опишите матрицу А размером 100х200 элементов типа char. Заполнить её процедурой FillChar (А, 2000, 'х').
5. Составить программу размещения ДРП, строка за строкой, треугольной матрицы размером N, в i-той строке которой i компонетнтов типа word, i=1,2,3,..,N. Занесите в элемент массива Mem N соответственно. Извините за нечёткие фразы, просто мне так переписали задание(.
6. Создать окно в рамке  на фоне, заполненном псевдографическим символом #176 синего цвета, с текстом из файла. Выполнять перемещение окна вверх, вниз, вправо или влево с сохранением фона по клавишам управления курсором.

Пожалуйста помогите! Я отблагодарю!.   :'(
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


У нас завтра (в понедельник) экзамен по информе, а на консультации нам сказали что больше всего запоров на работе с файлами и множествами, поэтому в качастве самопроверки, я решил попробывать решить тебе 2-ую задачу: ;)
Код

uses crt;
const
    n=84;
    p:array[1..5] of string=('programmer','sisadmin','taxidriver','mehanic','journey');
    f:array[1..10] of string=('f1','f2','f3','f4','f5','f6','f7','f8','f9','f10');
type
   base=record
              prof     :string;
              zp       :integer;
              fam      :string;
              st       :integer;
   end;
var
  work         :array[1..n] of base;
  i            :integer;
begin
    clrscr;
    randomize;
    for i:=1 to n do
        begin
             work[i].prof:=p[random(4)+1];
             work[i].fam:=f[random(9)+1];
             work[i].st:=random(15)+1;
             work[i].zp:=random(9000)+1000;
        end;
    {for i:=1 to n do
        begin
             writeln('family: ',work[i].fam);
             writeln('proffession: ',work[i].prof);
             writeln('stage: ',work[i].st);
             writeln('z/p: ',work[i].zp);
             writeln('-------------------');
        end;
    readln;
    clrscr;}              {vivid kajdogo rabochego}
    writeln('ludi s z/p nije srednego:');
    readln;
    for i:=1 to n do
        begin
             if (work[i].zp<5000) then
                begin
                     writeln('family: ',work[i].fam);
                     writeln('proffession: ',work[i].prof);
                     writeln('stage: ',work[i].st);
                     writeln('z/p: ',work[i].zp);
                     writeln('-------------------');
                end;
        end;
    readln;
    clrscr;
    writeln('ludi so stagem bolee 10-ti let:');
    readln;
    for i:=1 to n do
        begin
             if (work[i].st>10) then
                begin
                     writeln('family: ',work[i].fam);
                     writeln('proffession: ',work[i].prof);
                     writeln('stage: ',work[i].st);
                     writeln('z/p: ',work[i].zp);
                     writeln('-------------------');
                end;
        end;
    readln;
end.



--------------------
На самом деле самого дела нет. В самой деятельности заключена самость дела и наоборот. Наоборот получим оборот на, таким образом перевернем образ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Цитата
как проверить все комбинации

Примерно в таком духе:
Код

for i:=1 to n do
   for j:=1 to i do {можно и до n делать, но так исключается проверка пар i--j и j--i (это одно и то же +))}
       if i<>j then <работа с i-й и j-й точками>



Про 3-ю и 5-ю поподробней пожалуйста... что такое ДРП? Как дана информация об учениках (типа списка ученик-класс или еще как...)


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Про учеников, ничего точно сказать не могу, в задании не написано, скорее всего ФИО ученика-класс и всё.
ДРП, я сам сомневаюсь, но мне кажется это динамическое распределение памяти. Огромное спасибо за помощь! Если что нужно из Астрахани обращайтесь, там рыба какая или чего ещё)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


Мне пожалуйста бутер с красной икрой на мыло ;)


--------------------
На самом деле самого дела нет. В самой деятельности заключена самость дела и наоборот. Наоборот получим оборот на, таким образом перевернем образ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


Вот нафигачил третью:
Код

uses crt;
type
   base=record
              name:string;
              fam:string;
              klass:byte;
   end;
const
    n=100;
    na:array[1..5] of string=('Vasya','Andrey','Sasha','Petya','Misha');
    fa:array[1..5] of string=('Petrov','Ivanov','Sidorov','Vasechkin','Gulkin');
var
  school       :array[1..n] of base;
  i,k8,k9       :integer;
begin
clrscr;
randomize;
for i:=1 to n do
   begin
        school[i].name:=na[random(4)+1];
        school[i].fam:=fa[random(4)+1];
        school[i].klass:=random(10)+1;
   end;
k8:=0; k9:=0;
for i:=1 to n do
begin
    if (school[i].klass=8) then k8:=k8+1;
    if (school[i].klass=9) then k9:=k9+1;
end;
writeln('razniza uchenikov 8-ogo i 9-ogo klassa = ',abs(k8-k9));
readln;
end.


--------------------
На самом деле самого дела нет. В самой деятельности заключена самость дела и наоборот. Наоборот получим оборот на, таким образом перевернем образ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Пионер
**

Группа: Пользователи
Сообщений: 146
Пол: Мужской

Репутация: -  2  +


Rzevsky  НУС ШУРА ВЫ ДАЁТЕ!!! СМОТРИТЕ КАК БЫ ВАС НЕ ЗАПОЛИЛИ.....
ПОРУЧЧИКС.....А ИКОРКА У НАС КЛАССНАЯ...ПРОСТО НЕ ТО СЛОВО...........
САМЫЕ УМНЫЕ РЕШАЮТ ЗАДАЧИ В ФОРУМАХ ХЕХ
ЗЫ ЗЫ ЗЫ.............
У МЕНЯ ЧЕТВЁРТАЯ ЗАДАЧА ТАКАЯ ЖЕ КАК У ТЕБЯ....НО Я ЕЁ ПОКА НЕ РЕШИЛ...
ТАМА НЕ ТАК ТО ПРОСТО......ВСЯ МАТРИЦА В ДИНАМИЧЕСКУЮ ПАМЯТЬ НЕ ЗАЛАЗИТ
ГЫ ГЫ ГЫ МЛИН НУ ПОЧЕМУ НЕ 100Х100....ТОГДА БЫ ПРОЩЕ ПАРИНОЙ РЕПЫ.....В НЕСКОЛЬКО СТРОК...... :D :D ???
КСТАТИ КТО Я УЗНАЛ???


--------------------
Закон иудеев: Семь раз отмерь, один отрежь.
Закон экономии: Семь раз отмерь, семь раз отрежь.
Закон программиста: Семь раз отрежь, ошибся, отмерь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Пионер
**

Группа: Пользователи
Сообщений: 146
Пол: Мужской

Репутация: -  2  +


Эта задача с форума на исходниках........(спасибо модератору some1)
У меня такая же.......вот только в процедурах не разобрался ещё!!!
Господа программёры....может кто разбирается в модуле crt.....
Прошу вас напишите к этой проге комментарии.....а именно коментарии к процедурам.....а то у нас даже в методичках такого нету........
Если можно поподробнеее.......Заранее благодарен!!!
Код

program l2;
uses crt;
const
 {Имя файла, которым должен заполняться фон}
 {Фон}
 BackFGColor=LightGray;
 BackBGColor=Blue;
 BackSymbol=176;
 BackValue=BackBGColor shl 12+BackFGColor shl 8+BackSymbol;
 {Атрибуты окна}
 {-начальное положение (начиная с 0)}
 WinStartXPosition=9;
 WinStartYPosition=4;
 {Размер}
 WinXSize=40;
 WinYSize=12;
 {-Символы бордюра окна}
 WinBorderTopLeft=#201;
 WinBorderTopBottom=#205;
 WinBorderTopRight=#187;
 WinBorderLeftRight=#186;
 WinBorderBottomLeft=#200;
 WinBorderBottomRight=#188;
 {-Цвет бордюров окна}
 WinBorderFGColor=White;
 WinBorderBGColor=LightGray;
 WinBorderColor=WinBorderBGColor shl 4+WinBorderFGColor;
 {-Цвет и символ внутренности окна}
 WinContFGColor=black;
 WinContBGColor=LightGray;
 WinContSymbol=' ';
 WinContColor=WinContBGColor shl 4+WinContFGColor;
 {Кнопки клавиатуры}
 KeyEsc=#27;
 KeyLeft=#75;
 KeyUp=#72;
 KeyRight=#77;
 KeyDown=#80;
 KeyEnter=#13;
type
 Letter=record
   case boolean of
     false: (val:char; col:byte);
     true: (dat:word;)
 end;
 TWindow=record
   Data:array[1..WinYSize,1..WinXSize] of Letter;
   Background:array[1..WinYSize,1..WinXSize] of Letter;
   x,y:integer;
   XSize,YSize:word;
 end;
var
 ScreenBuffer:array[1..25,1..80] of Letter;
 Screen:array[1..25,1..80] of Letter absolute $B800:0000;
 p,o:word;
 temp:char;
 Window:TWindow;
 f:text;
 FileName:string[12];

procedure DrawWindow(var Win:TWindow);
var
 p,o:byte;
begin with Win do
 for o:=0 to high(Data)-low(Data) do
 for p:=0 to high(Data[1])-low(Data[1]) do
 if (y+o in [0..high(ScreenBuffer)-low(ScreenBuffer)])and
 (x+p in [0..high(ScreenBuffer[1])-low(ScreenBuffer[1])]) then
 begin
   Background[low(Background)+o,low(Background[1])+p]:=
     ScreenBuffer[low(ScreenBuffer)+y+o,low(ScreenBuffer[1])+x+p];
   ScreenBuffer[low(ScreenBuffer)+y+o,low(ScreenBuffer[1])+x+p]:=
     Data[low(Data)+o,low(Data[1])+p];
 end;
end;

procedure ClearWindow(Win:TWindow);
var
 p,o:byte;
begin with Win do
 for o:=0 to high(Background)-low(Background) do
 for p:=0 to high(Background[1])-low(Background[1]) do
 if (y+o in [0..high(ScreenBuffer)-low(ScreenBuffer)])and
 (x+p in [0..high(ScreenBuffer[1])-low(ScreenBuffer[1])]) then
 ScreenBuffer[low(ScreenBuffer)+y+o,low(ScreenBuffer[1])+x+p]:=
   Background[low(Background)+o,low(Background[1])+p];
end;

procedure InitWindow(var Win:TWindow;x,y:integer;XSize,YSize:word;ShowNow:boolean);
var
 p,o:byte;
begin
 if(XSize<2)or(YSize<2) then exit;
 Win.x:=x;
 Win.y:=y;
 Win.XSize:=XSize;
 Win.YSize:=YSize;
 with Win do
 begin
   Data[Low(Data),Low(Data[1])].val:=WinBorderTopLeft;
   Data[Low(Data),Low(Data[1])].col:=WinBorderColor;
   Data[Low(Data),high(Data[1])].val:=WinBorderTopRight;
   Data[Low(Data),high(Data[1])].col:=WinBorderColor;
   Data[high(Data),Low(Data[1])].val:=WinBorderBottomLeft;
   Data[high(Data),Low(Data[1])].col:=WinBorderColor;
   Data[high(Data),high(Data[1])].val:=WinBorderBottomRight;
   Data[high(Data),high(Data[1])].col:=WinBorderColor;
   for o:=Low(Data)+1 to high(Data)-1 do
   begin
     Data[o,low(Data[1])].val:=WinBorderLeftRight;
     Data[o,low(Data[1])].col:=WinBorderColor;
     Data[o,high(Data[1])].val:=WinBorderLeftRight;
     Data[o,high(Data[1])].col:=WinBorderColor;
   end;
   for p:=Low(Data[1])+1 to high(Data[1])-1 do
   begin
     Data[low(Data),p].val:=WinBorderTopBottom;
     Data[low(Data),p].col:=WinBorderColor;
     Data[high(Data),p].val:=WinBorderTopBottom;
     Data[high(Data),p].col:=WinBorderColor;
     for o:=Low(Data)+1 to high(Data)-1 do
     begin
       Data[o,p].val:=WinContSymbol;
       Data[o,p].col:=WinContColor;
     end;
   end;
 end;
 if ShowNow then DrawWindow(Win);
end;

begin
 clrscr;
 for o:=low(ScreenBuffer) to high(ScreenBuffer) do
 for p:=low(ScreenBuffer[1]) to high(ScreenBuffer[1]) do ScreenBuffer[o,p].dat:=BackValue;
 move(ScreenBuffer,screen,sizeof(screenBuffer));
 writeln('введите путь к файлу и имя ');
 read(FileName);
 assign(f,FileName);
 reset(f);
 o:=low(screenBuffer);
 p:=low(ScreenBuffer[1]);
 while not eof(f) and (o<=high(ScreenBuffer)) do
 begin
   read(f,temp);
   if temp=KeyEnter then
   begin
     read(f,temp);
     p:=low(ScreenBuffer[1]);
     inc(o);
   end else if p<=high(ScreenBuffer[1]) then
   begin
     ScreenBuffer[o,p].val:=temp;
     inc(p);
   end;
 end;
 close(f);
 InitWindow(Window,WinStartXPosition,WinStartYPosition,WinXSize,WinYSize,true);
 move(ScreenBuffer,screen,sizeof(screenBuffer));
 repeat
   if keypressed then case readkey of
     KeyEsc: break;
     #0: case readkey of
       KeyLeft:
       begin
         ClearWindow(Window);
         dec(Window.x);
         DrawWindow(Window);
       end;
       KeyUp:
       begin
         ClearWindow(Window);
         dec(Window.y);
         DrawWindow(Window);
       end;
       KeyRight:
       begin
         ClearWindow(Window);
         inc(Window.x);
         DrawWindow(Window);
       end;
       KeyDown:
       begin
         ClearWindow(Window);
         inc(Window.y);
         DrawWindow(Window);
       end;
     end;
   end;
   move(ScreenBuffer,screen,sizeof(screenBuffer));
 until false;
end.

Во вторник мы Саней (Rzevsky) будем вешаться ;D ;D :D


--------------------
Закон иудеев: Семь раз отмерь, один отрежь.
Закон экономии: Семь раз отмерь, семь раз отрежь.
Закон программиста: Семь раз отрежь, ошибся, отмерь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Матрица 100х200 должна вмещатся, это ж всего 19,5 кило.
Проходит такой вариант заполнения:
Код

FillChar(A, sizeof(A),'x'); {Заполняет всю матрицу}

А вот тут Винда начинает возражать:
Код

FillChar(A, 2000, 'x'); {Вообще я таким никогда не пользовался, обычно удобно так весь массив заполнять}


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Пионер
**

Группа: Пользователи
Сообщений: 146
Пол: Мужской

Репутация: -  2  +


trminator Да ты прав там нужно только изменить установленный по умолчанию объём динамической памяти....мне уже объяснили.....
директиву добавить нада
{$M 1024,0,100000} а потом матрица залазит туда... просто...
Код

{$M 1024,0,100000}
type
 pmatr=^matr;
 matr=array[1..100,1..200] of char;
var
 m:pmatr;

и всё нормуль.....
Код

fillchar(A^,sizeof(matr),'X');


Ах с crt бы ещё разобраться....
trminator ты случайно не знаешь где можно найти подобную прогу только с коментариями....а то я сам разобраться не могу....или хотя бы где можно достать
немного теории по crt, именно такой, которая нужна для решения поставленной
передо мной задачи....


--------------------
Закон иудеев: Семь раз отмерь, один отрежь.
Закон экономии: Семь раз отмерь, семь раз отрежь.
Закон программиста: Семь раз отрежь, ошибся, отмерь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


Матрица у меня влезала не в динамическую память, а в обычную...
С CRT я работать вообще почти не умею +(


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 18.11.2017 7:59
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"