Delphi World - Пример создания 3D движка
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пример создания 3D движка

Автор: BoogeMan
Оформил: RT17

   OpenGL - стандартный для большинства платформ и операционных систем набор низкоуровневых функций двумерной и трехмерной графики, библиотека, широко используемая в промышленных CAD-системах и играх. Поставляется в составе операционной системы Windows, начиная с версии OSR2 в виде двух DLL-файлов - opengl32.dll и glu32.dll. Первая из этих библиотек и есть собственно набор функций OpenGL, вторая содержит дополнительный набор функций, упрощающих кодирование, но построенных и выполняемых с подключением opengl32.dll и являющаяся надстройкой. То, что эти библиотеки поставляются в составе операционной системы, значительно упрощает распространение разработанных приложений. То, что OpenGL распространяется в виде динамических библиотек, упрощает доступ к его функциям. При выборе базы для построения приложений графики несомненными достоинствами OpenGL являются его простота и стандартность - код в случае необходимости можно легко перенести на другую платформу или под другую операционную систему. Для более подробной информации о OpenGL смотрите здесь

Ну что, начнем?

   Для начала создадим пару классов для дальнейшей работы.

3D объект.

unit gl_max;

interface

uses
  Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Controls, Dialogs, SysUtils, OpenGL;


type

  gl_color=array[1..3]of glfloat;

  gl_Rotate=array[1..3]of glfloat;

  text_cor=record
    x,y:glfloat;               //нормаль (вектор)
  end;

  normal=record
    x,y,z:glfloat;               //нормаль (вектор)
    znak:boolean;                //знак нормали
  end;

  sl_point=^tpoint;
  tpoint=record
    x,y,z:integer;
    texture:text_cor;
    smooh_nrml:normal;
    n:integer;             //координаты и номер
    select:boolean;              //выделение точки
    color:gl_color;              //цвет вершины
    next:sl_point;               //сл. точка в списке
  end;

  tpoint_fl=record
    x,y,z:glfloat;
  end;

  sl_poly=^tpoly;
  tpoly=record
    vr:array[1..3]of sl_point;   //Ссылки на точки в списке
    nrml:normal;                 //каждый полигон имеет свою нормаль
    gl_p_color:boolean;          //цвет полигона или по верширнам
    color:gl_color;              //цвет полигона
    next:sl_poly;                //ссылка на сл. полигон
  end;

  sl_obj=^tGL_object3D;

  tGL_object3D = class

       obj_set:record
          texture,smooth,
          color_m,light:boolean;
          draw_mode:glenum;
       end;

       angcn,angfr:array[1..3]of glfloat;
       next:sl_obj;
       x,y,z:integer;
       select:boolean;
       smooth:boolean;
      private
       fall_points:sl_point;             //Список точек
       next_p,new_p:sl_point;            //Список точек
       fall_polys,next_poly:sl_poly;     //список полигонов
       sh_points:boolean;
       sh_frame:boolean;

      public
       function put_point(x,y,z:integer):sl_point;
       function put_polygon:sl_poly;
       function get_selested:integer;
       function get_point(x,y,z:integer):sl_point;
       function get_sel_poly:sl_poly;
       procedure set_text_cor(x,y:glfloat);
       function get_col_points:integer;
       function get_col_polys:integer;
       procedure ved_diap(x,y,z,rad:glfloat);
       procedure ved_poly_by_point;
       function line_per(x1,y1,z1,x2,y2,z2:glfloat;var nrm:normal):tpoint_fl;
       procedure reset_ss_normals;
       procedure reset_sm_nrml_sel;
       procedure reset_sm_nrml;
       procedure filter_obj(x,y,z,rad:glfloat);
       procedure sin_obj(kof:glfloat);
       procedure set_s_color(r,g,b:glfloat);
       procedure de_sel;
       procedure invert_obj(x,y,z:boolean);
       procedure clear_obj;
       procedure select_all;
       procedure invert_select;
       procedure show_points(mode:boolean);
       procedure show_frame(mode:boolean);
       procedure invert_nrm;
       procedure del_polygons;
       procedure del_points;
       procedure reset_normals;      //производит расщет всех нормалей
       procedure invert_normals;     //инвертирует все нормали
       procedure LoadFromFile(const FileName : String);
       procedure Save_to_File(const FileName : String);
       procedure Draw;
  end;

Список 3D объектов, единичный объект которого будет класс tGL_object3D.

tList_objects3D = class
      private
       fall_obj,new_obj,next_obj:sl_obj;
      public
       function put_obj(x,y,z:integer;filename:string):sl_obj;
       function GET_obj_XY(x,y:integer):sl_obj;
       function GET_obj_Xz(x,z:integer):sl_obj;
       function get_col_s:integer;
       function get_col:integer;
       procedure sel_point_xz(x,z:integer);
       procedure set_color(r,g,b:glfloat);
       procedure SET_TEXT_CORD(x,y:glfloat);
       procedure filter_list(x,y,z,rad:glfloat);
       procedure reset_nrm_s;
       procedure del_poly_obj;
       procedure sdv_object(x,y,z:integer);
       procedure del_s_points;
       procedure sel_point_xy(x,y:integer);
       procedure put_poly_obj;
       procedure save_to_file_s(filename:string);
       procedure sel_all_points;
       procedure select_all;
       procedure inv_select;
       procedure inv_smooth;
       procedure set_draw_mode(mode:glenum);
       procedure show_points(b:boolean);
       procedure save_to_list_file(filename:string);
       procedure load_from_list_file(filename:string);
       procedure put_point_In_s(x,y,z:integer);
       procedure sdv_points_obj(xh,yh,zh:integer);
       procedure invert_objects(x,y,z:boolean);
       procedure Inv_sel_points;
       procedure obr_nrm_sel;
       procedure draw_list;
       procedure draw_list_xy(pw,ph,xsm,ysm,st:integer);
       procedure draw_list_xz(pw,ph,xsm,ysm,st:integer);
       procedure calk_sm_nrml;
       procedure del_obj;
       procedure clear;
  end;
  

И несколько дополнительный функций:

 procedure butbar3d(x1,y1,z1,x2,y2,z2:real;dr_type:glenum);
 function get_Normal(p1,p2,p3:tpoint;zn:boolean):normal;
 function get_Normal_fl(p1,p2,p3:tpoint_fl):normal;
 function get_dl_line(x1,y1,z1,x2,y2,z2:glfloat):glfloat;
 function get_S_abc(x1,y1,z1,x2,y2,z2,x3,y3,z3:integer):glfloat;
 function getpoint(p1,p2,pt1,pt2,pt3:tpoint_fl;nrm:normal):tpoint_fl;
 function get_angle(x,y:glfloat):glfloat;
 function point_in_triangle(x1,y1,x2,y2,x3,y3,x,y:glfloat):boolean;
 function PixelInOtr(x1,y1,x2,y2,x,y:glfloat):boolean;
 procedure rotate_point(angle:glfloat;var x,y:glfloat);
 procedure butbar3d_in(x1,y1,z1,x2,y2,z2:real;dr_type:glenum);

Теперь немного о самой форме :

Будем обрабатывать следующие:

	procedure FormCreate(Sender: TObject);  // выбираем нужный адаптер и устанавливаем нужные размеры окна  
	procedure FormDestroy(Sender: TObject); //возврощаем все что взяли
	procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); //смотрем что зажато
	procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); //смотрем что отпустили
	procedure FormKeyPress(Sender: TObject; var Key: Char); //смотрем что нажали
	

Исходный текст можна взять здесь

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования