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

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

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

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





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

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


Люди-человеки, помогите будной студентки разобраться в проге. blink.gif blink.gif Дали лабу с объектами, а толком ничего не объяснили. unsure.gif

Вот задание:
1) разработать интерфейсное меню, состоящее из кнопок вида ромба и квадрата
2)кнопки должны размещаться на панели и иметь объемный вид
3) текущей является кнопка серого цвета, неактивная - зеленая
4) перемещение по кнопкам производиться с помощью клавиш навигации, выбор кнопки-энтер
5) по нажатию каждой кнопки создается эффект вогнутости и выполняется действия:
на дополнительную панель внизу экрана вывести задание на лабу;
развернуть панель и вернуть ее в исходное состояние;
увеличить объемность панели...

А вот то, что я намучала:
uses crt,graph;
type
knopka=object
x0,y0,v,h:integer;
ckn,ckon:integer;
t:string[13];
activ:boolean;
procedure kvt_up;
procedure kvt_down;
procedure rmb_up;
procedure rmb_down;
procedure init(x1,y1,v1,h1:integer;ckn1,ckon1:integer);
end;
panel=object
xp,yp,vp,hp:integer;
czp:integer;
procedure draw;
procedure init(x,y,vp1,hp1:integer;colp:integer);
end;
procedure knopka.init;
begin
x0:=x1;
y0:=y1;
h:=h1;
v:=v1;
ckn:=ckn1;
ckon:=ckon1;
end;
procedure knopka.kvt_down;
begin
setcolor(black);
bar(x0-1,y0-1,x0+h,y0+v);
setfillstyle(1,black);
floodfill(x0,y0,black);
setcolor(white);
bar(x0+1,y0+1,x0+h,y0+v);
setfillstyle(1,white);
floodfill(x0,y0,white);
setcolor(darkgray);
bar(x0,y0,x0+h,y0+v);
setfillstyle(5,darkgray);
floodfill(x0,y0,darkgray);
setcolor(red);
outtextxy(x0-5,y0+5+2,t);
end;
procedure knopka.kvt_up;
begin
setcolor(15);
bar(x0-1,y0-1,x0+h,y0+v);
setfillstyle(1,15);
floodfill(x0,y0,15);
setcolor(0);
bar(x0+2,y0+2,x0+h,y0+v);
setfillstyle(1,0);
floodfill(x0,y0,0);
setcolor(2);
bar(x0,y0,x0+h,y0+v);
setfillstyle(5,2);
floodfill(x0,y0,2);
setcolor(red);
outtextxy(x0-5,y0+5*2,t);
end;
procedure rmb_up;
var poly: array[1..4] of pointtype;
begin
setcolor(8);
poly[1].x:=x0+1;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2)+1;
poly[2].y:=y0+round(v/2);
poly[3].x:=x0+1;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2)+1;
poly[4].y:=y0+round(v/2);
fillpoly(4,poly);
setfillstyle(1,15);
floodfill(x0+3),y0+round(v/2),15);
setcolor(15);
poly[1].x:=x0-1;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2)-1;
poly[2].y:=y0+round(v/2);
poly[3].x:=x0-1;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2)-1;
poly[4].y:=y0+round(v/2);
fillpoly(4,polly);
setfillstyle(1,8);
floodfill(x0,y0+round(v/2),8);
setcolor(4);
outtextxy(x0,y0+v+2,t);
setcolor(2);
poly[1].x:=x0;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2);;
poly[2].y:=y0+round(v/2);;
poly[3].x:=x0;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2);
poly[4].y:=y0-round(v/2);
fillpoly(4,poly);
setfillstyle(1,2);
floodfill(x0),y0+round(v/2),ckon);
setcolor(4);
outtextxy(x0,y0+v+2,t);
end;
procedure rmb_down;
var poly: array[1..4] of pointtype;
begin
setcolor(15);
poly[1].x:=x0+1;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2)+1;
poly[2].y:=y0+round(v/2);
poly[3].x:=x0+1;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2)+1;
poly[4].y:=y0+round(v/2);
fillpoly(4,poly);
setfillstyle(1,15);
floodfill(x0+3),y0+round(v/2),15);
setcolor(8);
poly[1].x:=x0-1;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2)-1;
poly[2].y:=y0+round(v/2);
poly[3].x:=x0-1;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2)-1;
poly[4].y:=y0+round(v/2);
fillpoly(4,polly);
setfillstyle(1,8);
floodfill(x0,y0+round(v/2),8);
setcolor(4);
outtextxy(x0,y0+v+2,t);
setcolor(7);
poly[1].x:=x0;
poly[1].y:=y0;
poly[2].x:=x0+round(h/2);;
poly[2].y:=y0+round(v/2);;
poly[3].x:=x0;
poly[3].y:=y0+v;
poly[4].x:=x0-round(h/2);
poly[4].y:=y0-round(v/2);
fillpoly(4,poly);
setfillstyle(1,ckn);
floodfill(x0),y0+round(v/2),7);
setcolor(4);
outtextxy(x0,y0+v+2,t);
end;
procedure panel.init;
begin
xp:=x;
yp:=y;
vp:=vp1;
hp:=hp1;
czp:=colp;
end;
procedure panel.draw;
begin
setcolor(15);
rectangle(xp-1,yp-1,xp-1+wp,yp-1+hp);
setfillstyle(1,15);
floodfill(xp+5,yp+5,15);
setcolor(darkgray);
rectangle(xp+2,yp+2,xp+2+vp,yp+2+hp);
setfillstyle(1,darkgray);
floodfill(xp+5,yp+5,darkgray);
setcolor(czp);
rectangle(xp,yp,xp+wp,yp+hp);
setfillstyle(1,czp);
floodfill(xp+5,yp+5,czp);
end;
procedure pan_dop;
var
text1,text2,text3:string;
begin
setcolor(6);
rectangle(220,140,420,340);
setfillstyle(1,15);
floodfill(300,200,6);
text1:='develop program ';
text2:='using ';
text3:='object programming';
outtextxy(235,145,text1);
outtextxy(235,165,text2);
outtextxy(235,185,text3);
end;
var
p:panel;
k:array[1..4] of knopka;
a:char;
i,n,gd,gm:integer;
begin
gd:=detect;
initgraph(gd,gm,'d:\bp\bgi');
setbkcolor(9);
cleardevice;
p.init(100,10,440,50,5);
p.draw;
for i:=1 to 4 do
k[i].init(i*110+40,20,20,30,7,4);
k[1].t:='zadanie';
k[2].t:='razvernut'';
k[3].t:='svernut'';
k[4].t:='ob'emnost'';
k[1].activ:=true;n:=1;
repeat
for i:=1 to 4 do
begin
if n=i then k[i].activ:=true
else k[i].activ:=false;
if k[i].activ then k[i].ckon:=4
else k[i].ckon:=7;
if (i mod 2)=0 then
k[i].romb
else
k[i].kvt;
end;
a:=readkey;
case a of
#77:if n=4 then n:=1 else n:=n+1;
#75:if n=1 then n:=4 else n:=n-1;
#13:case n of
1:begin
k[n].tr_d;delay(60000);
cleardevice;
p.init(100,10,440,50,5);
p.draw;
pan_dop;
for i:=1 to 4 do
k[i].init(i*110+40,20,20,30,7,4);
end;
2:begin
k[n].romb_d;
delay(60000);
cleardevice;
p.init(50,10,540,200,5);
p.draw;
for i:=1 to 4 do
k[i].init(i*110+40,80,30,50,7,4);
end;
3:begin
k[n].draw_down;delay(5000);
cleardevice;
p.init(150,20,300,60,cyan);p.draw;
for i:=1 to 4 do k[i].init(i*80+100,50,20);
end;
4:begin
k[n].romb_d;
delay(60000);
cleardevice;
p.init(50,10,540,200,5);
p.draw;
for i:=1 to 4 do
k[i].init(i*110+40,80,30,50,7,4);
end;
end;
end;
until a=#27;
closegraph;
end.



Очень жду и надеюсь на Вашу помощь rolleyes.gif rolleyes.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Программы, написанные по технологии Copy+Paste привести в рабочий вид гораздо сложнее, чем написать их заново. Сначала исправь все синтаксические ошибки (у тебя в программе их огромное количество. Где-то лишняя скобка при вызове процедуры; где-то ты забыла указать что процедура - это метод класса, из-за чего получаешь сообщения о неизвестных переменных. Где-то строка не является завершенной, потому что нельзя просто так добавлять в строку апостроф, его надо дублировать:
         k[4].t:='ob''emnost''';
, ну а про то, что методов romb и kvt в типе Knopka вообще нет - я уж и не говорю)...

В общем, еще раз: это делается во-первых, не копированием кусков текста из одного места в другое, а во-вторых - гораздо проще, чем сделано у тебя. Если хочешь - покажу, как. Но я делать за тебя полностью не буду, если будешь принимать в процессе написания активное участие - тогда начну объяснять... Нет - так нет.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


Я очень-очень хочу, чтобы Вы мне объяснили!!!:))))) Просто я выпрасила у одногруппников похожие проги и решила, что переделать я все же смогу, но видемо без помощи у меня мало что вышло=(((
А как можно проще написать? С ромбом можно как-то легче поступить? А вот с квадратиком разве что-то не так:
uses crt,graph;
type
knopka=object
x0,y0,v,h:integer;
ckn,ckon:integer;
t:string[13];
activ:boolean;
procedure kvt_up;
procedure kvt_down;
procedure rmb_up;
procedure rmb_down;
procedure init(x1,y1,v1,h1:integer;ckn1,ckon1:integer);
end;
panel=object
xp,yp,vp,hp:integer;
czp:integer;
procedure draw;
procedure init(x,y,vp1,hp1:integer;colp:integer);
end;
procedure knopka.init;
begin
x0:=x1;
y0:=y1;
h:=h1;
v:=v1;
ckn:=ckn1;
ckon:=ckon1;
end;
procedure knopka.kvt_down;
begin
setcolor(black);
bar(x0-1,y0-1,x0+h,y0+v);
setfillstyle(1,black);
floodfill(x0,y0,black);
setcolor(white);
bar(x0+1,y0+1,x0+h,y0+v);
setfillstyle(1,white);
floodfill(x0,y0,white);
setcolor(darkgray);
bar(x0,y0,x0+h,y0+v);
setfillstyle(5,darkgray);
floodfill(x0,y0,darkgray);
setcolor(red);
outtextxy(x0-5,y0+5+2,t);
end;
procedure knopka.kvt_up;
begin
setcolor(15);
bar(x0-1,y0-1,x0+h,y0+v);
setfillstyle(1,15);
floodfill(x0,y0,15);
setcolor(0);
bar(x0+2,y0+2,x0+h,y0+v);
setfillstyle(1,0);
floodfill(x0,y0,0);
setcolor(2);
bar(x0,y0,x0+h,y0+v);
setfillstyle(5,2);
floodfill(x0,y0,2);
setcolor(red);
outtextxy(x0-5,y0+5*2,t);
end;
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Злостный любитель
*****

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

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


Крайне не рекомендую использовать FloodFill, есть же процедура FillPoly для рисования закрашенных прямоугольников, вот ей и пользуйтесь.


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


Знаток
****

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

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


Цитата(TarasBer @ 28.02.2009 18:46) *

Крайне не рекомендую использовать FloodFill, есть же процедура FillPoly для рисования закрашенных прямоугольников, вот ей и пользуйтесь.

можешь обьеснить почему не рекомендуешь использовать FloodFill почему?


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





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

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


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


Злостный любитель
*****

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

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


Цитата(HoOope @ 28.02.2009 20:11) *

ДА, почему? ведь с помощью FillPoly так долго все описывать((


Огромная разница между FloodFill и FillPoly по части скорости и используемой памяти.
Не, если хотите, делайте так... Никто не запрешает, только это как-то по-индийски. Зачем заставлять компьютер делать лишние действия, летя в Москву через Владивосток?

Если говорить подробнее, то закраска многоугольника, при знании координат его центров, делается из линий очень просто, а уж в случае ромба - просто несколько линейно возрастающих горизонталей провести и всё. В случае же с заливкой необходимо попиксельно закрашивать всю область, при этом выполняя обход для того, чтобы рассчитать зону, ограниченную данными условиями. Обход, как известно, память требует, и делать его, когда необходимая зона и так известна - просто бессмысленно.

Сообщение отредактировано: TarasBer -


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


Гость






Цитата
А как можно проще написать? С ромбом можно как-то легче поступить?
Значит, смотри...

Начнем с того, что у тебя невнятно описана цепочка наследования. Давай посмотрим, что у тебя есть: у тебя есть прямоугольная панель, у тебя есть прямоугольная кнопка и ромбовидная кнопка. Есть ли что-то общее между всеми этими сущностями? Есть... Все они однозначно идентифицируются прямоугольником, в котором находятся. Причем как для отрисовки прямоугольной, так и для отрисовки ромбовидной кнопки нужны 4 точки. В связи с чем объекты предлагаю унаследовать так:

type
taction = procedure; { <--- Тип - процедура, которую будет выполнять кнопка }

{ Прямоугольный объект, от которого будет наследоваться все остальное }
trect_object = object
xst, yst, xfn, yfn: integer;
constructor init(x_st, y_st, x_fn, y_fn: integer);
end;
ptbutton = ^tbutton;
tbutton = object(trect_object) { Абстрактная кнопка }
caption: string;
action: taction;
constructor init(x_st, y_st, x_fn, y_fn: integer;
s: string; act: taction);
procedure draw(b: boolean); virtual;
procedure press(is_pressed: boolean); virtual;

private
function get_xst: integer; virtual;
function get_yst: integer; virtual;
function get_xfn: integer; virtual;
function get_yfn: integer; virtual;
end;

ptbutton_rect = ^tbutton_rect;
tbutton_rect = object(tbutton) { Прямоугольная кнопка }
constructor init(x_st, y_st, x_fn, y_fn: integer;
s: string; act: taction);
end;
ptbutton_romb = ^tbutton_romb;
tbutton_romb = object(tbutton) { Ромбовидная кнопка }
constructor init(x_st, y_st, x_fn, y_fn: integer;
s: string; act: taction);

private
function get_xst: integer; virtual;
function get_yst: integer; virtual;
function get_xfn: integer; virtual;
function get_yfn: integer; virtual;
end;

tpanel = object(trect_object) { Панель - она тоже прямоугольная, тоже наследник trect_object }
save_x: integer;

buttons_count: integer;
buttons: array[1 .. max_buttons] of ptbutton;

constructor init(x_st, y_st, x_fn, y_fn: integer);
procedure Insert(b: ptbutton);
procedure draw(n: integer);

procedure zoom;
procedure unzoom;

function count: integer;
end;
Попробуй посмотреть на то, что я написал, и подумать, не слишком ли это сложно для тебя. Естественно, я набросал программу, и этот кусок - именно оттуда, эта иерархия работает, причем работает прекрасно. Основная программа выглядит вот так:
begin
gdriver := detect;
initgraph(gdriver, gmode, '');
errcode := graphresult;
if errcode <> grOk then begin
writeln('graph error: ', grapherrormsg(errcode));
readln; halt(100);
end;

panel.init(10, 10,
10 + 4 * (btn_width + btn_between) + btn_between,
10 + btn_height + btn_between);
x := btn_between;
panel.insert(new(ptbutton_rect, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'task', actTask)));
inc(x, btn_width + btn_between);
panel.insert(new(ptbutton_romb, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'zoom', actZoom)));
inc(x, btn_width + btn_between);
panel.insert(new(ptbutton_rect, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'unzoom', actUnzoom)));
inc(x, btn_width + btn_between);
panel.insert(new(ptbutton_romb, init(x, btn_between, x + btn_width, 2 * btn_between + btn_height, 'grow', actGrow)));

current := 1;
finished := false;
repeat

panel.draw(current);
ch := readkey;
case ch of
#27: finished := true;
#13:
begin
panel.buttons[current]^.press(true);
panel.buttons[current]^.action;
end;

#0:
case readkey of
#77: if current = panel.count then current := 1 else inc(current);
#75: if current = 1 then current := panel.count else dec(current);
end;
end;
delay(50);

until finished = true;

closegraph;
end.
Как видишь, все очень даже компактно, и вполне в рамках ООП... Так что выбор - за тобой, перекраивать то решение, которое у тебя есть, или написать правильно работающую изначально программу.

Цитата
Крайне не рекомендую использовать FloodFill, есть же процедура FillPoly для рисования закрашенных прямоугольников, вот ей и пользуйтесь.
Я бы не был так категоричен. Для небольших размеров кнопок вполне подойдет и FloodFill (она медлительна при заливке больших поверхностей), а вот при попытке отладить программу в FPC я столкнулся с некорректной работой FillPoly на этом компиляторе, в связи с чем пришлось использовать условную компиляцию при отладке на двух компиляторах, чтоб не изменять программу туда-сюда... Так что не надо заниматься предварительной оптимизацией. "Premature optimization is the root of all evil" (С) Д. Кнут, вообще-то. Сначала надо заставить программу работать в принципе, а уж потом - считать такты и микросекунды, что так любят делать некоторые dry.gif

Добавлено через 2 мин.
P.S.
Цитата
только это как-то по-индийски
Я бы попросил не касаться понятий "индусского кода". Индусы пишут ГОРАЗДО более правильно, чем те, кто ХОЧЕТ представить их слабыми программистами. И у них надо еще поучиться программировать кое-кому.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9





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

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


Да, объем кода и в сравнение не идет, особенно для ООП. То, что в этом решении можно применить cв-во наследования - +, этого нам даже препод не говорил)))) Но вот что ознает этот странный значек
Цитата
ptbutton = ^tbutton;
и что мы означает вот эта часть
Цитата
private
function get_xst: integer; virtual;
function get_yst: integer; virtual;
function get_xfn: integer; virtual;
function get_yfn: integer; virtual;
end;
????
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10





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

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


