кнопки-объекты, помогите исправить ошибку Опции

[HoOope]

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

Вот задание:
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.

Очень жду и надеюсь на Вашу помощь

[volvo]

Программы, написанные по технологии Copy+Paste привести в рабочий вид гораздо сложнее, чем написать их заново. Сначала исправь все синтаксические ошибки (у тебя в программе их огромное количество. Где-то лишняя скобка при вызове процедуры; где-то ты забыла указать что процедура - это метод класса, из-за чего получаешь сообщения о неизвестных переменных. Где-то строка не является завершенной, потому что нельзя просто так добавлять в строку апостроф, его надо дублировать:

         k[4].t:='ob''emnost''';

, ну а про то, что методов romb и kvt в типе Knopka вообще нет - я уж и не говорю)...

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

[HoOope]

Я очень-очень хочу, чтобы Вы мне объяснили!!!:))))) Просто я выпрасила у одногруппников похожие проги и решила, что переделать я все же смогу, но видемо без помощи у меня мало что вышло=(((
А как можно проще написать? С ромбом можно как-то легче поступить? А вот с квадратиком разве что-то не так:

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;

[TarasBer]

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

[maksimla]

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

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

[HoOope]

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

[TarasBer]

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

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

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

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

[volvo]

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

Значит, смотри...

Начнем с того, что у тебя невнятно описана цепочка наследования. Давай посмотрим, что у тебя есть: у тебя есть прямоугольная панель, у тебя есть прямоугольная кнопка и ромбовидная кнопка. Есть ли что-то общее между всеми этими сущностями? Есть... Все они однозначно идентифицируются прямоугольником, в котором находятся. Причем как для отрисовки прямоугольной, так и для отрисовки ромбовидной кнопки нужны 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" (С) Д. Кнут, вообще-то. Сначала надо заставить программу работать в принципе, а уж потом - считать такты и микросекунды, что так любят делать некоторые

Добавлено через 2 мин.
P.S.

только это как-то по-индийски

Я бы попросил не касаться понятий "индусского кода". Индусы пишут ГОРАЗДО более правильно, чем те, кто ХОЧЕТ представить их слабыми программистами. И у них надо еще поучиться программировать кое-кому.

[HoOope]

Да, объем кода и в сравнение не идет, особенно для ООП. То, что в этом решении можно применить 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;

????

[HoOope]

вот код немного другой проги с кнопочками прямоугольниками и кругами

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.

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

и как можно написать общие процедурки для ромба и квадрата??