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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 01.03.2009, 17:54   #1
haros
Пользователь
 
Регистрация: 23.02.2009
Сообщений: 28
По умолчанию Масштабирование и поворот графического объекта

Привет всем!
У меня такая задача:
Нарисовать некий графический объект (похож на толстую двустороннюю стрелку) и по нажатию клавиши, к примеру 'z', масштабируем по оси ОУ, а по нажатию клавиши, к примеру 'x', поворачиваем в лево на 90 градусов. Все координаты беутся произвольные.

Вот что наваял я:
Код:
Program MasPov;
 uses crt, Graph;
 var Gd,Gm: integer;
  x,y,n,m,i:integer;
  s: char;
  a,b,c: array[1..11] of integer;

  procedure obiect(i:integer);
  begin
    for i:=1 to 10 do
      begin
        line(a[i],b[i],a[i+1],b[i+1]);
      end;
  end;

  procedure mashtab(i:integer);
  begin
    for i:=1 to 11 do
      begin
        b[i]:=b[i]+20;
      end;
    {obiect(i);}
  end;

  procedure povorot(i:integer);
  begin
    for i:=1 to 11 do
      begin
        b[i]:=b[i]*(-1);
        c[i]:=a[i];
        a[i]:=b[i];
        b[i]:=c[i];
      end;
      obiect(i);
  end;

  begin
    Gd:=Detect;
    InitGraph(Gd,Gm,'c:\bp\bgi');
    x:=GetMaxx div 2;
    y:=GetMaxy div 2;
    line(0,y,GetMaxx,y);
    line(x,0,x,GetMaxy);
    a[1]:=x-40;          b[1]:=y;
    a[2]:=x-20;          b[2]:=y-30;
    a[3]:=x-20;          b[3]:=y-20;
    a[4]:=x+20;          b[4]:=y-20;
    a[5]:=x+20;          b[5]:=y-30;
    a[6]:=x+40;          b[6]:=y;
    a[7]:=x+20;          b[7]:=y+30;
    a[8]:=x+20;          b[8]:=y+20;
    a[9]:=x-20;          b[9]:=y+20;
    a[10]:=x-20;         b[10]:=y+30;
    a[11]:=x-40;         b[11]:=y;
    obiect (i);
   { mashtab(i);
    povorot(i);}
    if keypressed then
      begin
        s:=readkey;
        case s of
          'z': mashtab(i);
          'x': povorot(i);
          else
            begin
              readkey;
              CloseGraph;
            end;
        end;
      end;
end.
Был ли я хоть на каплю на правильном пути?
Помогите с решением, пожалуйста.
P.S. Решение должно быть максимально компактно. Заранее благодарю!
Люди, слушайте голос разума...

Последний раз редактировалось haros; 01.03.2009 в 18:38.
haros вне форума Ответить с цитированием
Старый 02.03.2009, 13:20   #2
Dark_Spirit
Форумчанин
 
Аватар для Dark_Spirit
 
Регистрация: 05.02.2009
Сообщений: 324
По умолчанию

странные какие-то процедуры.... зачем передавать в процедуру внешний параметр, чтобы потом всё равно его там изменять от 1 к...
ну а вы сами запускали программу?
Тяжело быть бестолковым.....
Dark_Spirit вне форума Ответить с цитированием
Старый 02.03.2009, 14:58   #3
Sazary
В тени
Старожил
 
Аватар для Sazary
 
Регистрация: 19.12.2008
Сообщений: 5,788
По умолчанию

haros
То, что вы написали, работать не будет.
Вместо масштабирования будет происходить сдвиг. Процедура поворота тоже какая-то кривая.

Написал с нуля. Поворот - 'z', масштабирование - '+' и '-'.
Код:
 uses crt, Graph;
 var Gd,Gm: smallint; //для TP7 заменить тип на integer
 xcntr,ycntr : integer;
 dh : integer;
 pov : boolean;
 c : char;

procedure coordos;
 begin
 line(xcntr,0,xcntr,getmaxy);
 line(0,ycntr,getmaxx,ycntr);
 end;

