3D графика в Lazarus

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
// Подключение библиотек. Для работы C OpenGL необходимы OpenGLContext, GL, GLU
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, ComCtrls, OpenGLContext, GL, GLU;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    PageControl1: TPageControl;
    RadioGroup1: TRadioGroup;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure OpenGLControl1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    fleft, fright, ftop, fbottom: GLdouble;
    timer: single;
    LastMsecs: integer;
    rrx: single;
    fps: integer;
    procedure PaintGL1;
    procedure PaintGL2;
    procedure IdleFunc(Sender: TObject; var Done: Boolean);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
  fleft := -1;
  fright := 1;
  ftop := 1;
  fbottom := 0;
  fps := 0;
  RadioGroup1.ItemIndex := 0;
//  Application.OnIdle := @IdleFunc;
//  OpenGLControl1.MultiSampling := 4;
end;
 
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  if Key = ord('Q') then fleft := fleft + 0.1;
  if Key = ord('W') then fleft := fleft - 0.1;
  if Key = ord('O') then fright := fright + 0.1;
  if Key = ord('P') then fright := fright - 0.1;
 
  Caption := Format('%.2f, %.2f, %.2f, %.2f', [fleft, fright, fbottom, ftop]);
 
  OpenGLControl1.Invalidate;
 
end;
 
procedure TForm1.PaintGL1;
begin
  //  OpenGLControl1.
    glClearColor (0.2, 0.4, 0.6, 0); // цвет фона
    glClear (GL_COLOR_BUFFER_BIT);      // очистка буфера цвета
    glMatrixMode(GL_MODELVIEW);  // Выбор видовой матрицы
    glLoadIdentity();   //  Установка в единичные значения
  //  glOrtho(-0.5, 1, 0, 1, -1 ,1); // Установка проекции окна
    glOrtho(fleft, fright, fbottom, ftop, -1 ,1); // Установка проекции окна
    //glTranslatef(0.5,0.5,0);  // Сдвиг
    //glRotatef(10, 0, 0, 0);   // Вращение
    glBegin(GL_TRIANGLES);      // Рисование треугольника
      glColor3f(1, 0, 0);     // Красный
      glVertex3f(0.0, 1.0, 0.0 ); // Верх треугольника (Передняя)
      glColor3f(0, 1, 0);
      glVertex3f( -1.0, -1.0 , 0.0);
      glColor3f(0, 0, 1);
      glVertex3f( 1.0, -1.0, 0.0);
    glEnd;
end;
 
procedure TForm1.PaintGL2;
var
  CurTime: TDateTime;
  MSecs: integer;
begin
  CurTime:=Now;
  MSecs:=round(CurTime*86400*1000) mod 1000;
 
  if MSecs<0 then MSecs:=1000+MSecs;
  timer:=msecs-LastMsecs;
 
  if timer<0 then timer:=1000+timer;
  LastMsecs:=MSecs;
 
  glClearColor(0.0, 0.0, 0.0, 0.0);
 
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
  glLoadIdentity ();
  glFrustum (-1, 1, -1, 1, 4.5, 10);
  glTranslatef(0.0, 0.0, -5.0);
 
  rrx:=rrx-0.6*(timer/10);
  glRotatef(rrx,0.0,1.0,0.0);
 
  glBegin(GL_QUADS);
 
  glColor3f( 1.0, 1.0, 0.0);
 
  glVertex3f(-0.5, 0.5, 0.0);
  glVertex3f( 0.5, 0.5, 0.0);
  glVertex3f( 0.5,-0.5, 0.0);
  glVertex3f(-0.5,-0.5, 0.0);
 
  glEnd();
end;
 
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
begin
  Inc(fps);
  case RadioGroup1.ItemIndex of
  0: PaintGL1;
  1: PaintGL2;
  end;
 
  OpenGLControl1.SwapBuffers; // Отрисовка из буффера
//  Sleep(1);
end;
 
procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
end;
 
procedure TForm1.IdleFunc(Sender: TObject; var Done: Boolean);
begin
  OpenGLControl1.Invalidate;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  OpenGLControl1.Invalidate;
end;
 
procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Caption := IntToStr(fps);
  fps := 0;
end;
 
end.