
{*******************************************************}
{                                                       }
{       Tworzenie brył - Delphi                         }
{       Wykorzystanie komponentu GlBox i OpenGL         }
{                                                       }
{       autor: Waldemara Pokuta - 2003                  }
{                                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Forms, Dialogs, OpenGl, ExtCtrls,
  Controls, StdCtrls, GLBox;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    Timer1: TTimer;
    gl: TGLBox;
    procedure UstawOswietlenie;
    procedure UstalRozmiar;
    procedure glRender(Sender: TObject);
    procedure glSetupRC(Sender: TObject);
    procedure glResize(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
    procedure ScrollBar3Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  procedure Szescian(rozm: real);
  procedure Czworoscian(rozm: real);
  procedure Osmioscian(rozm: real);
  procedure Czternastoscian(rozm: real);
  procedure Dwudziestoscian(rozm: real);
  procedure Dwunastoscian(rozm: real);
  procedure Kula(rozm: real; gestosc: integer);
  procedure Metan(rozm: real);
var
  Form1: TForm1;
  katx : real = 0;
  katy : real = 0;
  katz : real = 0;

implementation

{$R *.DFM}

procedure Szescian(rozm: real);
var
  i: integer;
begin
  glPushMatrix;
  for i := 0 to 5 do begin
    glBegin(GL_QUADS);
      glNormal3f(    0,    0,    1);
      glVertex3f(-rozm, rozm, rozm);
      glVertex3f(-rozm,-rozm, rozm);
      glVertex3f( rozm,-rozm, rozm);
      glVertex3f( rozm, rozm, rozm);
    glEnd;
    // Obrót na kolejną ścianę
    if odd(i) then glRotatef(90, 0, 1, 0) else glRotatef(90, 1, 0, 0);
  end;
  glPopMatrix;
end;

procedure Czworoscian(rozm: real);
const
  wsp = 0.6436;
var
  i: integer;
begin
  glPushMatrix;
  for i := 0 to 3 do begin
    glBegin(GL_TRIANGLES);
      glNormal3f(  wsp,  wsp,  wsp);
      glVertex3f(-rozm, rozm, rozm);
      glVertex3f( rozm, rozm,-rozm);
      glVertex3f( rozm,-rozm, rozm);
    glEnd;
    // Obrót na kolejną ścianę
    if odd(i) then glRotatef(180, 1, 0, 0) else glRotatef(180, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure Osmioscian(rozm: real);
const
  wsp = 0.6436;
var
  i: integer;
begin
  glPushMatrix;
  for i := 0 to 7 do begin
    glBegin(GL_TRIANGLES);
      glNormal3f(  wsp,  wsp,  wsp);
      glVertex3f(    0,    0, rozm);
      glVertex3f( rozm,    0,    0);
      glVertex3f(    0, rozm,    0);
    glEnd;
    // Obrót na kolejną ścianę
    glRotatef(90, 1, 0, 0);
    // Po czterech ścianach odwracamy figurę o 180 stopni
    if i = 3 then glRotatef(180, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure Czternastoscian(rozm: real);
const
  wsp = 0.6436;
var
  i: integer;
begin
  // Ściany trójkątne
  glPushMatrix;
  for i := 0 to 7 do begin
    glBegin(GL_TRIANGLES);
      glNormal3f(  wsp,  wsp,  wsp);
      glVertex3f(    0, rozm, rozm);
      glVertex3f( rozm, rozm,    0);
      glVertex3f( rozm,    0, rozm);
    glEnd;
    // Obrót na kolejną ścianę
    glRotatef(90, 1, 0, 0);
    // Po czterech ścianach odwracamy figurę o 180 stopni
    if i = 3 then glRotatef(180, 0, 1, 0);
  end;
  glPopMatrix;
  // Ściany kwadratowe
  glPushMatrix;
  for i := 0 to 5 do begin
    glBegin(GL_QUADS);
      glNormal3f(    0,    0,    1);
      glVertex3f(    0, rozm, rozm);
      glVertex3f( rozm,    0, rozm);
      glVertex3f(    0,-rozm, rozm);
      glVertex3f(-rozm,    0, rozm);
    glEnd;
    // Obrót na kolejną ścianę
    if odd(i) then glRotatef(90, 0, 1, 0) else glRotatef(90, 1, 0, 0);
  end;
  glPopMatrix;
end;

procedure Dwunastoscian(rozm: real);
const
  h = 0.7946544;
  r = 0.607062;
  beta = 31.717477;
var
  i, j: integer;
begin
  glPushMatrix;
  glScalef(rozm, rozm, rozm);
  for j := 0 to 5 do begin
    glBegin(GL_POLYGON);
      glNormal3f(0, 1, 0);
      for i := 0 to 4 do glVertex3f(r*sin(i*2*pi/5), h, r*cos(i*2*pi/5));
    glEnd;
    glBegin(GL_POLYGON);
      glNormal3f(0, -1, 0);
      for i := 0 to 4 do glVertex3f(-r*sin(i*2*pi/5), -h, -r*cos(i*2*pi/5));
    glEnd;
    glRotatef(-2*beta, 1, 0, 0);
    glRotatef(36, 0, 1, 0);
    if j = 0 then glRotatef(72, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure Dwudziestoscian(rozm: real);
const
  h = 0.7946544;
  r = 0.607062;
  beta = 20.905159;
var
  i, j, k: integer;
begin
  glPushMatrix;
  glScalef(rozm, rozm, rozm);
  for k := 0 to 4 do begin
    glPushMatrix;
    for j := 0 to 1 do begin
      glBegin(GL_TRIANGLES);
        glNormal3f(0, 1, 0);
        for i := 0 to 2 do glVertex3f(r*sin(i*2*pi/3), h, r*cos(i*2*pi/3));
      glEnd;
      glBegin(GL_TRIANGLES);
        glNormal3f(0, -1, 0);
        for i := 0 to 2 do glVertex3f(-r*sin(i*2*pi/3), -h, -r*cos(i*2*pi/3));
      glEnd;
      glRotatef(-2*beta, 1, 0, 0);
      glRotatef(60, 0, 1, 0);
    end;
    glPopMatrix;
    glRotatef(120, 0, 1, 0);
    glRotatef(-2*beta, 1, 0, 0);
    glRotatef(-60, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure Kula(rozm: real; gestosc: integer);
var
  i, j, k, ii, jj: integer;
  x, y, z: real;
begin
  glPushMatrix;
  glScalef(rozm, rozm, rozm);
  glBegin(GL_QUADS);
    for i := 0 to gestosc-1 do begin
      for j := 0 to gestosc-1 do begin
        for k := 0 to 3 do begin
          if k<=1 then ii := 0 else ii := 1;
          if k in [1,2] then jj:=0 else jj:=1;
          x := sin((i+ii)*pi/gestosc)*sin((j+jj)*2*pi/gestosc);
          y := cos((i+ii)*pi/gestosc);
          z := sin((i+ii)*pi/gestosc)*cos((j+jj)*2*pi/gestosc);
          glNormal3f(x, y, z);
          glVertex3f(x, y, z);
        end;
      end;
    end;
  glEnd;
  glPopMatrix;
end;

procedure Metan(rozm: real);
var
  gestosc: integer;
begin
  gestosc := round(rozm)+5;
  glPushMatrix;

  glScalef(rozm, rozm, rozm);
  glColor3f(1, 0, 0);
  Kula(1.5, gestosc);

  glPushMatrix;
  glTranslatef(2, 2, 2);
  glColor3f(0, 1, 0);
  Kula(1, gestosc);
  glPopMatrix;

  glPushMatrix;
  glTranslatef(-2, -2, 2);
  glColor3f(0, 0, 1);
  Kula(1, gestosc);
  glPopMatrix;

  glPushMatrix;
  glTranslatef(2, -2, -2);
  glColor3f(0, 1, 1);
  Kula(1, gestosc);
  glPopMatrix;

  glTranslatef(-2, 2, -2);
  glColor3f(1, 0, 1);
  Kula(1, gestosc);

  glPopMatrix;
end;

procedure Polka(kat: real);
var
  h: real;
  i, j: integer;
begin
  h := sqrt(3)/2;
  glPushMatrix;
  glRotatef(kat, 0, 1, 0);
  for j := 0 to 1 do begin
    for i := 0 to 2 do begin
      glBegin(GL_QUADS);
        glNormal3f(-0.9, 0, 0.1);
        glVertex3f(-h*0.8, 0.5*0.8, 0.5);
        glVertex3f(-h, 0.5, 0);
        glVertex3f(-h, -0.5, 0);
        glVertex3f(-h*0.8, -0.5*0.8, 0.5);

        glNormal3f(0.9, 0, 0.1);
        glVertex3f(h*0.8, 0.5*0.8, 0.5);
        glVertex3f(h, 0.5, 0);
        glVertex3f(h, -0.5, 0);
        glVertex3f(h*0.8, -0.5*0.8, 0.5);
      glEnd;
      glRotatef(60, 0, 0, 1);
    end;
    glRotatef(180, 1, 0, 0);
  end;
  glPopMatrix;
end;

procedure Regal;
const
  kat: real = 0;
var
  h, a: real;
  i, j: integer;
begin
  h := 1.1*sqrt(3)/2;
  a := 1.1;
  glPushMatrix;
  glScalef(38, 38, 38);

  glPushMatrix;
  glTranslatef(3*h, 0, 0);
  for i := 0 to 3 do begin
    Polka(kat);
    glTranslatef(-2*h, 0, 0);
  end;
  glPopMatrix;

  glTranslatef(2*h, 1.5*a, 0);
  for j := 0 to 1 do begin
    for i := 0 to 2 do begin
      Polka(kat);
      glTranslatef(-2*h, 0, 0);
    end;
    glTranslatef(6*h, -3*a, 0);
  end;
  kat := kat+3;
  glPopMatrix;
end;

procedure TForm1.UstawOswietlenie;
const
  ambient: TGLArrayf4 = ( 0.3, 0.3, 0.3, 1.0);
  l0amb  : TGLArrayf4 = ( 0.0, 0.0, 0.0, 1.0);
  l0dif  : TGLArrayf4 = ( 0.9, 0.9, 0.9, 1.0);
  l0spec : TGLArrayf4 = ( 1.0, 1.0, 1.0, 1.0);
  l0pos  : TGLArrayf4 = ( 0.0, 0.0,-300, 1.0);
  l1amb  : TGLArrayf4 = ( 0.0, 0.0, 0.0, 1.0);
  l1dif  : TGLArrayf4 = ( 0.5, 0.5, 0.5, 1.0);
  l1spec : TGLArrayf4 = ( 0.5, 0.2, 0.5, 1.0);
  l1pos  : TGLArrayf4 = (-200,-250, 300, 1.0);
  l2amb  : TGLArrayf4 = ( 0.0, 0.0, 0.0, 1.0);
  l2dif  : TGLArrayf4 = ( 0.5, 0.5, 0.5, 1.0);
  l2spec : TGLArrayf4 = ( 1.0, 1.0, 1.0, 1.0);
  l2pos  : TGLArrayf4 = ( 200, 400, 350, 1.0);
begin
  glLightModelfv(GL_LIGHT_MODEL_AMBIENT, @ambient);
  glLightfv(GL_LIGHT0,  GL_AMBIENT,  @l0amb);
  glLightfv(GL_LIGHT0,  GL_DIFFUSE,  @l0dif);
  glLightfv(GL_LIGHT0, GL_SPECULAR, @l0spec);
  glLightfv(GL_LIGHT0, GL_POSITION,  @l0pos);
  glEnable (GL_LIGHT0);
  glLightfv(GL_LIGHT1,  GL_AMBIENT,  @l1amb);
  glLightfv(GL_LIGHT1,  GL_DIFFUSE,  @l1dif);
  glLightfv(GL_LIGHT1, GL_SPECULAR, @l1spec);
  glLightfv(GL_LIGHT1, GL_POSITION,  @l1pos);
  glEnable (GL_LIGHT1);
  glLightfv(GL_LIGHT2,  GL_AMBIENT,  @l2amb);
  glLightfv(GL_LIGHT2,  GL_DIFFUSE,  @l2dif);
  glLightfv(GL_LIGHT2, GL_SPECULAR, @l2spec);
  glLightfv(GL_LIGHT2, GL_POSITION,  @l2pos);
  glEnable (GL_LIGHT2);
end;

procedure TForm1.UstalRozmiar;
var
  w, h: integer;
begin
  // Ustalenie widoku perspektywicznego
  w := gl.Width;
  h := gl.Height;
  if h = 0 then h := 1;
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(60, w/h, 1, 400);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TForm1.glRender(Sender: TObject);
var
  x, y, z: real;
  i: integer;
const
  amb_dif: TGLArrayf4 = (0.5, 0.5, 0.2, 1);
  spec   : TGLArrayf4 = (0.5, 0.5, 0.5, 1);
  emis   : TGLArrayf4 = (0.1, 0.1, 0.1, 1);
  kat: real=0;
  tab_c: array[0..9, 0..2] of real =
   ((0.8, 0.0, 0.0), (0.0, 0.8, 0.0), (0.0, 0.0, 0.8),
    (0.5, 0.5, 0.0), (0.5, 0.0, 0.5), (0.0, 0.5, 0.5), (0.3, 0.7, 0.0),
    (0.3, 0.0, 0.7), (0.0, 0.3, 0.7), (0.7, 0.0, 0.3));
  tab_p: array[0..9, 0..1] of real =
   ((  74,  60), (   0,  60), ( -74,  60),
    ( 111,   0), (  37,   0), ( -37,   0), (-111,   0),
    (  74, -60), (   0, -60), ( -74, -60));
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  // Materiał figur
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @amb_dif);
  glMaterialfv(GL_FRONT_AND_BACK,            GL_SPECULAR,    @spec);
  glMaterialf (GL_FRONT_AND_BACK,           GL_SHININESS,       80);
  glMaterialfv(GL_FRONT_AND_BACK,            GL_EMISSION,    @emis);
  // Załadowanie przekształcenia tożsamościowego
  glLoadIdentity;
  // Położenie kamery
  glRotatef(katz, 0, 0, 1);
  x :=  200*Sin(katx)*Cos(katy);
  y :=  200*Sin(katy);
  z := -200*Cos(katx)*Cos(katy);
  gluLookAt(x, y, z, 0, 0, 0, 0, 1, 0);
  // Oświetlenie
  UstawOswietlenie;
  // Rysowanie regału
  Regal;
  // Rysowanie kolejnych gadżetów
  for i := 0 to 9 do begin
    glPushMatrix;
    glColor3f(tab_c[i, 0], tab_c[i, 1], tab_c[i, 2]);
    glTranslatef(tab_p[i, 0], tab_p[i, 1], 0);
    glRotatef(kat, sin(kat/210), cos(kat/200), 0.7);
    case i of
      0: Szescian(15);
      1: Czworoscian(15);
      2: Osmioscian(20);
      3: Czternastoscian(15);
      4: Dwunastoscian(20);
      5: Dwudziestoscian(20);
      6: Metan(6);
      7: ;
      8: ;
      9: ;
    end;
    glPopMatrix;
  end;
  kat := kat+5;
end;

procedure TForm1.glSetupRC(Sender: TObject);
begin
  // Wartości początkowe
  glClearColor(0, 0, 0, 1);
  UstalRozmiar;
  glEnable(GL_LIGHTING);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_NORMALIZE);
  glEnable(GL_COLOR_MATERIAL);
  Timer1.Enabled := TRUE;
end;

procedure TForm1.glResize(Sender: TObject);
begin
  UstalRozmiar;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  // Obrót obserwatora wzdłuż równoleżnika - kat w radianach
  katx := ScrollBar1.Position*2*PI/200;
end;

procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
  // Obrót obserwatora wzdłuż południka - kat w radianach
  katy := ScrollBar2.Position*PI/200;
end;

procedure TForm1.ScrollBar3Change(Sender: TObject);
begin
  // Obrót obserwatora wokół własnej osi - kąt w stopniach
  katz := ScrollBar3.Position*360/200;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // Następna klatka
  gl.Invalidate;
end;

end.
