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

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

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

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


Профи
****

Группа: Пользователи
Сообщений: 920
Пол: Женский
Реальное имя: Марина

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


задние такое: нарисовать равнобокую трапецию и закрасить её последовательно разными цветами.

Вот основная программ:


uses Graph;

type
TTrap = record
x, y, a, b, h: integer;
end;

function InitGraphMode: boolean;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,' ');
ErrCode := GraphResult;
if ErrCode <> grOk then
begin
InitGraphMode := false;
Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end
else
InitGraphMode := true;
end;

procedure DrawTrapecia(ATrap: TTrap; c: integer);
var
d: integer;
x_: integer;
begin
setcolor©;
d := (ATrap.a - ATrap.b) div 2;

if d > 0 then
x_ := ATrap.x + d
else
x_ := ATrap.x;

moveto(x_, ATrap.y);
lineto(x_ + ATrap.b, ATrap.y);

if d > 0 then
x_ := ATrap.x + ATrap.a
else
x_ := ATrap.x + ATrap.a - d;

lineto(x_, ATrap.y + ATrap.h);
lineto(x_ - ATrap.a, ATrap.y + ATrap.h);
lineto(x_ - ATrap.a + d, ATrap.y);
end;

function Max(t1, t2: integer): integer;
begin
if t1 >= t2 then
Max := t1
else
Max := t2;
end;

procedure LineTrapFill(ATrap: TTrap; l, c: integer);
var
w, d, x1, x2, f: integer;
begin
w := Max(ATrap.a, ATrap.b);
d := abs(ATrap.a - ATrap.b) div 2;

f := l * d div ATrap.h;

if ATrap.a > ATrap.b then
f := d - f;

x1 := ATrap.x + f;
x2 := ATrap.x + w - f;
setcolor©;
MoveTo(x1, ATrap.y + l);
LineTo(x2, ATrap.y + l);
end;

procedure TrapFill(ATrap: TTrap);
var
i: integer;
begin
for i := 0 to ATrap.h - 1 do
begin
LineTrapFill(ATrap, i, 14);

end;
end;

var

Trap: TTrap;

begin
if InitGraphMode then
begin { Do graphics }

with Trap do
begin
x := 200;
y := 200;
a := 300;
b := 200;
h := 100;
end;

DrawTrapecia(Trap, 4);
TrapFill(Trap);

Readln;
CloseGraph;
end;
end.




это процедура для закрашивания трапеции


procedure TrapFill(ATrap: TTrap);
var
i: integer;
begin
for i := 0 to ATrap.h - 1 do
begin
LineTrapFill(ATrap, i, 14);

end;
end;



у меня такой вопрос : что добавить в эту процедуру закрашивания , чтобы трапеция закрашивалась разными цветами

?????

( у меня такая мысль : добавить i mod 16, но не знаю куда....)

Сообщение отредактировано: 18192123 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Можешь сделать
 LineTrapFill(ATrap, i,  i mod 14);
, например... Правда, такой бред должен будет получиться blink.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Профи
****

Группа: Пользователи
Сообщений: 920
Пол: Женский
Реальное имя: Марина

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


Цитата(volvo @ 11.12.2006 23:02) *

Можешь сделать
 LineTrapFill(ATrap, i,  i mod 14);
, например... Правда, такой бред должен будет получиться blink.gif

а как сделать, чтоб пользователь сам мог вводить размеры трапеции?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Перед инициализацией граф. режима запрашивай необходимые размеры, и записывай их в структуру Trap, вместо того, чтобы записывать туда константы...
 К началу страницы 
+ Ответить 

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

 





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