unit frmMain;

 

interface

 

uses

  Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Controls, SysUtils,

  Dialogs, StdCtrls,

  OpenGL;

 

type

  TfrmGL = class(TForm)

    Memo1: TMemo;

    procedure FormCreate(Sender: TObject);

    procedure FormResize(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure FormKeyDown(Sender: TObject; var Key: Word;

      Shift: TShiftState);

 

  private

    DC: HDC;

    hrc: HGLRC;

    vp : Array [0..3] of GLint;

    selectBuf : Array [0..128] of GLuint;

 

    procedure SetDCPixelFormat;

    procedure Render (mode : GLEnum);

    function DoSelect(x : GLint; y : GLint) : GLUInt;

  protected

    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

  end;

 

var

  frmGL: TfrmGL;

  angle : GLfloat = 0;

implementation

 

{$R *.DFM}

 

procedure angleAdd;

begin

 angle := angle + 0.05;

 if angle > 1

 then angle := 0;

end;

 

procedure angleSubtract;

begin

 angle := angle - 0.05;

 if angle < -1

 then angle := 0;

end;

 

function TfrmGL.DoSelect(x : GLint; y : GLint) : GLUInt;

begin

  glRenderMode(GL_SELECT);

  glInitNames;

  glPushName(0);

  glGetIntegerv(GL_VIEWPORT, @vp);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity;

  gluPickMatrix(x, ClientHeight - y, 1, 1, @vp);

  gluPerspective(18.0, (ClientWidth - Memo1.Width) / ClientHeight, 6.0, 10.0);

  glViewport(0, 0, (ClientWidth - Memo1.Width), ClientHeight);

  glMatrixMode(GL_MODELVIEW);

  glClear(GL_COLOR_BUFFER_BIT);

  Render(GL_SELECT);

  Result := glRenderMode(GL_RENDER);

end;

 

procedure TfrmGL.Render (mode : GLEnum);

begin

  glPushMatrix;

  glRotatef (-60, 0.0, 0.0, 1.0);

  if mode = GL_SELECT

  then glLoadName (0);

  glColor3f (1.0, 0.0, 0.0);

  glRectf(-0.5, -0.5, 0.5, 0.5);

  glPopMatrix;

end;

 

procedure TfrmGL.WMPaint(var Msg: TWMPaint);

var

  ps : TPaintStruct;

begin

  BeginPaint(Handle, ps);

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity;

  glTranslatef(0.0, 0.0, -9.0);

  glRotatef(90.0, 1.0, 0.0, 1.0);

 

  glPushMatrix;

  //glRotatef (angle, 0.0, 0.0, 1.0);

  glTranslatef(0.0, 0.0, angle);

  Render (GL_RENDER);

  glPopMatrix;

 

  SwapBuffers(DC);

  EndPaint(Handle, ps);

end;

 

 

procedure TfrmGL.FormCreate(Sender: TObject);

begin

  DC := GetDC(Handle);

  SetDCPixelFormat;

  hrc := wglCreateContext(DC);

  wglMakeCurrent(DC, hrc);

  glSelectBuffer(SizeOf (selectBuf), @selectBuf);

  Memo1.Clear;

end;

 

 

 

procedure TfrmGL.SetDCPixelFormat;

var

  nPixelFormat: Integer;

  pfd: TPixelFormatDescriptor;

begin

  FillChar(pfd, SizeOf(pfd), 0);

 

  pfd.dwFlags   := PFD_DRAW_TO_WINDOW or

                 PFD_SUPPORT_OPENGL or

                 PFD_DOUBLEBUFFER;

  nPixelFormat := ChoosePixelFormat(DC, @pfd);

  SetPixelFormat(DC, nPixelFormat, @pfd);

end;

 

procedure TfrmGL.FormResize(Sender: TObject);

begin

  glViewport(0, 0, (ClientWidth - Memo1.Width), ClientHeight);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity;

  gluPerspective(18.0, (ClientWidth - Memo1.Width) / ClientHeight, 6.0, 10.0);

  glMatrixMode(GL_MODELVIEW);

  glGetIntegerv(GL_VIEWPORT, @vp);

  InvalidateRect(Handle, nil, False);

end;

 

procedure TfrmGL.FormDestroy(Sender: TObject);

begin

  wglMakeCurrent(0, 0);

  wglDeleteContext(hrc);

  ReleaseDC(Handle, DC);

  DeleteDC (DC);

end;

 

procedure TfrmGL.FormMouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var

  hit, hits: GLUint;

begin

  hits := DoSelect (X, Y);

  Memo1.Clear;

  Memo1.Lines.Add(Format('Îáúåêòîâ ïîä êóðñîðîì : %d',[hits]));

  glViewport(0, 0, (ClientWidth - Memo1.Width), ClientHeight);

  glMatrixMode(GL_PROJECTION);

  glLoadIdentity;

  gluPerspective(18.0, (ClientWidth - Memo1.Width) / ClientHeight, 6.0, 10.0);

  glGetIntegerv(GL_VIEWPORT, @vp);

  glMatrixMode(GL_MODELVIEW);

  InvalidateRect(Handle, nil, False);

 

end;

 

procedure TfrmGL.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  If Key = VK_ESCAPE then Close;

   If Key = VK_UP then begin

    angleSubtract;

    InvalidateRect(Handle, nil, False);

 end;

 If Key = VK_DOWN then begin

    angleAdd;

   InvalidateRect(Handle, nil, False);

 end;

end;

 

end.