unit Multi;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Parameters1: TMenuItem;
    Transformation1: TMenuItem;
    Identity1: TMenuItem;
    CullDisable1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Parameters1Click(Sender: TObject);
    procedure Transformation1Click(Sender: TObject);
    procedure Identity1Click(Sender: TObject);
    procedure CullDisable1Click(Sender: TObject);
  private
    GLContext: HGLRC;
    glDC: HDC;
    errorCode: GLenum;
    openGLReady: boolean;
    oldw,
    oldh: integer;
    angle,
    xvalue,
    yvalue,
    zvalue: glFloat;
    procedure ExceptionGL(Sender:TObject;E:Exception);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Trans1;

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject); 
var
  pfd: TPixelFormatDescriptor;
  FormatIndex: integer;
begin
  Application.OnException := ExceptionGL;
  fillchar(pfd,SizeOf(pfd),0);
  with pfd do
  begin
    nSize      := SizeOf(pfd);
    nVersion   := 1; {The current version of the desccriptor is 1}
    dwFlags    := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24; {support 24-bit color}
    cDepthBits := 32; {depth of z-axis}
    iLayerType := PFD_MAIN_PLANE;
  end; {with}
  glDC := getDC(handle);
  FormatIndex := ChoosePixelFormat(glDC,@pfd);
  if FormatIndex=0 then
    raise Exception.Create('ChoosePixelFormat failed '+
      IntToStr(GetLastError)); 

  if not SetPixelFormat(glDC,FormatIndex,@pfd) then
    raise Exception.Create('SetPixelFormat failed '+
      IntToStr(GetLastError));

  GLContext := wglCreateContext(glDC);
  if GLContext=0 then
    raise Exception.Create('wglCreateContext failed '+
      IntToStr(GetLastError)); 

  if not wglMakeCurrent(glDC,GLContext) then
    raise Exception.Create('wglMakeCurrent failed '+
      IntToStr(GetLastError));
  
  OpenGLReady := true;
  oldw := ClientWidth;
  oldh := ClientHeight;
  glOrtho(-1.0,1.0,-1.0,1.0,-1.0,1.0);   
  glEnable(GL_DEPTH_TEST);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
                 
  glEnable(GL_CULL_FACE);
  glCullFace(GL_BACK);
end; {FormCreate}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  OpenGLReady := false;
  wglMakeCurrent(glDC,0);
  wglDeleteContext(GLContext);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if not openGLReady then
    exit;
    
  {green background}
  glClearColor(0.0,0.4,0.0,0.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glBegin(GL_POLYGON); {near face}
    glColor3f(0.5,0.0,0.0);
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(+0.4,-0.4,-0.4);
    glVertex3f(+0.4,+0.4,-0.4);
    glVertex3f(-0.4,+0.4,-0.4);
  glEnd;

  glBegin(GL_POLYGON); {right face}
    glColor3f(0.3,0.3,0.8);
    glVertex3f(+0.4,-0.4,-0.4);
    glVertex3f(+0.4,-0.4,+0.4);
    glVertex3f(+0.4,+0.4,+0.4);
    glVertex3f(+0.4,+0.4,-0.4);
  glEnd;

  glBegin(GL_POLYGON); {left face}
    glColor3f(0.5,0.0,0.5);
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(-0.4,+0.4,-0.4);
    glVertex3f(-0.4,+0.4,+0.4);
  glEnd;

  glBegin(GL_POLYGON); {back face}
    glColor3f(0.0,0.0,0.5);
    glVertex3f(+0.4,-0.4,+0.4);
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(-0.4,+0.4,+0.4);
    glVertex3f(+0.4,+0.4,+0.4);
  glEnd;

  glBegin(GL_POLYGON); {bottom face}
    glColor3f(0.5,0.5,0.0);
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(+0.4,-0.4,+0.4);
    glVertex3f(+0.4,-0.4,-0.4);
  glEnd;

  glBegin(GL_POLYGON); {top face}
    glColor3f(0.3,0.0,0.1);
    glVertex3f(-0.4,+0.4,-0.4);
    glVertex3f(+0.4,+0.4,-0.4);
    glVertex3f(+0.4,+0.4,+0.4);
    glVertex3f(-0.4,+0.4,+0.4);
  glEnd;

  glFlush;

  errorCode := glGetError;
  if errorCode<>GL_NO_ERROR then
    raise Exception.Create('Error in Paint'#13+
      gluErrorString(errorCode));
end; {FormPaint}

procedure TForm1.FormResize(Sender: TObject);
begin
  if not openGLReady then
    exit;
  glViewPort(0,0,ClientWidth,ClientHeight);

  errorCode := glGetError;
  if errorCode<>GL_NO_ERROR then
    raise Exception.Create('FormResize:'+gluErrorString(errorCode));
  if (ClientWidth<=oldw) and (ClientHeight<=oldh) then
    FormPaint(Sender);
  oldh := ClientHeight;
  oldw := ClientWidth;
end;

procedure TForm1.ExceptionGL(Sender:TObject;E:Exception);
begin
  ShowMessage(E.Message);
  repeat
    errorCode := glGetError;
    if errorCode<>GL_NO_ERROR then
      showMessage(gluErrorString(errorCode));
  until errorCode=GL_NO_ERROR;
end;

procedure TForm1.Parameters1Click(Sender: TObject);
begin
  FormTransform.ShowModal;
end;

procedure TForm1.Transformation1Click(Sender: TObject);
var
  list: TStringList;
  lno: integer;
begin
  list := TStringList.Create;
  list.sorted := true;
  with list,transData do
  begin
    if translate then
      Add(OrT+'T');
    if scale then
      Add(OrS+'S');
    if rotate then
      Add(OrR+'R');
    if count=0 then
      exit;

    glMatrixMode(GL_MODELVIEW);
    for lno := 0 to count-1 do
    begin
      case strings[lno][2] of
        'R': begin
          glRotatef(ra,rx,ry,rz);
        end;
        'S': begin
          glScalef(sx,sy,sz);
        end;
        'T': begin
          glTranslatef(tx,ty,tz);
        end;
      end; {case}
    end; {for}
  end; {with}
  List.Free;
  Invalidate;
end;

procedure TForm1.Identity1Click(Sender: TObject);
begin
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  Invalidate;
end;

procedure TForm1.CullDisable1Click(Sender: TObject);
begin
  glDisable(GL_CULL_FACE);
  Invalidate;
end;

end.
