Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.02.2015, 20:40   #1
NEymexa:c
Пользователь
 
Регистрация: 26.02.2015
Сообщений: 24
Печаль Turbo pascal. Графика\движение фигуры

Здравствуйте! Прошу помочь с графикой в паскале, а именно с движение прямоугольника по средствам кнопок (вправо,вверх,влево,вниз). Сетка из закрашенных эллипсов с рандомным цветом.

Все что получилось. А именно сама сетка. С остальным прошу помощи.

Код:
uses crt, graph;
var
    grdriver, grmode, x, y, R, x1, y1: integer;
   
    
begin
    grdriver := detect;
    initgraph(grdriver, grmode, ' '); 
    if(graphresult <> grok) then   halt; 
    cleardevice; 
    x := 10;
    y := 10;
    R := 10; 
    randomize;    
    while(y <= 480) do
    begin
        while(x <= 640) do
        begin
            setfillstyle(1, random(14));
            fillellipse(x, y, r, r);
            x := x + 2*R+1;
        end;
        x := 10;
        y := y + 2*R+1;
    end;
end.
NEymexa:c вне форума Ответить с цитированием
Старый 27.02.2015, 16:40   #2
Dvoishnik
Форумчанин
 
Регистрация: 12.02.2011
Сообщений: 808
По умолчанию

чтобы заставить двигаться можно использовать
Код:
var
keyRu:char;
..............
keyRu:=readkey;
case keyRu of
#75:begin процедура для движение влево end;
#72:begin процедура для движение в перед end;
#80:begin процедура для движение  направо end;
#77:begin процедура для движение на зад end;
Терпение!Дежурный экстрасенс скоро свяжется с вами!

Последний раз редактировалось Dvoishnik; 27.02.2015 в 16:44.
Dvoishnik вне форума Ответить с цитированием
Старый 06.05.2015, 14:29   #3
NEymexa:c
Пользователь
 
Регистрация: 26.02.2015
Сообщений: 24
По умолчанию

Получилось как-то так, но нужно что бы до конца экрана доходила фигура.. впритык. Сверху получилось, а с остальным никак.

Код:
uses crt, graph;
var
    grdriver, grmode, str_ug, x, y, r, t1, t, x1, y1: integer;
    k: char;
    size: word;
    p: pointer;
    
procedure f_ugol(n,x,y,r:integer);// процедура многоугольника
var p:array[1..6] of pointtype;
    i:byte;
    a,da:real;
begin
a:=pi/2;
da:=2*pi/n;
for i:=1 to n do
 begin
  p[i].X:=x+round(r*cos(a));
  p[i].Y:=y-round(r*sin(a));
  a:=a+da
 end;
p[n+1]:=p[1];
setcolor(15);
setfillstyle(1, 15);
fillpoly(n+1,p);
end;
 
