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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 16.12.2011, 13:02   #1
serj-07
Пользователь
 
Аватар для serj-07
 
Регистрация: 07.03.2009
Сообщений: 68
По умолчанию программирование 3D графики

Здравствуйте!!!
Помогите пожалуйста по методичке собрать программу.
Я начал но не получается, ума ведать еще не хватает.

Код:
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
TYPE T3DCoord=(CX,CY,CZ);
     T3DPoint=ARRAY[CX..CZ] OF REAL;
     TEdges= ARRAY OF ARRAY[1..2] OF BYTE;
     TPoints=ARRAY OF T3DPoint;
 
var
  Form1: TForm1;
  points: TPoints;
  edges: Tedges;
  canvas: Tcanvas;
  PX:real;
  PY:real;
  scal:real;
 
implementation
 
{$R *.dfm}
 
PROCEDURE Ini;
 
begin
 SetLength(points, 4);
 SetLength(edges, 6);
 points[0][CX]:=-40; points[0][CY]:=0; points[0][CZ]:=0;  
 points[1][CX]:=20; points[0][CY]:=34.6; points[0][CZ]:=0;  
 points[2][CX]:=20; points[0][CY]:=-34.6; points[0][CZ]:=0;  
 points[3][CX]:=0; points[0][CY]:=0; points[0][CZ]:=15;
 edges[0][1]:=0; edges [0][2]:=1;  // ребро от точки 0 в точку 1
 edges[1][1]:=0; edges [1][2]:=2;  // ребро от точки 0 в точку 2
 edges[2][1]:=1; edges [2][2]:=2;  // ребро от точки 1 в точку 2
 edges[3][1]:=0; edges [3][2]:=3;  // ребро от точки 0 в точку 3
 edges[4][1]:=1; edges [4][2]:=3;  // ребро от точки 1 в точку 3
 edges[5][1]:=2; edges [5][2]:=3;  // ребро от точки 2 в точку 3
end;
 
PROCEDURE Draw;
 
VAR i:BYTE;
 
BEGIN
 Ini;
  PX:=0;
  PY:=0;
  scal:=1;
 WITH Form1.Image1.canvas DO
  BEGIN
   // Фон 
   Brush.Color:=ClWhite;
   FillRect(Form1.Image1.Canvas.ClipRect);
   // Отрисовка ребер
   Pen.Color:=CLBlue;
   FOR i:=0 TO Length(edges)-1 DO
    BEGIN
     MoveTo(TRUNC(points[edges[i,1],CX]*scal+PX),TRUNC(points[edges[i,1],CY]*scal+PY));
     LineTo(TRUNC(points[edges[i,2],CX]*scal+PX),TRUNC(points[edges[i,2],CY]*scal+PY))
    END;
  END;
END;
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 Draw
end;
 
end.
Заранее спасибо!!!
Вложения
Тип файла: rar 3D.rar (137.3 Кб, 9 просмотров)
Мы все учились понемногу
Чему-нибудь и как-нибудь!!!
serj-07 вне форума Ответить с цитированием
Старый 16.12.2011, 19:19   #2
serj-07
Пользователь
 
Аватар для serj-07
 
Регистрация: 07.03.2009
Сообщений: 68
Вопрос

Помогите хотя бы по моему коду увидеть фигуру на форме!
Мы все учились понемногу
Чему-нибудь и как-нибудь!!!
serj-07 вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Программирование графики в Linux. OpenGL. Алексей Емеля Gamedev - cоздание игр: Unity, OpenGL, DirectX 1 16.07.2011 09:48
Программирование или web-программирование? Дмитрий Батогов Помощь студентам 3 23.06.2011 14:14
Программирование графики beztrud Мультимедиа в Delphi 3 13.02.2009 14:14
Программирование графики sasha465 Общие вопросы C/C++ 5 10.10.2008 15:48