Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue42/opengl/glAbsWin.pas

Pascal/Delphi Source File | 1998-11-26 | 32.9 KB | 904 lines

unit glAbsWin;
{============================================================}
{ Unit Title -  Abstract OpenGL Window                            }
{                                                            }
{ Codemaster  -      ohn Hutchings                             }
{   Date      -      10/6/98                                 }
{  DeBugged   -               }
{                                }
{============================================================}

{$V+,X+,F+,B-}
{$IFDEF MinSize} {$S-,L-,R-,Q-,D-} {$ENDIF}

{===============================================================================

PURPOSE

   Unit contains all the basic GL windows functionality.
   Should be considered as an abstract class and not used

METHOD

COMPILER DIRECTIVES

  DEBUG     adds addition tests for valid data and type safe assigns
  MINSIZE   limits debug and symbol info

GLOBALS

  Classes
  Exceptions
  Variables

  Procedures

EXCEPTIONS


NOTES


===============================================================================}

interface
{$W+}//set stack frames on as this seemms to help win95 access error
uses
  Windows, Messages, SysUtils, Classes, Graphics, MmSystem,
  Controls, Forms, Dialogs, stdctrls,comctrls,opengl, glFuncs;

 Type
   // handle hi -res bit map image
   TAbstractOpenGLBitmap = class(TObject)
   Protected
    faPPfd                 : TPixelFormatDescriptor;
    fPixelFormat           : LongInt;
    fRenderDC              : HDC;
    fGLPalette             : HPalette;
    fHRC                   : HGLRC;
    fBitMap                : TBitMap;
    fAllOK                 : Boolean;
    fBackColor             : GLBackground;

    Procedure GLStartUp;                    Virtual;
    // Startn up the GLSession
    Procedure GLShutDown;                   Virtual;
    // Shut down a session
    Function GetCanvas:TCanvas;


    Function SetUpPixelFormat:Boolean;       Virtual;
    //Set up the pixel formatfor the session}

    Public
     constructor CreateInit(aBitMap:tBitMap;aBack:GLBackground);
     destructor Destroy; override;

     Property GLRC    : HGLRC Read fHRC;
     property RenderDC: HDC   Read fRenderDC;
     Property GLCanvas: TCanvas Read GetCanvas;
     Property ViewMap : TBitMap Read fBitMap;
     Property GLSessionOK:Boolean Read fAllOk;
  end;

 TAbstractOpenGLControl = Class(TComponent)
   Private
    FWindowHandle          : HWnd;
    faPPfd                 : TPixelFormatDescriptor;
    fPixelFormat           : LongInt;
    fHRC                   : HGLRC;
  // pixel Support flags
   (*
    pfd_Win_Draw,
    fpfd_BitMap,
    fpfd_Accel,
    fpfdDoubleBuf,
    fpfd_Swap_Copy,
    fpfd_swap_exhg,
    fpfd_GL_sup,
    fpfd_GDI_sup,
    fpfd_Stereo            : Boolean;
     *)
    procedure WndProc(var Msg: TMessage);

    Procedure SetRenderContext(aVal:HGLRC);
    Procedure SetPFormat(aVal:LongInt);
    Procedure SetPixelDescription(aVal:TPixelFormatDescriptor);

   Public
    constructor Create(AOwner: TComponent);Override;
    destructor Destroy;                             Override;

    Procedure SetUpHandle;

    Property RenderDC: HGLRC read fHRC Write SetRenderContext;
    Property PixelDescription:TPixelFormatDescriptor Read faPPfd Write SetPixelDescription;
    Property PixelFormat : LongInt read fPixelFormat Write SetPFormat;

  end;

  TAbstractOpenGL = class(TWinControl)
   Private
    fGLLock                : TRTLCriticalSection;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;

   Protected
    faPPfd                 : TPixelFormatDescriptor;
    fPixelFormat           : LongInt;
    fRenderDC              : HDC;
    fGLPalette             : HPalette;
    fHRC                   : HGLRC;
    fGMF                   : tGMF;
    // bitmap size=0 when drawing to screen

    fShareGL               : TAbstractOpenGL;
    fErrorList             : TStringList;
    // holds a list of all errors from the last get error call
    //use display list of this GLWin

    fDoneGLSetup,      // used to tag initial setup been done
    fValidBuffer,          //valid buffer for copying to screen rather than repaint
    fRebuildNeeded,        //need to rebuild ie rerender
    fGrabFocus,            // Grab the focus if set to true Default=true
    fRepaintNeeded,        // only need to repaint ie swap buffer if valid
    fCloseGL,               // close the GL session if not focused
  // pixel Support flags
    pfd_Win_Draw,
    fpfd_BitMap,
    fpfd_Accel,
    fpfdDoubleBuf,
    fpfd_Swap_Copy,
    fpfd_swap_exhg,
    fpfd_GL_sup,
    fpfd_GDI_sup,
    fpfd_Stereo,
    fGDIGeneric           // WARNING this needs to be true for safe GDI calls
    //there is a risk if this is false that GDI calls via canvas will fail dramatically
             : Boolean;


    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMSetFocus); message WM_KILLFOCUS;

    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;

 //Override basic startup and shut down
    procedure CreateParams(var Params: TCreateParams);           Override;