procedure obj(pv : boolean);
 var x0,y0,i : integer;
 prx,pry : integer;
 begin

 for i:=1 to 4 do
  begin
   case i of
   1 : begin
       prx := 1; pry := 1;
       end;
   2 : begin
       prx := -1; pry := 1;
       end;
   3 : begin
       prx := -1; pry := -1;
       end;
   4 : begin
       prx := 1; pry := -1;
       end;
    end;   {case}
  if pv then
   begin
   x0 := xcntr;
   y0 := ycntr-dh*pry;
   moveto(x0,y0);
   linerel(dh*prx,0);
   linerel(0,-dh*pry);
   linerel(dh*prx,2*dh*pry);
   end
  else
   begin
   x0 := xcntr-dh*prx;
   y0 := ycntr;
   moveto(x0,y0);
   linerel(0,dh*pry);
   linerel(-dh*prx,0);
   linerel(2*dh*prx,dh*pry);
   end;

  end;
 end;

procedure masshtab(plus : boolean);
 begin
 if plus then inc(dh,20)
 else dec(dh,20);
 cleardevice;
 coordos;
 obj(pov);
 end;

procedure povorot;
 begin
 cleardevice;
 pov := not pov;
 coordos;
 obj(pov);
 end;



begin
clrscr;
Gd := detect;
initgraph(Gd,Gm,'');
xcntr := getmaxx div 2;
ycntr := getmaxy div 2;
dh := 20;
pov := true;
coordos;
obj(pov);

repeat
c := readkey;
case c of
 '+' : masshtab(true);
 '-' : masshtab(false);
 'z' : povorot;
end;
until c = #27;

closegraph;
end.
Вполне очевидно, чтобы что-то понять, необходимо книги читать.
Не нужно плодить бессмысленных тем. Вас Поиск избавит от многих проблем.

___________________________________ ___________________________________ _______
[=Правила форума=]_____[Поиск]_____[Литература по С++]____[Литература. Паскаль]
Sazary вне форума Ответить с цитированием
Старый 02.03.2009, 15:24   #4
haros
Пользователь
 
Регистрация: 23.02.2009
Сообщений: 28
По умолчанию

у меня вот че в итоге получилось:
Код:
 uses crt, Graph;
 var Gd,Gm: integer;
  x,y,n,m,i:integer;
  s: char;
  a,b,c: array[1..11] of integer;

  procedure obiect;
  begin
    cleardevice;
    for i:=1 to 10 do
      begin
        line(a[i],b[i],a[i+1],b[i+1]);
      end;
  end;

  procedure mashtab(prov:boolean);
  begin
    cleardevice;
    if prov then
    begin
    for i:=1 to 11 do
      b[i]:=b[i]*2-y;
    end else
    begin
      for i:=1 to 11 do
        b[i]:=(b[i]-y) div 2+y;
    end;
   obiect;
  end;

  procedure povorot;
  begin
    cleardevice;
    for i:=1 to 11 do
      begin
        c[i]:=a[i];
        a[i]:=a[i]+b[i]-a[i]+x-y;
        b[i]:=b[i]-c[i]-b[i]+x+y;
      end;
      obiect;
  end;

  begin
    clrscr;
    Gd:=Detect;
    InitGraph(Gd,Gm,'');
    x:=GetMaxx div 2;
    y:=GetMaxy div 2;
    a[1]:=x-40;          b[1]:=y;
    a[2]:=x-20;          b[2]:=y-30;
    a[3]:=x-20;          b[3]:=y-20;
    a[4]:=x+20;          b[4]:=y-20;
    a[5]:=x+20;          b[5]:=y-30;
    a[6]:=x+40;          b[6]:=y;
    a[7]:=x+20;          b[7]:=y+30;
    a[8]:=x+20;          b[8]:=y+20;
    a[9]:=x-20;          b[9]:=y+20;
    a[10]:=x-20;         b[10]:=y+30;
    a[11]:=x-40;         b[11]:=y;
    obiect;
    while s<>'c' do
    begin
    s:=readkey;
    case s of
    '+': mashtab(true);
    '-': mashtab(false);
    #13: povorot;
    #27: exit;
    end;
    end;
end.
Всем спасибо!
Люди, слушайте голос разума...
haros вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
С помощью методов и свойств объекта осуществляется управление терминалом. Имя (идентификатор) объекта User>lia Общие вопросы Delphi 4 16.01.2009 16:37
Как поменять одну из текстур объекта не меняя все остальные и без повторной загрузки объекта в GLScene DomKr@t Мультимедиа в Delphi 0 14.12.2008 01:52
Масштабирование Град Microsoft Office Excel 6 24.10.2008 09:23
создание графического редактора в Delphi? parano_ya Помощь студентам 1 29.04.2007 08:17
Вставка записи в поле графического типа Bibigul БД в Delphi 3 10.04.2007 16:07