Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue69/OpenGL/BasicOpenGL.pas

Pascal/Delphi Source File | 2001-04-16 | 15.1 KB | 527 lines

unit BasicOpenGL;

interface
  Uses Windows, Controls, Messages, Dialogs, Forms, Classes, ComCtrls,//standard units
       Opengl12,                          //OpenGL header unit from Mike  Lishke
       Geometry,                          //support unit with data constructs
       DGLUT;                             //OpenGL utility Library

 Type
   TBasicOpenGL = class;
   TOpenGLObject = Class;

   TGLUpdateTreeEventNotify = Procedure Of Object;  //Event used to update a treeview

   TGLPoint       = packed Record
     X, Y, Z: TGLDouble;
   End;

   TGLColorVal     = Array [0..3] Of TGlFloat;

   TSelectMode =(tsMouseSelect, //will set the select flag to true on objects found
                 tsWindowCull); //will set the viewCull flag to false on those in the view

   TBasicOpenGL    = Class(TWinControl)
   Private
      FRenderDC       : HDC;             //create and hold device context for the session
      FHRC            : HGLRC;           //rendering context assigned to device context and windows handle

    procedure SetViewAngle(const Value: Single);          // used to tag initial setup been done

   Protected
      FRootObject     : TOpenGLObject;
      FViewAngle      : Single;
      FOnUpdateTreeView   : TGLUpdateTreeEventNotify;
      FViewPosition   : Integer;

 //override original functionality to get the OpenGL window running
      Procedure WMPaint(Var Message: TWMPaint); Message WM_PAINT;
      procedure WMSize(var Message: TWMSize); message WM_SIZE;
      Procedure WMEraseBkgnd(Var Message: TWmEraseBkgnd); Message WM_ERASEBKGND;
      Procedure WMSetFocus(Var Message: TWMSetFocus); Message WM_SETFOCUS;

      Procedure DestroyWindowHandle; Override;
      Procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Override;

      Procedure GLShutDown;              //GL session shutdown
      Procedure ClearWindow;             //clear the OpenGL window
      Procedure GetSelectList(X,Y:Integer; SelectMode :TSelectMode); //returns a list of objects
      Procedure RenderWindow;  Virtual;          //Render the window similar to Paint

   Public
      Constructor Create(Owner:TComponent);Override;

      Procedure GLStartUp;               // GL startup
      Procedure CullView;                //remove all objects not in the current view frame from the draw list

      Property RootObject:TOpenGLObject read FRootObject write FRootObject;
      Property ViewAngle:Single Read fViewAngle write SetViewAngle;

      Property OnUpdateTreeView : TGLUpdateTreeEventNotify Read FOnUpdateTreeView write FOnUpdateTreeView;
      Property ViewPosition:Integer read fViewPosition write fViewPosition;
   end;

  TOpenGLObject = Class (TObject)
  //class will be attached to the TreeNodes as Data as the TTreeNode is not extendable
  private
    procedure setSelected(const Value: Boolean);
    procedure setViewCulled(const Value: Boolean);
    procedure settext(const Value: String);
    function getText: String;
    function GetChild(Index: Integer): TOpenGLObject;
    function GetChildrenCount: Integer;
  Protected
    FParent        : TOpenGLObject;  //parent in the scene
    FChildrenList  : TList;       //holds all children
    FViewCulled : Boolean;  //if true then this object is not currently in the view
    FSelected   : Boolean;  // true if this is selected
    FTranslation: TGLPoint; // a translation which will effect all the children
    FRotation,             //a rotation about X,Y and Z axis
    FScale      : TGLPoint;//a scale in X, Y and Z directions
    FText       : String;
    FMode       : Integer;
  Public
    Constructor Create;
    Destructor Destroy;Override;
    Procedure DoRender;
    Function AddChild: TOpenGLObject;
    Procedure BuildTreeView(ATreeView:TTreeView;ParentNode:TTreeNode);
    Procedure CullAllObjects(Value:Boolean);  //set all objects as NOT visible;

 //access properties
    Property ChildCount:Integer Read GetChildrenCount;
    Property Child[Index: Integer]: TOpenGLObject Read GetChild;
    Property ViewCulled : Boolean read FViewCulled write setViewCulled ;
    Property Selected  : Boolean  read FSelected  write setSelected;
    Property Translation: TGLPoint read FTranslation write FTranslation ;
    Property Rotation: TGLPoint read FRotation write FRotation ;
    Property Scale: TGLPoint read FScale write FScale ;
    Property Text:String read getText write settext;
    Property Mode:Integer Read fMode write fMode;
  end;

  const
    glRed     : TGLColorVal = (1, 0, 0, 1);
    glGreen   : TGLColorVal = (0, 1, 0, 1);
    glBlue    : TGLColorVal = (0, 0, 1, 1);
    glGray    : TGLColorVal = (0.8, 0.8, 0.8, 0.5);