// set up the basic window parameters
    procedure DestroyWindowHandle;                               Override;
// close down the GL session

   Procedure GLStartUp;                    Virtual;
  // Startn up the GLSession
   Procedure GLShutDown;                   Virtual;
  // Shut down a session

    Procedure DoMoveTidyUp;                 Virtual;
    // If pan zoom etc then tidy up the possible cursor draw
    Function SetUpPixelFormat:Boolean;       Virtual;
    //Set up the pixel formatfor the session}
    Procedure GLLock;
    // Lock the current procedure
    Procedure GLUnLock;
    // Unlock the current procedure
    Procedure SetGrabFocus(Val:Boolean);
    // force focus to this window
    Procedure setShareGLWin(Val: TAbstractOpenGL);
    //TIDY UP - this may not be needed
    Procedure SetGenericGDI(AVal:Boolean);
  // set the GDI use state

    Procedure SaveState(aState:GLSaveState);
    // save the current state before mods restore state will reset
    Procedure RestoreState;
    // return the last state


  Public
    constructor Create(AOwner: TComponent); Override;
    destructor Destroy;                     override;

    procedure Repaint;                      Override;
    {Modifies the standard paint to now handle the OpenGL drawing}
    procedure InvalidateRectangle(Rect:TRect;DoRepaint:Boolean);
    // will invalidate only the given rectangle area of the control
   Function EnableGL:Boolean;
   // Ensure that this window has the active session

   Procedure DisableGL;
   //Turn off the GL Session

   Function IsGLActive:Boolean;
    {Is the current }

   Function  GetError:Boolean;
    // run error checking on GL session
   Procedure ClearError;
    // empty the error list
  { Procedure PrintWindow(aPrinter:tPrinter);  Virtual;}
   //Handle the printing of the window to a Printer

   Property GLRenderDC :HDC         Read fRenderDC;
   Property GLContext  :HGLRC       Read fHRC;
   Property PixelFormat:LongInt     Read fPixelFormat;
   Property PixelData  :TPixelFormatDescriptor read faPPfd;
   Property ErrorList  :TStringList read fErrorList;
 //publish later
   Property GrabFocus:Boolean Read fGrabFocus Write SetGrabFocus;
   Property ShareGL  :TAbstractOpenGL Read fShareGL Write setShareGLWin;
   Property GenericGDI :Boolean     Read fGDIGeneric write SetGenericGDI;

  end;
(*************************************************************)
                          implementation
(*************************************************************)
(*************************************************************)
var
  GLUtilWindowClass: TWndClass = (
    style: CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS + CS_OWNDC;
    lpfnWndProc: @DefWindowProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'GLUtilWindow');