begin    
    clrscr; 
    write('Введите длину стороны:');
    read(str_ug);           
    grdriver := detect;
    initgraph(grdriver, grmode, ' '); 
    if(graphresult <> grok) then     halt; 
    cleardevice; 
    x := 10;
    y := 10;
    R := 10; 
    randomize;  //фон  
    while(y <= 480) do
    begin
        while(x <= 640) do
        begin
            setfillstyle(1, random(14));
            fillellipse(x, y, r, r);
            x := x + 2*R+1;
        end;
        x := 10;
        y := y + 2*R+1;
    end;    
    x := 320;
    x1 := x+2;
    y := 240;
    y1 := y+2;    
    size := imagesize(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug);
    getmem(p, size); 
    getimage(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug, p^); 
    setfillstyle(1, 15);
    f_ugol(5,(x+x1) div 2,(y+y1) div 2,str_ug);
    repeat
        if(keypressed) then
        begin
            k := readkey;
            case k of
                #72:{движение вверх}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    t := y;
                    t1 := y1;
                    y := y - 10;
                    y1 := y1 - 10;
                    if(y <= 0 + str_ug) then
                    begin
                        y := t;
                        y1 := t1;
                    end;
                    getimage(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug, p^);
                    f_ugol(5,(x+x1) div 2,(y+y1) div 2,str_ug);
                end;
                #75:{движение влево}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    t := x;
                    t1 := x1;
                    x := x - 10;
                    x1 := x1 - 10;
                    if(x <= 0 + str_ug) then
                    begin
                        x := t;
                        x1 := t1;
                    end;
                    getimage(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug, p^);
                    f_ugol(5,(x+x1) div 2,(y+y1) div 2,str_ug);
                end;
                #77:{движение вправо}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    t := x;
                    t1 := x1;
                    x := x + 10;
                    x1 := x1 + 10;
                    if(x1 >= 640 - str_ug) then
                    begin
                        x := t;
                        x1 := t1;
                    end;
                    getimage(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug, p^);
                    f_ugol(5,(x+x1) div 2,(y+y1) div 2,str_ug);
                   end;
                #80:{движение вниз}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    t := y;
                    t1 := y1;
                    y := y + 10;
                    y1 := y1 + 10;
                    if(y1 >= 480-str_ug) then
                    begin
                        y := t;
                        y1 := t1;
                    end;
                    getimage(x-str_ug, y-str_ug, x1+str_ug, y1+str_ug, p^);
                    f_ugol(5,(x+x1) div 2,(y+y1) div 2,str_ug);
                end;
            end;
        end;
    until k = #27;

    freemem(p, size);
end.
NEymexa:c вне форума Ответить с цитированием
Старый 06.05.2015, 14:53   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

NEymexa:c это Вы три месяца дорабатываете эту программу? ! Мда, не быстро.

Если никто раньше не поможет, то я сегодня вечером постараюсь посмотреть ваш код в TP: что у Вас есть и что Вы пытаетесь достичь.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 06.05.2015, 15:04   #5
NEymexa:c
Пользователь
 
Регистрация: 26.02.2015
Сообщений: 24
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
NEymexa:c это Вы три месяца дорабатываете эту программу? ! Мда, не быстро.

Если никто раньше не поможет, то я сегодня вечером постараюсь посмотреть ваш код в TP: что у Вас есть и что Вы пытаетесь достичь.
Конечно же нет. В свободное время)
NEymexa:c вне форума Ответить с цитированием
Старый 06.05.2015, 15:42   #6
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от NEymexa:c Посмотреть сообщение
Конечно же нет. В свободное время)
Так это Вы не по учёбе, просто для себя?
Тогда очень странен выбор инструмента. Зачем Вам этот досовский антиквариат? Неужели на FreePascal не проще/лучше/удобнее ?!
Serge_Bliznykov вне форума Ответить с цитированием
Старый 06.05.2015, 15:55   #7
NEymexa:c
Пользователь
 
Регистрация: 26.02.2015
Сообщений: 24
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
Так это Вы не по учёбе, просто для себя?
Тогда очень странен выбор инструмента. Зачем Вам этот досовский антиквариат? Неужели на FreePascal не проще/лучше/удобнее ?!
Нет, по учебе, но подходит время для сдачи. Хотел по раньше начать, увы.. дотянул до последнего.
NEymexa:c вне форума Ответить с цитированием
Старый 07.05.2015, 01:18   #8
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

немножко кривенько, но, может такой код Вас устроит:
Код:
uses crt, graph;
var
    grdriver, grmode, str_ug, x, y, R : integer;
    k: char;
    size: word;
    p: pointer;