implementation

{ TBasicOpenGL }
procedure TBasicOpenGL.GLShutDown;
begin
   If (wglGetCurrentContext=fHRC) Then
       wglMakeCurrent(0,0) ;
          //if this window  session is active the deactivate

   If fHRC<>0 Then
      Begin
         wglDeleteContext(fHRC);  //delete the Rendering context
         fHRC:=0;
      End ;

   If fRenderDC<>0 Then
      ReleaseDC(handle,fRenderDC);  //release the device context

   fRenderDC:=0;
end;

procedure TBasicOpenGL.GLStartUp;
// Startn up the GLSession
Begin { TdvAbstractOpenGL.GLStartUp }
   If fHRC<>0 then exit;

   If not HandleAllocated then
      HandleNeeded;            //request a windows handle now.

   If not HandleAllocated then exit;//if not assigned a handle then exit

   If fRenderDC=0 then
      fRenderDC:=GetDC(handle);  //create a device context for the handle

   If fRenderDC=0 Then Exit;     //fail to start

// Create the Render Context for the device context
   fHRC:=CreateRenderingContext(fRenderDC,
                                [opDoubleBuffered], //use double bufferein to stop flickering
                                24,    //colour bits
                                1,    //stencil bits
                                32,  //accum bits
                                0,0);

//handle fail
   If fHRC=0 Then
   Begin
     ReleaseDC(handle, fRenderDC);
     Exit ;
   end;

   ActivateRenderingContext(fRenderDC,fHRC); //activate the session

   glEnable(GL_DEPTH_TEST);
   glEnable(GL_LINE_SMOOTH);
   glEnable(GL_POLYGON_SMOOTH);
   glDrawBuffer(GL_BACK);
end;

Procedure TBasicOpenGL.ClearWindow;
Begin
  glClearColor(0,0,0,0);            //set to black
  glClear(GL_COLOR_BUFFER_BIT or
          GL_DEPTH_BUFFER_BIT);    //clear the depth and color buffers
end;

procedure TBasicOpenGL.RenderWindow;
begin
  ClearWindow;            //clear the window
  If Height=0 then exit;
  glViewport(0,0,width,Height);    //set the viewport size
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluperspective(fViewAngle,width/Height,1,500);  //set to perspective view
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  Case fViewPosition of
    0:  glTranslatef(0,0,-50);          //move the viewer 50 units up the z axis looking down
    1:  //above
    Begin
      glTranslatef(0,0,-50);
      glRotatef(15,0,1,0);
      glRotatef(25,1,0,0);
    end;
    2:     //side
    Begin
      glTranslatef(0,0,-50);
      glRotatef(90,0,1,0);
    end;
    3:  //behind
    Begin
      glTranslatef(0,0,-50);
      glRotatef(160,0,1,0);
      glRotatef(35,1,0,0);
    end;
    else glTranslatef(0,0,-50);
  end;//case

  If fRootObject<>Nil then
     fRootObject.DoRender;
  glFlush;                //flush the GL pipeline
  SwapBuffers(fRenderDC); //swap the buffers
end;

procedure TBasicOpenGL.WMPaint(var Message: TWMPaint);
begin
    ValidateRect(handle,nil);
    ControlState:=ControlState+[csCustomPaint];
    RenderWindow;
    ControlState:=ControlState-[csCustomPaint];
    Message.Result:=1;
end;
procedure TBasicOpenGL.DestroyWindowHandle;
begin
  GLShutDown;
  inherited;
end;

procedure TBasicOpenGL.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
   If (fHRC<>0) Then
      Message.Result:=1;
end;