(*************************************************************)
(*************************************************************)
function GLAllocateHWnd(parentWin:HWND;Method: TWndMethod): HWND;
var
  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  Result:=0;
  If ParentWin=0 then exit;
  GLUtilWindowClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance, GLUtilWindowClass.lpszClassName,TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(GLUtilWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(GLUtilWindowClass);
  end;

  Result := CreateWindowEx(0, GLUtilWindowClass.lpszClassName,
    '', WS_BORDER or WS_CHILD or WS_CLIPCHILDREN or WS_CLIPSIBLINGS , 0, 0, 10, 10, parentWin, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

(*************************************************************)
(*************************************************************)
procedure GLDeallocateHWnd(Wnd: HWND);
var
  Instance: Pointer;
begin
  If Wnd=0 then exit;
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  DestroyWindow(Wnd);
  if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
end;
(*************************************************************)
constructor TAbstractOpenGLControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;
(*************************************************************)

destructor TAbstractOpenGLControl.Destroy;
begin
  GLDeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;
(*************************************************************)
 Procedure TAbstractOpenGLControl.SetUpHandle;
  Begin
   If (FWindowHandle=0) and
      Assigned(Application) and
      Assigned(Application.MainForm) and
      (Application.MainForm.Handle<>0) then FWindowHandle := GLAllocateHWnd(Application.mainform.Handle,WndProc);
  end;
(*************************************************************)
  procedure TAbstractOpenGLControl.WndProc(var Msg: TMessage);
  begin
   With Msg do
     Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  end;
(*************************************************************)
  Procedure TAbstractOpenGLControl.SetRenderContext(aVal:HGLRC);
    Begin

    end;
(*************************************************************)
  Procedure TAbstractOpenGLControl.SetPFormat(aVal:LongInt);
    Begin
    end;
(*************************************************************)
Procedure TAbstractOpenGLControl.SetPixelDescription(aVal:TPixelFormatDescriptor);
    Begin
    end;
(*************************************************************)
(*************************************************************)
constructor TAbstractOpenGL.Create(AOwner: TComponent);
Begin
  DoubleBuffered:=False;
  Inherited Create(aOwner);
  TabStop:=True;
  ShowHint:=true;
  fErrorList  := TStringList.Create;
  fShareGL    := nil;
  fValidBuffer:= False;        //valid buffer for copying to screen rather than repaint
  fRebuildNeeded:=True;        //need to rebuild ie rerender
  fRepaintNeeded:=True;        // only need to repaint ie swap buffer if valid
  fDoneGLSetup:=False;

  InitializeCriticalSection(fGLLock);
end;
(*************************************************************)
procedure TAbstractOpenGL.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);    { call the inherited first }
  Params.Style := WS_child + WS_CLIPCHILDREN + WS_CLIPSIBLINGS + ws_border;
  //set up the windows style flags MUST have ClipChildren and clipsiblings
  Params.WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS + CS_OWNDC;
  // set up the windowclass style MUST have VRedraw, HRedraw and OwnDC
end;
(******* ******************************************************)
Procedure TAbstractOpenGL.GLStartUp;
  // Startn up the GLSession
  Begin
     fRenderDC:=GetDC(handle);
 //MUST use the current window handle and will hold onto it
     If fRenderDC=0 then Exit;
 // Set up the pixel format for the window}
     SetUpPixelFormat;
 // Create the Render Context}
     fHRC:=wglCreateContext(fRenderDC);
     If fHRC=0 then  Exit;
     EnableGL;
     // set this session as current
  // if the first GL context then set as primary
     if assigned(fShareGL) then wglShareLists(fShareGL.fHRC,fHRC);
  // check for GLErrors
     GetError;
  end;
(******* ******************************************************)
destructor TAbstractOpenGL.Destroy;
Begin
  DeleteCriticalSection(FGLLock);
  fErrorList.Free;
  Inherited Destroy;
end;
(******* ******************************************************)
Procedure TAbstractOpenGL.GLShutDown;
  // Shut down a GL session
  Begin
     If (wglGetCurrentContext=fHRC)then  wglMakeCurrent(0,0);
     If fHRC<>0 then
      Begin
       wglDeleteContext(fHRC);
       fHRC:=0;
      end;
     If fGLPalette<>0 then DeleteObject(fGLPalette);
     fGLPalette:=0;
     If fRenderDC<>0 then ReleaseDC(handle,fRenderDC);
     //no real need to do this for pri vate DC
     fRenderDC:=0;
  end;
(*************************************************************)
 Procedure TAbstractOpenGL.DoMoveTidyUp;
    // If pan zoom etc then tidy up the possible cursor draw
  Begin    end;
(******* ******************************************************)
Function TAbstractOpenGL.SetUpPixelFormat:Boolean;
 Var
  ECode        : DWord;
{ If necessary, creates a 3-3-2 palette for the device context listed.}
          Procedure GetOpenGLPalette;
          Var
            pPal:^TLogPalette;        {Pointer to memory for logical palette}
            nColors:Integer;        { Number of entries in palette}
            i      :Integer;               { Counting variable }
            RedRange,GreenRange,BlueRange:BYTE;{ Range for each color entry (7,7,and 3)}
            MultVal:Byte;
            aVal:Byte;
          Begin
            { Get the pixel format index and retrieve the pixel format description}
            DescribePixelFormat(frenderDC, fPixelFormat, sizeof(TPIXELFORMATDESCRIPTOR), faPPfd);
             { Does this pixel format require a palette?  If not, do not create a}
             { palette and just return NULL}
            if not(PFD_NEED_PALETTE = (faPPfd.dwFlags and PFD_NEED_PALETTE)) then exit;
             { Number of entries in palette.  8 bits yeilds 256 entries}
            nColors := 1 shl faPPfd.cColorbits{1 << pfd.cColorBits};
          { Allocate space for a logical palette structure plus all the palette entries}
            GetMem(pPal,SizeOf(TLogPalette)+nColors*sizeOf(TpaletteEntry));
          { Fill in palette header}
            pPal^.palVersion := $300;        { Windows 3.0}
            pPal^.palNumEntries := nColors; { table size }

                  { Build mask of all 1's.  This creates a number represented by having
                  { the low order x bits set, where x = pfd.cRedBits, pfd.cGreenBits, and
                  { pfd.cBlueBits. }
            RedRange   := (1 shl faPPfd.cRedBits)-1{(1 << pfd.cRedBits) -1};
            GreenRange :=( 1 shl faPPfd.cGreenBits)-1 {(1 << pfd.cGreenBits) - 1};
            BlueRange  := (1 shl faPPfd.cBlueBits)-1{(1 << pfd.cBlueBits) -1};
            MultVal:=255;
                  { Loop through all the palette entries}
          {$R-}
            For i:=0 to nColors-1 do
              With pPal^ do Begin
                AVal:=   (i shr faPPfd.cRedShift) and RedRange;
                aVal:=   aVal*MultVal div RedRange;
                palPalEntry[i].peRed:=aVal;
                aVal:= (i shr faPPfd.cGreenshift) and GreenRange;
                aVal:= aVal*MultVal div GreenRange;
                palPalEntry[i].peGreen:=aVal;
                aVal:=  (i shr faPPfd.cBlueShift) and BlueRange;
                aVal:=  aVal*MultVal div BlueRange;
                palPalEntry[i].peBlue:=aVal;
                palPalEntry[i].peFlags := 0;
               end;
                  { Create the palette}
          {R+}
            fGLPalette := CreatePalette(pPal^);

                  { Free the memory used for the logical palette structure}
            FreeMem(pPal,SizeOf(TLogPalette)+nColors*sizeOf(TpaletteEntry));
          end;
Begin
  Result:=False;
  fGLPalette:=0;
  If fRenderDC=0 then exit;
  FillChar(fAPPFD,SizeOf(fAPPFD),0);
  With fAPPFD do
  Begin
    nSize:=SizeOf(fAPPFD);
    nVersion:=1;                     //Must Be
    dwFlags:=(PFD_Draw_To_Window or  //rendering to a window
              Pfd_Support_OpenGL or  //supporting OpenGL
              Pfd_Stereo or          //request stereo buffers if hardware supports it(not often)
              pfd_Generic_Accelerated or //use accelerated if available
              pfd_swap_copy or      //swapcopy will swap in a buffer but keep a copy
              PFD_DOUBLEBUFFER) ;   //want double buffering for smooth animation
    iPixelType:=PFD_TYPE_RGBA;      //see current settings in GLFuncs
    cColorBits:=pix_ColorBits;      //see current settings in GLFuncs
    cDepthBits:=pix_DepthBits;      //see current settings in GLFuncs
    cStencilBits:=pix_StencilBits;  //see current settings in GLFuncs
    cAccumBits:=pix_AccumBits;      //see current settings in GLFuncs
    cAlphaBits:=0;                  //no choice in Windows
    cAuxBuffers:=0;                 //no choice in Windows
    iLayerType:=PFD_Main_Plane;     //no choice in Windows
  end;
  fPixelFormat:=ChoosePixelFormat(fRenderDC,@fAPPFD); // find the closest fit to the requested
  Result:=SetPixelFormat(fRenderDC,fPixelFormat,@faPPFD); //set the pixel format
  DescribePixelFormat(frenderDC, fPixelFormat, sizeof(TPIXELFORMATDESCRIPTOR), faPPfd);
  fPixelFormat:=GetPixelFormat(fRenderDC);
  fGDIGeneric:=False;
// set up identifier flags
  pfd_Win_Draw  := (PFD_Draw_To_Window = (faPPFD.dwFlags and PFD_Draw_To_Window));
  fpfd_BitMap   := (PFD_Draw_To_Bitmap = (faPPFD.dwFlags and PFD_Draw_To_Bitmap));
  fpfd_Accel    := (PFD_GENERIC_ACCELERATED = (faPPFD.dwFlags and PFD_GENERIC_ACCELERATED));
  fpfdDoubleBuf := (PFD_DOUBLEBUFFER = (faPPFD.dwFlags and PFD_DOUBLEBUFFER));
  fpfd_Swap_Copy:= (pfd_swap_copy = (faPPFD.dwFlags and pfd_swap_copy));
  fpfd_swap_exhg:= (pfd_swap_exchange = (faPPFD.dwFlags and pfd_swap_exchange));
  fpfd_GL_sup   := (Pfd_Support_OpenGL = (faPPFD.dwFlags and Pfd_Support_OpenGL));
  fpfd_GDI_sup  := (Pfd_Support_GDI = (faPPFD.dwFlags and Pfd_Support_GDI));
  fpfd_Stereo   := (PFD_STEREO = (faPPFD.dwFlags and PFD_STEREO));
  If Result then
   Begin
      { Get the pixel format index and retrieve the pixel format description}
       if (PFD_NEED_PALETTE = (faPPfd.dwFlags and PFD_NEED_PALETTE)) then
       Begin
         { Go ahead and select and realize the palette for this device context}
         If fGLPalette=0 then GetOpenGLPalette;
         SelectPalette(fRenderDC,fGLPalette,FALSE);
         RealizePalette(fRenderDC);
       end;
   end else
    Begin
     ECode:=GetLastError;
     If ECode>0 then
        MessageDlg('Problem with Set pixel format',mtInformation,[mbOk], 0);
    end;
end;
(*************************************************************)
Procedure TAbstractOpenGL.ClearError;
  Begin
    fErrorList.Clear;
  end;
(************************************************************)
Function TAbstractOpenGL.GetError:Boolean;
var
  glError: glEnum;
  s: string;
  Counter:LongInt;
begin
  Result:=False;
  If not EnableGL then exit;
  Counter:=0;
  Repeat
    glError:= glGetError;
    case glError of
      GL_INVALID_ENUM:      s:= 'GL_INVALID_ENUM';
      GL_INVALID_VALUE:     s:= 'GL_INVALID_VALUE';
      GL_INVALID_OPERATION: s:= 'GL_INVALID_OPERATION';
      GL_STACK_OVERFLOW:    s:= 'GL_STACK_OVERFLOW';
      GL_STACK_UNDERFLOW:   s:= 'GL_STACK_UNDERFLOW';
      GL_OUT_OF_MEMORY:     s:= 'GL_OUT_OF_MEMORY';
    end;
    If Length(s)>0 then
      fErrorList.Add(s);
    Inc(Counter);
  Until  (glError<>GL_NO_ERROR) or (Counter=1000)or (Length(s)=0);
  Result:=(counter>1);
  {$IFDEF ERRORDEBUG}
  If Result then messagedlg('Error here',mtinformation,[mbok],0);
  {$ENDIF}
end;
(*************************************************************)
procedure TAbstractOpenGL.WMPaint(var Message: TWMPaint);
begin
  ControlState:= ControlState + [csCustomPaint];
  inherited;
  ControlState:= ControlState - [csCustomPaint];
end;
(*************************************************************)
procedure TAbstractOpenGL.DestroyWindowHandle;
Begin
  GLShutDown;
  //close the GL render session
  Inherited DestroyWindowHandle;
end;
(*************************************************************)
Procedure TAbstractOpenGL.GLLock;
   Begin
     EnterCriticalSection(fGLLock);
   end;
(*************************************************************)
Procedure TAbstractOpenGL.GLUnLock;
  begin
    LeaveCriticalSection(fGLLock);
 end;
(******* ******************************************************)
procedure TAbstractOpenGL.Repaint;
 Var aRect,WinRect:TRect;
     aErase,UpdateB:Boolean;
Begin
  fValidBuffer    :=False;
  fRepaintNeeded  :=true;
  aErase:=False;
 // does a small area need redrawing
  UpdateB:=GetUpdateRect(Handle,aRect,aErase);
  SetRectEmpty(WinRect);
  With WinRect do
   Begin
    Right:=Width;Bottom:=Height;
   end;

  fRebuildNeeded  :=True;

  If not EqualRect(aRect,WinRect)and UpDateB then
    Begin
     // only a small area needs redrawing not finished
     {glScissor}
     Invalidate;
     update;
    end else
    Begin
      Invalidate;
      Update;
    end;
end;
(*************************************************************)
procedure TAbstractOpenGL.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;
(*************************************************************)
procedure TAbstractOpenGL.WMSetFocus(var Message: TWMSetFocus);
 begin
  inherited;
  If fCloseGL and (fHRC=0) then GLStartUp;
  EnableGL;
  RePaint;
 end;
(*************************************************************)
procedure TAbstractOpenGL.WMKillFocus(var Message: TWMSetFocus);
begin
  inherited;
  DoMoveTidyUp;
  RePaint;
  DisableGL;
  If fCloseGL then GLShutDown;
end;
(*************************************************************)
procedure TAbstractOpenGL.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  If canFocus and not focused and fGrabFocus then SetFocus;
  // used to automatically grab the focus if the mouse passes over
end;
(*************************************************************)
procedure TAbstractOpenGL.CMShowingChanged(var Message: TMessage);
begin
  Inherited;
  if not fDoneGLSetup then
    Begin
      GLStartUp;
      fValidBuffer:=False;
      fRebuildNeeded:=True;        //need to rebuild ie rerender
      fRepaintNeeded:=True;        // only need to repaint ie swap buffer if valid
      fDoneGLSetup:=True;
    end;
end;
(*************************************************************)
 procedure TAbstractOpenGL.InvalidateRectangle(Rect:TRect;DoRepaint:Boolean);
    // will invalidate only the given rectangle area of the control will concatinate with
    // existing update if already there
 Var CRect,OutRect:tRect;
     aErase:Boolean;
 Begin
  CopyRect(OutRect,Rect);
  aErase:=False;
  If GetUpdateRect(Handle,CRect,aErase) then IntersectRect(OutRect,CRect,Rect);
  if HandleAllocated then
   begin
    if Parent <> nil then Parent.Perform(CM_INVALIDATE, 1, 0);
    InvalidateRect(Handle, @OutRect, not (csOpaque in ControlStyle));
    If DoRepaint then Repaint;
   end;
 end;
(*************************************************************)
Function TAbstractOpenGL.EnableGL:Boolean;
{Ensures that the windows DC and RC and active}
 var TempRC:HGLRC;
     TempDC:HDC;
 Begin
  Result:=False;
// normal window
  If (fRenderDC=0) or (fHRC=0) then exit;
  TempRC:= wglGetCurrentContext;
  TempDC:= wglGetCurrentDC;
  If (TempRC<>fHRC) or (TempDC<>fRenderDC) then
     Result:=wglMakeCurrent(fRenderDC,fHRC) else
     Result:=True;
 {$IFDEF ERRORDEBUG}
  If not Result then
    MessageDlg('Problem with OpenGL Session',mtInformation,[mbOk],0);
 {$ENDIF}
 end;
(*************************************************************)
 Procedure TAbstractOpenGL.DisableGL;
   //Turn off the GL Session
   Begin
    If (wglGetCurrentContext=fHRC)then wglMakeCurrent(0,0);
   end;
(*************************************************************)
Function TAbstractOpenGL.IsGLActive:Boolean;
    {Is the current }
  Begin
    Result:=False;
    If (fRenderDC=0) or (fHRC=0) then exit;
    Result:= (wglGetCurrentContext=fHRC) AND (wglGetCurrentDC=fRenderDC);
  end;
(*************************************************************)
 Procedure TAbstractOpenGL.SetGrabFocus(Val:Boolean);
   Begin
     fGrabFocus:=Val;
   end;
(*************************************************************)
Procedure TAbstractOpenGL.setShareGLWin(Val: TAbstractOpenGL);
  Begin
     If Val = fShareGL then exit;
     fShareGL:=Val;
     If fHRC=0 then exit;
     GLShutDown;
     GLStartUp;
  end;
(******************************************************)
 Procedure TAbstractOpenGL.SaveState(aState:GLSaveState);
    // save the current state before mods restore state will reset
  Begin
    Case aState of
      stAll      :glPushAttrib(GL_ALL_ATTRIB_BITS);
      stDrawing  :glPushAttrib(GL_ENABLE_BIT or GL_LINE_BIT or GL_POINT_BIT or GL_POLYGON_BIT
                                or GL_CURRENT_BIT or GL_HINT_BIT or GL_SCISSOR_BIT);
      stLighting :glPushAttrib(GL_LIGHTING_BIT);
      stTexturing:glPushAttrib(GL_TEXTURe_BIT);
    end;
  end;
(******************************************************)
 Procedure TAbstractOpenGL.RestoreState;
      Begin
        glPopAttrib;
      end;
(*************************************************************)
 Procedure TAbstractOpenGL.SetGenericGDI(AVal:Boolean);
  // set the GDI use state
  Begin
    If aVal=fGDIGeneric then exit;
    fGDIGeneric:=aVal;
    Repaint;
  end;
(******* ******************************************************)
(*************************************************************)
constructor TAbstractOpenGLBitmap.CreateInit(aBitMap:tBitMap;aBack:GLBackground);
Begin
  Inherited Create;
  fBitMap:=aBitMap;
  fBackColor:=aBack;
  GLStartUp;
end;
(*************************************************************)
Destructor TAbstractOpenGLBitmap.Destroy;
Begin
  GLShutDown;
  Inherited Destroy;
end;
(******* ******************************************************)
Procedure TAbstractOpenGLBitmap.GLStartUp;
 Var  CompDC:HDC;
      TempBM:hBitMap;
  // Startn up the GLSession
  Begin
    iF Not Assigned(fBitMap) then exit;
    fRenderDC:=fBitMap.Canvas.Handle;
    fHRC:=0;
    If SetUpPixelFormat then fHRC:=wglCreateContext(fRenderDC)
     else
     Begin
       CompDC:=CreateCompatibleDC(0);
       TempBM:=CreateCompatibleBitMap(CompDC,fBitMap.Width,fBitMap.Height);
       If (CompDC<>0) and (TempBM<>0) then
         SelectObject(CompDC,TempBM);
       fBitmap.Handle:=TempBM;
       fRenderDC:=CompDC;
       If SetUpPixelFormat then fHRC:=wglCreateContext(fRenderDC)
        else exit;
     end;
    If fHRC<>0 then
     If wglMakeCurrent(fRenderDC,fHRC) then
      Begin
          If fBackColor=glWhiteBkgd then
            glClearColor(1.0,1.0,1.0,1.0)
          else
            glClearColor(0.0,0.0,0.0,1.0);
          glClearIndex(0.0);
          glClearDepth(1.0);
          glPixelStorei(GL_Unpack_Alignment,1);
            //specific for windows and byte alignment
          glDisable(GL_SCISSOR_TEST);
          glDisable(GL_BLEND);
          glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
          glfinish;

          fAllOK:=True;
     end;
  end;
(******* ******************************************************)
Procedure TAbstractOpenGLBitmap.GLShutDown;
  // Shut down a session
  Begin
     If (wglGetCurrentContext=fHRC) then  wglMakeCurrent(fRenderDC,0);
     // if the current Rendering context is this one then make NOT current
     If fHRC<>0 then
       Begin
         wglDeleteContext(fHRC);
     // delete the Rendering Context
         fHRC:=0;
       end;
     If fGLPalette<>0 then
       Begin
         DeleteObject(fGLPalette);
     // delete the Palette if used
         fGLPalette:=0;
       end;
  end;
(******* ******************************************************)
Function TAbstractOpenGLBitmap.SetUpPixelFormat:Boolean;

{ If necessary, creates a 3-3-2 palette for the device context listed.}
          Procedure GetOpenGLPalette;
          Var
            pPal:^TLogPalette;        {Pointer to memory for logical palette}
            nColors:Integer;        { Number of entries in palette}
            i      :Integer;               { Counting variable }
            RedRange,GreenRange,BlueRange:BYTE;{ Range for each color entry (7,7,and 3)}
            MultVal:Byte;
            aVal:Byte;
          Begin
            { Get the pixel format index and retrieve the pixel format description}
            DescribePixelFormat(frenderDC, fPixelFormat, sizeof(TPIXELFORMATDESCRIPTOR), faPPfd);
             { Does this pixel format require a palette?  If not, do not create a}
             { palette and just return NULL}
            if not(PFD_NEED_PALETTE = (faPPfd.dwFlags and PFD_NEED_PALETTE)) then exit;
             { Number of entries in palette.  8 bits yeilds 256 entries}
            nColors := 1 shl faPPfd.cColorbits{1 << pfd.cColorBits};
          { Allocate space for a logical palette structure plus all the palette entries}
            GetMem(pPal,SizeOf(TLogPalette)+nColors*sizeOf(TpaletteEntry));
          { Fill in palette header}
            pPal^.palVersion := $300;        { Windows 3.0}
            pPal^.palNumEntries := nColors; { table size }

                  { Build mask of all 1's.  This creates a number represented by having
                  { the low order x bits set, where x = pfd.cRedBits, pfd.cGreenBits, and
                  { pfd.cBlueBits. }
            RedRange   := (1 shl faPPfd.cRedBits)-1{(1 << pfd.cRedBits) -1};
            GreenRange :=( 1 shl faPPfd.cGreenBits)-1 {(1 << pfd.cGreenBits) - 1};
            BlueRange  := (1 shl faPPfd.cBlueBits)-1{(1 << pfd.cBlueBits) -1};
            MultVal:=255;
                  { Loop through all the palette entries}
          {$R-}
            For i:=0 to nColors-1 do
              With pPal^ do Begin
                AVal:=   (i shr faPPfd.cRedShift) and RedRange;
                aVal:=   aVal*MultVal div RedRange;
                palPalEntry[i].peRed:=aVal;
                aVal:= (i shr faPPfd.cGreenshift) and GreenRange;
                aVal:= aVal*MultVal div GreenRange;
                palPalEntry[i].peGreen:=aVal;
                aVal:=  (i shr faPPfd.cBlueShift) and BlueRange;
                aVal:=  aVal*MultVal div BlueRange;
                palPalEntry[i].peBlue:=aVal;
                palPalEntry[i].peFlags := 0;
               end;
                  { Create the palette}
          {R+}
            fGLPalette := CreatePalette(pPal^);

                  { Free the memory used for the logical palette structure}
            FreeMem(pPal,SizeOf(TLogPalette)+nColors*sizeOf(TpaletteEntry));
          end;
Begin
  Result:=False;
  fGLPalette:=0;
  If fRenderDC=0 then exit;
  FillChar(fAPPFD,SizeOf(fAPPFD),0);//set values to zero
  With fAPPFD do
  Begin
    nSize:=SizeOf(fAPPFD);
    nVersion:=1;
    dwFlags:=(PFD_Draw_To_Window or
              PFD_Draw_To_BitMap or
              PFD_SUPPORT_GDI or
              Pfd_Support_OpenGL);
    iPixelType:=PFD_TYPE_RGBA;
    cColorBits:=24;  //24 bit color for bitmaps
    cDepthBits:=16;
    cStencilBits:=1;
    cAccumBits:=0;
    cAlphaBits:=0;
    cAuxBuffers:=0;
    iLayerType:=PFD_Main_Plane;
  end;
  fPixelFormat:=ChoosePixelFormat(fRenderDC,@fAPPFD);
  Result:=SetPixelFormat(fRenderDC,fPixelFormat,@faPPFD);
  fPixelFormat:=GetPixelFormat(fRenderDC);
  If Result then
   Begin
      { Get the pixel format index and retrieve the pixel format description}
       if (PFD_NEED_PALETTE = (faPPfd.dwFlags and PFD_NEED_PALETTE)) then
       Begin
         { Go ahead and select and realize the palette for this device context}
         If fGLPalette=0 then GetOpenGLPalette;
         SelectPalette(fRenderDC,fGLPalette,FALSE);
         RealizePalette(fRenderDC);
       end;
     //  if (PFD_NEED_PALETTE = (faPPfd.dwFlags and INSTALLABLE_DRIVER_TYPE_MASK)) then
   end;
  end;
(*************************************************************)
 Function TAbstractOpenGLBitmap.GetCanvas:TCanvas;
  Begin
    Result:=fBitMap.Canvas;
  end;
(*************************************************************)
(*************************************************************)

 end.