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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 07.05.2007, 23:53   #1
Eugene
 
Регистрация: 07.05.2007
Сообщений: 3
По умолчанию Рисование пирамиды на канве

Не могу сообразить как нарисовать пирамиду с прямоугольником (или квадратом ) в основании. Проблемы начинаются уже при рисовании основания. Я задаю 3 вектора с координатами P[1,1]=X1, P[1,2]=Y1,
P[1,3]=Z1,.....,P[3,3]=Z3.
Дальше строю две стороны.
Другие две будут параллельны. Не врублюсь как осуществить параллельный перенос.
Код:
//Процедура рисования пирамиды
procedure TForm2.pyr;

var
 x1, x2, x3,
 y1, y2, y3,
 a1, a2: real;

begin
// преобразование координат
      x1 := xc - P[1, 1]*cos(30*pi/180) + P[1, 2]*cos(30*pi/180);
      y1 := yc + P[1, 1]*sin(30*pi/180) + P[1, 2]*sin(30*pi/180) - P[1, 3];

      x2 := xc - P[2, 1]*cos(30*pi/180) + P[2, 2]*cos(30*pi/180);
      y2 := yc + P[2, 1]*sin(30*pi/180) + P[2, 2]*sin(30*pi/180) - P[2, 3];

      x3 := xc - P[3, 1]*cos(30*pi/180) + P[3, 2]*cos(30*pi/180);
      y3 := yc + P[3, 1]*sin(30*pi/180) + P[3, 2]*sin(30*pi/180) - P[3, 3];

  { //нахождение центра пирамиды
       a1 := (x1 + x2 + x1*cos(30*pi/180)- y1*sin(30*pi/180))/3;
       a2 := (y1 + y2 + x1*sin(30*pi/180)+ y1*cos(30*pi/180))/3;}

with PaintBox1.Canvas do begin
                Pen.Color := clFuchsia;

// line - процедура рисования линии по двум координатам
                  line (round(x1), round(y1), round(x2), round(y2));
                  line (round(x2), round(y2), round(x3), round(y3));
                  {   ?????????????????????                            }
                                   end;
end;
Eugene вне форума Ответить с цитированием
Старый 08.05.2007, 02:05   #2
Shuraken
Форумчанин
 
Аватар для Shuraken
 
Регистрация: 16.04.2007
Сообщений: 298
По умолчанию

Хмм, интересно, откуда у канвы взялось новое свойство Line. LineTo есть такое, а Line?
Не надо ничего усложнять. Все достаточно тривиально.
Shuraken вне форума Ответить с цитированием
Старый 08.05.2007, 22:43   #3
Eugene
 
Регистрация: 07.05.2007
Сообщений: 3
По умолчанию

Цитата:
Сообщение от Shuraken Посмотреть сообщение
Хмм, интересно, откуда у канвы взялось новое свойство Line. LineTo есть такое, а Line?
Line - процедура.
Цитата:
procedure Line (x1, y1, x2, y2 : integer);
begin
with Form2.PaintBox1.Canvas do begin
MoveTo (x1, y1);
LineTo (x2, y2);
end;
end;
Eugene вне форума Ответить с цитированием
Старый 08.05.2007, 22:58   #4
Eugene
 
Регистрация: 07.05.2007
Сообщений: 3
По умолчанию

С проблемой параллельного перноса я справился.
Но есть ещё одна проблема:
надо начертить боковые рёбра, причём все боковые грани должны быть равнобедренными треугольниками. (Высоту задаю сам.)
Для этого я определяю центр пирамиды и насколько понимаю дальше мне необходимо найти вектор нормали. Как мне это сделать?
Можно ли другим способом построить боковые рёбра (каким)?
И вообще какими ещё способами можно построить саму пирамиду, так чтобы в основании был квадрат.

Вот текст программы:

Код:
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Unit1, StdCtrls;

type
    TPYR = array[1..3,1..7] of real;   // для пирамиды
  TForm2 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure mash;  // процедура масштабирования
    procedure osi;     // процедура рисования осей
    procedure pyr;    // процедура рисования пирамиды
  private
    { Private declarations }
  public
    { Public declarations }

    P : TPYR;
  
  end;

var
  Form2: TForm2;
  
implementation

{$R *.dfm}
 var
        mx, my, xc, yc : real;  // - для масштабирования

// Процедура рисования линии по двум координатам
procedure Line (x1, y1, x2, y2 : integer);
begin
        with Form2.PaintBox1.Canvas do begin
                MoveTo (x1, y1);  
                LineTo (x2, y2);
        end;
end;