procedure TBasicOpenGL.GetSelectList(X, Y: Integer;
  SelectMode: TSelectMode);
Var
   SelectArray  : Array[0..256] of TGLuint;
   Hits         : Integer;
   fviewport    : TVector4i;

    Procedure  ProcessHits;
      Var I,ArrayCount:Integer;
          aPtr:Pointer;

          Procedure ProcessHit;
            Var HitCount,I:Integer;
          Begin
            HitCount:=SelectArray[ArrayCount];
            Inc(ArrayCount);
            If HitCount=0 then exit;
            Inc(ArrayCount);//Z valu min
            Inc(ArrayCount);//Z Value Max
            For i:=1 to HitCount do
            Begin
              aPtr:=Ptr(SelectArray[ArrayCount]); Inc(ArrayCount);
              If (aPtr<>Nil) and
                 (TObject(aPtr) is TOpenGLObject) then
                Case SelectMode of
                   tsMouseSelect: TOpenGLObject(aPtr).Selected:=True;
                   tsWindowCull : TOpenGLObject(aPtr).ViewCulled:=False;
                end;//case
            end;//hitcount loop
          end;

      Begin
        ArrayCount:=0;
        For i:=1 to Hits do
            ProcessHit;
      end;

begin
  If height<=0 then exit;
  Hits:=0 ;
  FillChar (SelectArray[0],SizeOf(SelectArray),0);

  glSelectBuffer(256,@SelectArray[0]);
  glRenderMode(GL_Select);

  fviewport[0]:=0;
  fviewport[1]:=0;
  fviewport[2]:=Width;
  fviewport[3]:=Height;

  If (SelectMode= tsMouseSelect) then
  Begin
    glMatrixMode(GL_PROJECTION);
    glPushMatrix;
    glLoadIdentity;
    gluPickMatrix(X, Height-Y, 10, 10, fViewPort);
    gluperspective(fViewAngle,width/height,1,500)
  end;

  glInitNames;
  glLoadName(0);

  glMatrixMode(GL_MODELVIEW);

  If SelectMode=tsWindowCull then
     If fRootObject<>Nil then
        fRootObject.CullAllObjects(false);

  If fRootObject<>Nil then
     fRootObject.DoRender;

//get the hits data
  Hits:= glRenderMode(GL_Render);
//tidy up
  If (SelectMode= tsMouseSelect) then
  Begin
    glMatrixMode(GL_PROJECTION);
    glPopMatrix;
    glMatrixMode(GL_MODELVIEW);
  end;

  If SelectMode=tsMouseSelect then
      If FRootObject<>Nil then
         FRootObject.Selected:=False;

  If Hits>0 then
  Begin
    If SelectMode=tsWindowCull then
       If fRootObject<>Nil then
          fRootObject.CullAllObjects(True);
    ProcessHits;
  end;

  If Assigned(FOnUpdateTreeView) then
     FOnUpdateTreeView;
  Invalidate;
end;

procedure TBasicOpenGL.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  GetSelectList(X,Y,tsMouseSelect);
end;

constructor TBasicOpenGL.Create(Owner: TComponent);
begin
  inherited;
  fViewAngle:= 25;
end;

procedure TBasicOpenGL.SetViewAngle(const Value: Single);
begin
  fViewAngle := Value;
  If fViewAngle>179 then
     fViewAngle:=179 ;  // limit the angle to less than 180
  RenderWindow;
  CullView;
  If Assigned(FOnUpdateTreeView) then
     FOnUpdateTreeView;
end;

procedure TBasicOpenGL.CullView;
begin
  GetSelectList(0,0,tsWindowCull);
end;

procedure TBasicOpenGL.WMSize(var Message: TWMSize);
begin
  Inherited;
  If fHRC=0 then exit;
  CullView;
  If Assigned(FOnUpdateTreeView) then
     FOnUpdateTreeView;
end;

procedure TBasicOpenGL.WMSetFocus(var Message: TWMSetFocus);
begin
  Inherited;
  If fHRC=0 then exit;
  ActivateRenderingContext(fRenderDC,fHRC); //activate the session
end;

{ TOpenGLObject }
function TOpenGLObject.AddChild: TOpenGLObject;
begin
  Result:=TOpenGLObject.Create;
  Result.FParent:=self;
  FChildrenList.Add(Result);