procedure f_ugol(n,x,y,r:integer);{// процедура многоугольника}
var p:array[1..6] of pointtype;
    i,maxY, deltaY:integer;
    a,da:real;
begin
a:=pi/2;
da:=2*pi/n;
for i:=1 to n do
 begin
  p[i].X:=x+round(r*cos(a));
  p[i].Y:=y-round(r*sin(a));
  a:=a+da
 end;
p[n+1]:=p[1];

{sdvig vniz}
if (y+r)=GetMaxY then begin
 maxY := p[1].Y;
 for i:=2 to n do
    if p[i].Y>maxY
      then maxY := p[i].Y;
 deltaY := GetMaxY - MaxY;
 if deltaY>0 then
   for i:=1 to n+1 do
      p[i].Y := p[i].Y + deltaY;
end;

setcolor(15);
setfillstyle(1, 15);
fillpoly(n+1,p);
end;

begin
    clrscr;
    write('Введите длину стороны:');
    readln(str_ug);
    grdriver := detect;
    initgraph(grdriver, grmode, ' ');
    if(graphresult <> grok) then     halt;
    cleardevice;
    x := 10;
    y := 10;
    R := 10;
    randomize;  {//фон}
    while(y <= GetMaxY) do
    begin
        while(x <= (GetMaxX+1) ) do
        begin
            setfillstyle(1, random(14));
            fillellipse(x, y, r, r);
            x := x + 2*R+1;
        end;
        x := 10;
        y := y + 2*R+1;
    end;
    x := GetMaxX div 2;
    y := GetMaxY div 2;
    size := imagesize(x-str_ug, y-str_ug, x+str_ug, y+str_ug);
    getmem(p, size);
    getimage(x-str_ug, y-str_ug, x+str_ug, y+str_ug, p^);
    setfillstyle(1, 15);
    f_ugol(5,x,y,str_ug);
    repeat
        if(keypressed) then
        begin
            k := readkey;
            case k of
                #72:{движение вверх}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    y := y - 10;
                    if(y <= (0 + str_ug)) then
                        y := str_ug;
                    getimage(x-str_ug, y-str_ug, x+str_ug, y+str_ug, p^);
                    f_ugol(5,x,y,str_ug);
                end;
                #75:{движение влево}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    x := x - 10;
                    if(x <= 0 + str_ug) then
                        x := str_ug;
                    getimage(x-str_ug, y-str_ug, x+str_ug, y+str_ug, p^);
                    f_ugol(5,x,y,str_ug);
                end;
                #77:{движение вправо}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    x := x + 10;
                    if(x > (GetMaxX - str_ug)) then
                        x := GetMaxX - str_ug;
                    getimage(x-str_ug, y-str_ug, x+str_ug, y+str_ug, p^);
                    f_ugol(5,x,y,str_ug);
                   end;
                #80:{движение вниз}
                begin
                    putimage(x-str_ug, y-str_ug, p^, copyput);
                    y := y + 10;
                    if(y > (GetMaxY-str_ug)) then
                        y := GetMaxY-str_ug;
                    getimage(x-str_ug, y-str_ug, x+str_ug, y+str_ug, p^);
                    f_ugol(5,x,y,str_ug);
                end;
            end;
        end;
    until k = #27;

    freemem(p, size);
end.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 07.05.2015, 07:29   #9
NEymexa:c
Пользователь
 
Регистрация: 26.02.2015
Сообщений: 24
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
немножко кривенько, но, может такой код Вас устроит:
Большое спасибо за помощь!
NEymexa:c вне форума Ответить с цитированием
Старый 07.05.2015, 12:01   #10
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Пожалуйста!
Ещё можно алгоритм(код) улучшать/оптимизировать (вынести общие части за пределы проверок нажатой клавиши, учитывать, что если позиция не изменилась, то нет смысла перевыводить многоугольник на том же самом месте и т.д.).
Но, если Вас устраивает, то можно и так оставить
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
графика Паскаль - движение фигуры Nataly026 Паскаль, Turbo Pascal, PascalABC.NET 6 18.04.2012 23:20
Движение одной фигуры,вслед изменения высоты другой фигуры. 7vlad37 Microsoft Office Excel 3 21.07.2011 18:01
движение языков пламени или костер (огонь) - графика на Pascal ABC Дариiя Помощь студентам 2 19.06.2011 17:55
Графика в Turbo Pascal 7.0 Seleznev N. Помощь студентам 2 09.02.2011 14:31