вот код немного другой проги с кнопочками прямоугольниками и кругами
Uses crt,graph;
type knop=object
cz,cl,x1,y1,r1,r2,x2,y2:integer;ac:boolean;
procedure init(x0,y0,x4,y4,cli,cza:integer;act:boolean);
procedure init2(x0,y0,rx,ry,cli,cza:integer;act:boolean);
procedure draw1;
procedure draw2;
procedure draw_dawn;
procedure draw_up;
end;
panel=object(knop)
procedure initp(x00,y00,x44,y44,cl0,cz0:integer);
procedure drawp;
end;
procedure knop.init;
begin
x1:=x0;y1:=y0;x2:=x4;y2:=y4;cl:=cli;cz:=cza;ac:=act;
end;
procedure knop.init2;
begin
x1:=x0;y1:=y0;r1:=rx;r2:=ry;cz:=cza;cl:=cli;act:=ac;
end;
procedure knop.draw1;
begin
setcolor(2);setfillstyle(1,cz);
setlinestyle(0,1,3);
if ac=true
then begin

setlinestyle(0,2,3);
setcolor(15);line(x1-1,y1,x2+1,y1);line(x1,y1+2,x1,y2);
setcolor(8);line(x1+1,y2,x2,y2);line(x2,y1+1,x2,y2);
setcolor(7);line(x1+3,y2-3,x2-3,y2-3);line(x2-3,y1+3,x2-3,y2-3);
Bar(x1+2,y1+2,x2-3,y2-3); setlinestyle(1,1,3);setcolor(12);
rectangle(x1+4,y1+4,x2-4,y2-4);
end else begin setlinestyle(0,2,3);
setcolor(15);line(x1-1,y1,x2+1,y1);line(x1,y1+2,x1,y2);
setcolor(8);line(x1+1,y2,x2,y2);line(x2,y1+1,x2,y2);
setcolor(7);line(x1+3,y2-3,x2-3,y2-3);line(x2-3,y1+3,x2-3,y2-3);
Bar(x1+2,y1+2,x2-3,y2-3);end;end;

