{*******************************************************}
{                                                       }
{       Światło w OpenGL - Delphi                       }
{       Wykorzystanie komponentu GlBox i OpenGL         }
{                                                       }
{       autor: Waldemara Pokuta - 2003                  }
{                                                       }
{*******************************************************}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  GLBox, OpenGL, ExtCtrls, StdCtrls, Buttons, ComCtrls;

type
  TForm1 = class(TForm)
    GL: TGLBox;
    Timer1: TTimer;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Label11: TLabel;
    GroupBox1: TGroupBox;
    SpeedButton2: TSpeedButton;
    Label10: TLabel;
    Label1: TLabel;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    Label2: TLabel;
    ScrollBar4: TScrollBar;
    ScrollBar5: TScrollBar;
    ScrollBar6: TScrollBar;
    Label4: TLabel;
    Label3: TLabel;
    ScrollBar7: TScrollBar;
    ScrollBar8: TScrollBar;
    ScrollBar9: TScrollBar;
    ScrollBar10: TScrollBar;
    ScrollBar11: TScrollBar;
    ScrollBar12: TScrollBar;
    Label7: TLabel;
    ScrollBar16: TScrollBar;
    SpeedButton3: TSpeedButton;
    Label9: TLabel;
    ScrollBar17: TScrollBar;
    ScrollBar15: TScrollBar;
    ScrollBar14: TScrollBar;
    ScrollBar13: TScrollBar;
    Label5: TLabel;
    Label6: TLabel;
    procedure UstawOswietlenie;
    procedure UstalRozmiar;
    procedure GLSetupRC(Sender: TObject);
    procedure GLResize(Sender: TObject);
    procedure GLRender(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Kontrolki(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  swiatlo: record
    lighting, Enable: boolean;
    amb, dif, spec, pos: TGLArrayf4;
  end = (lighting: false;
         Enable : false;
         amb : (  0,  0,  0,  1);
         dif : (  0,  0,  0,  1);
         spec: (  0,  0,  0,  1);
         pos : (  0,  0,  0,  1));
var
  Form1: TForm1;
  kw: gluQuadricObj;
  procedure powierzchnia;
  procedure figury;
implementation

{$R *.DFM}

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(80, w/h, 1, 600);
  glMatrixMode(GL_MODELVIEW);
end;

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

procedure TForm1.GLSetupRC(Sender: TObject);
const
  amb_dif: TGLArrayf4 = (0.8, 0.8, 0.8, 0.2);
  spec   : TGLArrayf4 = (0.5, 0.5, 0.5, 0.2);
  emis   : TGLArrayf4 = (0.0, 0.0, 0.0, 0.2);
begin
  // Wartości początkowe
  glClearColor(0, 0, 0, 1);
  UstalRozmiar;
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_COLOR_MATERIAL);
  glEnable(GL_NORMALIZE);
  // 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);
  // Kwadryki
  kw := gluNewQuadric;
  gluQuadricDrawStyle(kw, GLU_FILL);
  gluQuadricNormals(kw, GLU_SMOOTH);
  gluQuadricOrientation(kw, GLU_OUTSIDE);
  Timer1.Enabled := TRUE;
end;

procedure powierzchnia;
var
  i, j, p: integer;
begin
  glColor3f(0.0, 0.5, 0.0);
  glPushMatrix;
  for p := 0 to 4 do begin
    glBegin(GL_QUADS);
    glNormal3f(0, 0, 1);
    for i := -60 to 59 do
      for j := -60 to 59 do begin
        glVertex3f(    i*2,     j*2, -120);
        glVertex3f(    i*2, (j+1)*2, -120);
        glVertex3f((i+1)*2, (j+1)*2, -120);
        glVertex3f((i+1)*2,     j*2, -120);
      end;
    glEnd;
    if p = 0 then glRotatef(90, 1, 0, 0)
    else
    glRotatef(90, 0, 1, 0);
  end;
  glPopMatrix;
end;

procedure figury;
begin
  glPushMatrix;
  // kula
  glTranslatef(0, 0,-20);
  glRotatef(90, 1, 0, 0);
  glColor3f(1, 0, 0);
  glTranslatef(40, 0, 40);
  gluSphere(kw, 30, 50, 50);
  // walec
  glColor3f(0, 0, 1);
  glTranslatef(-80, 0,-30);
  gluCylinder(kw, 25, 25, 60, 50, 50);
  // stozek
  glColor3f(1, 1, 0);
  glTranslatef(0, 0,-80);
  gluCylinder(kw, 0, 30, 60, 50, 50);
  // dwa stozki
  glColor3f(0, 0.5, 0.5);
  glTranslatef(80, 0, 30);
  gluCylinder(kw, 30, 0, 30, 50, 50);
  glTranslatef(0, 0, -30);
  gluCylinder(kw, 0, 30, 30, 50, 50);
  glPopMatrix;
end;

procedure TForm1.UstawOswietlenie;
begin
  // Oświetlenie sceny
  with swiatlo do begin
    if lighting then
      glEnable(GL_LIGHTING) else
      glDisable(GL_LIGHTING);
    if Enable then
      glEnable(GL_LIGHT1) else
      glDisable(GL_LIGHT1);
    glLightfv(GL_LIGHT1, GL_AMBIENT       , @amb);
    glLightfv(GL_LIGHT1, GL_DIFFUSE       , @dif);
    glLightfv(GL_LIGHT1, GL_SPECULAR      , @spec);
    glLightfv(GL_LIGHT1, GL_POSITION      , @pos);
  end;
end;

procedure TForm1.GLRender(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glLoadIdentity;
  gluLookAt(0, 20, 120, 0, 0, 0, 0, 1, 0);
  UstawOswietlenie;
  // Rysowanie sceny
  powierzchnia;
  figury;
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  gl.Invalidate;
end;

procedure TForm1.Kontrolki(Sender: TObject);
begin
  // Reakcja na użycie kontrolki
  with swiatlo do begin
    lighting := SpeedButton1.Down;
    Enable := SpeedButton2.Down;
    amb[0] := Scrollbar1.Position/100;
    amb[1] := Scrollbar2.Position/100;
    amb[2] := Scrollbar3.Position/100;
    dif[0] := Scrollbar4.Position/100;
    dif[1] := Scrollbar5.Position/100;
    dif[2] := Scrollbar6.Position/100;
    spec[0] := Scrollbar7.Position/100;
    spec[1] := Scrollbar8.Position/100;
    spec[2] := Scrollbar9.Position/100;
    pos[0] := Scrollbar10.Position;
    pos[1] := Scrollbar11.Position;
    pos[2] := Scrollbar12.Position;
  end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  gluDeleteQuadric(kw);
end;

end.