procedure TForm2.FormActivate(Sender: TObject);
begin
// Ввод данных для пирамиды
P[1,1]:=StrToInt(Form1.Edit8.Text);
P[1,2]:=StrToInt(Form1.Edit9.Text);
P[1,3]:=StrToInt(Form1.Edit10.Text);
P[2,1]:=StrToInt(Form1.Edit11.Text);
P[2,2]:=StrToInt(Form1.Edit12.Text);
P[2,3]:=StrToInt(Form1.Edit13.Text);
P[3,1]:=StrToInt(Form1.Edit14.Text);
P[3,2]:=StrToInt(Form1.Edit15.Text);
P[3,3]:=StrToInt(Form1.Edit16.Text);


end;

procedure TForm2.mash;
begin
        mx := PaintBox1.Width;
        my := PaintBox1.Height;
        xc := round(mx/2);   // - центр по оси X
        yc := round(my/2);   // - центр по оси Y
end;

procedure TForm2.osi;

var
        a, b : real;  //  для вычисления вспомогательных значений
begin
        b := mx/2 - 100;
        a := b*sin(30*pi/180)/cos(30*pi/180);
        with PaintBox1.Canvas do begin
                Pen.Color := clGreen;  
                // Рисование осей координат и стрелок на координатных
//осях
                Line (round(mx/2), round(my/2), round(mx/2), 10);
                Line (round(mx/2), 10, round(mx/2)-10, 30);
                Line (round(mx/2), 10, round(mx/2)+10, 30);
                Line (round(mx/2), round(my/2), round(mx/2-b), round(my/2+a));
                Line (round(mx/2), round(my/2), round(mx/2+b), round(my/2+a));
                Line (round(mx/2-b), round(my/2+a), round(mx/2-b)+15, round(my/2+a)-20);
                Line (round(mx/2-b), round(my/2+a), round(mx/2-b)+30, round(my/2+a)-10);
                Line (round(mx/2+b), round(my/2+a), round(mx/2+b)-15, round(my/2+a)-20);
                Line (round(mx/2+b), round(my/2+a), round(mx/2+b)-30, round(my/2+a)-10);
                // Надписи на осях координат
                Font.Color := clRed;  
                Font.Size := 15;      
                TextOut (round(mx/2)-20, 10, 'Z');
                TextOut (round(mx/2-b), round(my/2+a)-40, 'X');
                TextOut (round(mx/2+b), round(my/2+a)-40, 'Y');
        end;
end;


procedure TForm2.pyr;
var 
x1, x2,x3,
y1, y2, y3 : real;

begin
// Преобразование координат из мировых в экранные
      x1 := xc - P[1, 1]*cos(30*pi/180) + P[1, 2]*cos(30*pi/180);
      y1 := yc + P[1, 1]*sin(30*pi/180) + P[1, 2]*sin(30*pi/180) - P[1, 3];
      
      x2 := xc - P[2, 1]*cos(30*pi/180) + P[2, 2]*cos(30*pi/180);
      y2 := yc + P[2, 1]*sin(30*pi/180) + P[2, 2]*sin(30*pi/180) - P[2, 3];
      
      x3 := xc - P[3, 1]*cos(30*pi/180) + P[3, 2]*cos(30*pi/180);
      y3 := yc + P[3, 1]*sin(30*pi/180) + P[3, 2]*sin(30*pi/180) - P[3, 3];


with PaintBox1.Canvas do begin
           Pen.Color := clFuchsia;
              line (round(x1), round(y1), round(x2), round(y2));
              line (round(x2), round(y2), round(x3), round(y3));
           
              line (round(x3), round(y3), round(x1+x3-x2), round(y1+y3-y2));
              line (round(x1+x3-x2), round(y1+y3-y2), round(x1), round(y1));
  {???????????}
                 
                         end;
end;

procedure TForm2.Button1Click(Sender: TObject);

begin
mash; // масштабирование
osi;    // рисование осей    
pyr;   // рисование пирамиды
end;

end.

Последний раз редактировалось Eugene; 09.05.2007 в 13:43.
Eugene вне форума Ответить с цитированием
Старый 17.10.2013, 17:27   #5
klavver
Новичок
Джуниор
 
Регистрация: 17.10.2013
Сообщений: 1
По умолчанию

Тебе нужна ещё одна координата (вершина пирамиды):
x4, y4; преобразовываться это всё будет по тому же закону что и для x1..x3; y1..y3
и плюс ещё 4 линии добавятся от этой вершины до всех этих трёх точек и четвёртой- которая получилась в результате параллельного переноса.
klavver вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Вычислить обьем пирамиды по ее координатам в пространстве Dog Помощь студентам 2 19.05.2008 17:05
Мерцание на Канве SERG1980 Мультимедиа в Delphi 3 30.04.2008 08:14
Поворот маленького примитива на канве valwin Общие вопросы Delphi 7 04.02.2007 03:34
построение графика на Канве Chepa Общие вопросы Delphi 2 19.01.2007 22:59
как рисовать на канве битмапы учитывая прозрачность участков битмапа? Alar Общие вопросы Delphi 0 29.10.2006 23:06