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


Пионер
**

Группа: Пользователи
Сообщений: 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 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





- Текстовая версия 5.09.2025 12:07
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name