procedure knop.draw_dawn;
begin
setfillstyle(1,cz);
setlinestyle(0,2,3);
setcolor(8);
line(x1,y1,x2,y1);line(x1,y1+3,x1,y2);
setcolor(15);
line(x1+3,y2,x2,y2);line(x2,y1+3,x2,y2-3);
setcolor(7);
line(x1+3,y1+3,x2-3,y1+3);line(x1+3,y1+3,x1+3,y2-3);
Bar(x1+4,y1+4,x2-3,y2-3);delay(5000);
end;

procedure knop.draw2;
begin
setcolor(2);setfillstyle(1,cz);setlinestyle(0,1,3);
if ac=true
then begin
setlinestyle(0,2,3);setcolor(15);
ellipse(x1-1,y1-1,0,2,r1,r2);setfillstyle(1,15);fillellipse(x1-1,y1-1,r1,r2);
setcolor(8);
ellipse(x1+1,y1+1,0,2,r1,r2);setfillstyle(1,8);fillellipse(x1+1,y1+1,r1,r2);
setcolor(2);
ellipse(x1,y1,0,2,r1,r2);setfillstyle(1,cz);fillellipse(x1,y1,r1,r2);
setcolor(12); setlinestyle(1,1,1);
ellipse(x1,y1,0,360,r1,r2);end
else begin
setlinestyle(0,2,3);setcolor(15);
ellipse(x1-1,y1-1,0,2,r1,r2);setfillstyle(1,15);fillellipse(x1-1,y1-1,r1,r2);
setcolor(8);
ellipse(x1+1,y1+1,0,2,r1,r2);setfillstyle(1,8);fillellipse(x1+1,y1+1,r1,r2);
setcolor(2);
ellipse(x1,y1,0,2,r1,r2);setfillstyle(1,cz);fillellipse(x1,y1,r1,r2);
end;end;
procedure knop.draw_up;
begin
setfillstyle(1,cz);
setlinestyle(1,2,3);
ellipse(x1,y1,0,2,r1+3,r2+3);
setlinestyle(1,2,3);setcolor(8);
ellipse(x1-1,y1-1,0,2,r1,r2);setfillstyle(1,8);fillellipse(x1-1,y1-1,r1,r2);
setcolor(15);
ellipse(x1+1,y1+1,0,2,r1,r2);setfillstyle(1,15);fillellipse(x1+1,y1+1,r1,r2);
setcolor(2);
ellipse(x1,y1,0,2,r1,r2);setfillstyle(1,cz);fillellipse(x1,y1,r1,r2);delay(5000)
;
end;
procedure panel.initp;
begin
x1:=x00;y1:=y00;x2:=x44;y2:=y44;cz:=cz0;cl:=cl0;
end;
procedure panel.drawp;
begin
setfillstyle(1,cz);
setlinestyle(0,2,3);setcolor(2);rectangle(x1,y1,x2,y2);
floodfill(x1+5,y1+5,2);
end;
var a:array[1..4] of knop;v:array[1..4,1..4] of real;
p,c:panel;
chk:char;i,j,k,z:byte;
m:byte;gd,gm:integer;tt:string;f:text;
begin
gd:=detect;
initgraph(gd,gm,'d:\bp\bgi');
cleardevice;setbkcolor(1);
p.initp(120,10,560,80,4,blue);
p.drawp;
a[1].init(140,30,190,70,15,green,false);
a[2].init2(280,50,25,20,15,green,false);
a[3].init(380,30,430,70,15,green,false);
a[4].init2(520,50,25,20,15,green,false);
a[1].ac:=true;m:=1;z:=2;
repeat
setbkcolor(0);cleardevice;
p.drawp;
for i:=1 to 4 do begin
if m=i then a[i].ac:=true
else a[i].ac:=false;
if (i=1) or (i=3) then a[i].draw1 else a[i].draw2;
end;
chk:=readkey;
case chk of
#77:if (m=4) then m:=1 else m:=m+1;
#75:if (m=1) then m:=4 else m:=m-1;
#13:begin
if (m=1) or (m=3)
then a[m].draw_dawn
else a[m].draw_up;
case m of
1:begin
cleardevice;setbkcolor(1);
p.initp(230,10,450,45,4,blue);p.drawp;
a[1].init(240,17,273,38,15,green,false);
a[2].init2(317,27,12,10,15,green,false);
a[3].init(357,17,387,38,15,green,false);
a[4].init2(427,27,12,10,15,green,false);
a[1].ac:=true;m:=1;end;
2:begin
cleardevice;setbkcolor(1);
p.initp(120,410,560,478,4,blue);p.drawp;
a[1].init(140,430,190,470,15,green,false);
a[2].init2(280,447,25,20,15,green,false);
a[3].init(380,430,430,470,15,green,false);
a[4].init2(520,447,25,20,15,green,false);
a[1].ac:=true;m:=2;end;
3:begin if (z mod 2)=0 then begin
p.initp(1,1,640,480,4,blue);a[1].ac:=true; p.drawp;a[1].init(140,30,190,70,15,green,false);
a[2].init2(280,50,25,20,15,green,false);
a[3].init(380,30,430,70,15,green,false);
a[4].init2(520,50,25,20,15,green,false);z:=z+1; end
else begin
p.initp(120,10,560,80,4,blue);
p.drawp;a[1].init(140,30,190,70,15,green,false);
a[2].init2(280,50,25,20,15,green,false);
a[3].init(380,30,430,70,15,green,false);
a[4].init2(520,50,25,20,15,green,false);
z:=z+1;
a[1].ac:=true; end;end;
4:begin

c.initp(120,120,450,250,4,blue);c.drawp;
assign(f,'d:\cs.txt');
reset(f);j:=0;
while not eof(f) do
begin
readln(f,tt);outtextxy(125,125+j,tt);
j:=j+10;
end;
close(f);delay(65000);readkey;
end;

end;
end;end;
until chk=#27;end.



кропочку уменьшения панели можно переделать на увеличение объемности , а перенос - возвращение в прежний режим

и как можно написать общие процедурки для ромба и квадрата??
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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