end;

procedure TOpenGLObject.BuildTreeView(ATreeView: TTreeView;
                                      ParentNode: TTreeNode);
Var  Node:TTreeNode;
     i:Integer;
begin
  If aTreeView=Nil then exit;
  If ParentNode=nil then
    Node:=aTreeView.Items.AddObject( ParentNode,Text,self)
  else
    Node:=aTreeView.Items.AddChildObject( ParentNode,Text,self);
  If ChildCount>0 then
    For i:=0 to ChildCount-1 do
      Child[i].BuildTreeView(ATreeView, Node);
end;

constructor TOpenGLObject.Create;
begin
  FParent       :=nil;                //parent in the scene
  FChildrenList := TList.Create;       //holds all children
  FScale.X:=1;
  FScale.Y:=1;
  FScale.Z:=1;
  Inherited;
end;

procedure TOpenGLObject.CullAllObjects(Value:Boolean);
Var i:Integer;
begin
  FViewCulled:=Value;
  If ChildCount=0 then exit;
  For i:=0 to ChildCount-1 do
    child[i].CullAllObjects(Value);
end;

destructor TOpenGLObject.Destroy;
 Var I:Integer;
begin
  If (FChildrenList.Count>0) then
    For i:=0 to FChildrenList.count-1 do
    Begin
      TOpenGLObject(FChildrenList.Items[i]).Free;
    end;
  FChildrenList.Clear;
  FChildrenList.Free;
  inherited;
end;

procedure TOpenGLObject.DoRender;
 Var i:Integer;
begin
  If FViewCulled then exit;     // no need to render further
  glPushMatrix;                 //copy current matrix
  glTranslated(fTranslation.X,fTranslation.Y, fTranslation.Z);

  glRotated(fRotation.X,1,0,0);
  glRotated(fRotation.Y,0,1,0);
  glRotated(fRotation.Z,0,0,1);

  glPushMatrix;                 //copy current matrix
  glScaled(fScale.X,fScale.Y,fScale.Z);//only scale the local object

  glPushName(Integer(self));    //push Self as Object name/locator

  Case fMode of
    1: Begin
         glColor3fv(@glRed);
         glutSolidSphere(0.5,20,20);  //render as a sphere
       end;
    2: Begin
         glColor3fv(@glGreen);
         glutSolidCube(1);          //render as a cube
       end;
    3: Begin
         glColor3fv(@glBlue);
         glutSolidCylinder(0.5,1,10,10);   //render as a cylinder
       end;
  end; //case

  if FSelected then      // if the object tagged as selected then draw a bounding box
  Begin
    glColor3fv(@glGray);
    glutWireCube(1.2);
  end;

  glPopName;                  //pop name back of name stack
  glPopMatrix;                //restore the original matrix

  If FChildrenList.Count>0 then          //if child count>0 then render the children
  Begin
    For i:=0 to FChildrenList.count-1 do
        Child[i].DoRender;                       //recursive call down the tree
  end;
  glPopMatrix;                //restore the original matrix


end;

function TOpenGLObject.GetChild(Index: Integer): TOpenGLObject;
begin
  Result:=nil;
  If (Index<0) or
     (Index>= FChildrenList.count) then exit;
  Result:=TOpenGLObject(FChildrenList.Items[index]);
end;

function TOpenGLObject.GetChildrenCount: Integer;
begin
  Result:= FChildrenList.count;
end;

function TOpenGLObject.getText: String;
begin
  Result:=fText;
  If fViewCulled then
     Result:=Result+' (Not in View)';
  If fSelected then
  Result:=Result+' (Selected)';
end;

procedure TOpenGLObject.setSelected(const Value: Boolean);
 Var i:Integer;
begin
  //selection is passed down the tree
  FSelected := Value;
  If ChildCount>0 then
     for i:=0 to ChildCount-1 do
       Child[i].Selected:= FSelected;
end;

procedure TOpenGLObject.settext(const Value: String);
begin
  fText:=Value;
end;

procedure TOpenGLObject.setViewCulled(const Value: Boolean);
begin
//  View culling if false is passed back up the tree
  FViewCulled := Value;
  If fParent=nil then exit;
  If fViewCulled then exit;
  FParent.ViewCulled:=false;
end;

end.