[Glxtreem-commits] GLXtreem/Source GLXDraws.pas,1.2,1.3 GLXNotification.pas,1.1,1.2 GLXPrimitives.pa

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/glxtreem/GLXtreem/Source
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12511/Source

Modified Files:
	GLXDraws.pas GLXNotification.pas GLXPrimitives.pas 
	GLXTexture.pas GLXTimer.pas 
Log Message:
Added help context and various other changes

Index: GLXDraws.pas
===================================================================
RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXDraws.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** GLXDraws.pas	11 Mar 2004 01:16:53 -0000	1.2
--- GLXDraws.pas	12 Mar 2004 07:31:20 -0000	1.3
***************
*** 3,7 ****
  //      GLXTreem                                                              //
  //                                                                            //
! //      Date      : 2004-03- 08                                               //
  //                                                                            //
  //      The contents of this file are used with permission, subject to        //
--- 3,7 ----
  //      GLXTreem                                                              //
  //                                                                            //
! //      Date      : 2004-03-08                                                //
  //                                                                            //
  //      The contents of this file are used with permission, subject to        //
***************
*** 22,26 ****
    @author(Andreas Lago: an...@li...)
    @created(Mar 8, 2004)
!   @lastmod(Mar 8, 2004)
  }

--- 22,26 ----
    @author(Andreas Lago: an...@li...)
    @created(Mar 8, 2004)
!   @lastmod(Mar 12, 2004)
  }

***************
*** 33,37 ****
    Windows, Forms, Classes, Controls, Messages, Graphics, Sysutils,

!   GLXCamera, GLXTimer, GLXScreens,

    dglOpenGL;
--- 33,37 ----
    Windows, Forms, Classes, Controls, Messages, Graphics, Sysutils,

!   GLXCamera, GLXTimer, GLXScreens, GLXNotification,

    dglOpenGL;
***************
*** 39,44 ****

  //------------------------------------------------------------------------------
! {@exclude}
! Type TGLXDrawOption   = (doInitialize, doFullScreen, doAutosize);
  //------------------------------------------------------------------------------
  {@exclude}
--- 39,53 ----

  //------------------------------------------------------------------------------
! { Options for the glxdraw.<br><br>Can be any of the following values.<br><br> }
! Type TGLXDrawOption   = (
!   { Automaticcaly initialize renderer on program start. }
!   doInitialize,
!   { Fullscreen is used when next call to SetScreenMode. }
!   doFullScreen,
!   { Automatically resize the surface size when the component is resized. }
!   doAutosize
!   );
! 
! 
  //------------------------------------------------------------------------------
  {@exclude}
***************
*** 118,135 ****
      procedure SetStencilBits(const Value: Integer);
      procedure SetZBits      (const Value: Integer);
-   protected
-     {@exclude}
-     Procedure UpdateOpenGL;
    public
      {@exclude}
      Constructor Create(AOwner: TObject);
    published

!     property ColorBits          : Integer      read fColorBits          write SetColorBits;
!     property ZBits              : Integer      read fZBits              write SetZBits;
!     property StencilBits        : Integer      read fStencilBits        write SetStencilBits;
!     property AccumBits          : Integer      read fAccumBits          write SetAccumBits;
!     property AuxBuffers         : Integer      read fAuxBuffers         write SetAuxBuffers;
! 
      { Specifies if the scene is to be rendered using depth testing. }
      property doDepthTest   : Boolean      read FdoDepthTest     write SetDepthTest;
--- 127,148 ----
      procedure SetStencilBits(const Value: Integer);
      procedure SetZBits      (const Value: Integer);
    public
      {@exclude}
      Constructor Create(AOwner: TObject);
+     {@ Updates the opengl context. }
+     Procedure Update;
    published
+     { Specifies the number of color bits. }
+     property numColorBits        : Integer      read FColorBits          write SetColorBits;
+     { Specifies the number of z bits. }
+     property numZBits            : Integer      read FZBits              write SetZBits;
+     { Specifies the number of stencil bits. }
+     property numStencilBits      : Integer      read FStencilBits        write SetStencilBits;
+     { Specifies the number of accum bits. }
+     property numAccumBits        : Integer      read FAccumBits          write SetAccumBits;
+     { Specifies the number of auxillary buffers. }
+     property numAuxBuffers       : Integer      read FAuxBuffers         write SetAuxBuffers;

!     
      { Specifies if the scene is to be rendered using depth testing. }
      property doDepthTest   : Boolean      read FdoDepthTest     write SetDepthTest;
***************
*** 142,146 ****
      { Specifies if the scene is to be rendered with culling. }
      property doCulling     : Boolean      read FdoCulling       write SetCulling;
!     { Specifies if the scene is to be rendered with line stripple. }
      property doLineStripple: Boolean      read FdoLineStripple  write SetLineStripple;
    end;
--- 155,159 ----
      { Specifies if the scene is to be rendered with culling. }
      property doCulling     : Boolean      read FdoCulling       write SetCulling;
!     { Specifie if the scene is to be rendered with line stripple. }
      property doLineStripple: Boolean      read FdoLineStripple  write SetLineStripple;
    end;
***************
*** 188,197 ****
      function GetDisplay: TGLXDrawDisplay;

!     procedure SetCamera   (const Value: TGLXCamera);
!     procedure SetOptions  (const Value: TGLXDrawOptions);
!     procedure SetDisplay  (const Value: TGLXDrawDisplay);
!     procedure SetTimer(const Value: TGLXTimer);
   protected
-    { Protected declarations }
      {@exclude}
      procedure Paint; override;
--- 201,209 ----
      function GetDisplay: TGLXDrawDisplay;

!     procedure SetCamera (const Value: TGLXCamera);
!     procedure SetOptions(const Value: TGLXDrawOptions);
!     procedure SetDisplay(const Value: TGLXDrawDisplay);
!     procedure SetTimer  (const Value: TGLXTimer);
   protected
      {@exclude}
      procedure Paint; override;
***************
*** 275,281 ****

!     // Events
      property OnSetup      : TNotifyEvent    read FOnSetup       write FOnSetup;
      property OnInitialize : TNotifyEvent    read FonInitialize  write FonInitialize;
      property OnRender     : TGLXTimerEvent  read FOnRender      write FOnRender;

--- 287,295 ----

!     { This event is called just before opengl initialization, use to setup screen mode. }
      property OnSetup      : TNotifyEvent    read FOnSetup       write FOnSetup;
+     { This event is called when opengl is initialized. }
      property OnInitialize : TNotifyEvent    read FonInitialize  write FonInitialize;
+     { This event is called by the onTimer event if the timer is assigned. }
      property OnRender     : TGLXTimerEvent  read FOnRender      write FOnRender;

***************
*** 355,363 ****
    inherited Create(AOwner);

!   FRC          :=0;
!   Camera       :=nil;
!   Timer        :=nil;
    RenderOptions:= TGLXRenderOptions.Create(self);
!   Options      :=[doInitialize, doAutosize];
  end;

--- 369,377 ----
    inherited Create(AOwner);

!   FRC          := 0;
!   Camera       := nil;
!   Timer        := nil;
    RenderOptions:= TGLXRenderOptions.Create(self);
!   Options      := [doInitialize, doAutosize];
  end;

***************
*** 429,434 ****
  Procedure TGLXDraw.Render(FrameTime: Single);
  begin
-   Activate;
- 
    If Assigned(Camera)  then begin
      Camera.Style:= csPerspective;
--- 443,446 ----
***************
*** 441,446 ****

    Flip;
- 
-   Deactivate;
  end;

--- 453,456 ----
***************
*** 460,471 ****
    FDC := GetDC(Handle);

!   if FDC=0 then raise Exception.Create('Could not get device context!');

    // Create the rendering context
    with RenderOptions do
!   FRC := CreateRenderingContext(FDC, [opDoubleBuffered], ColorBits, ZBits, StencilBits, AccumBits, AuxBuffers,0);

!   if FRC=0 then raise Exception.Create('Could not create rendering context!');
    // Activate the rendering context
    ActivateRenderingContext(DC, RC);
--- 470,481 ----
    FDC := GetDC(Handle);

!   if FDC = 0 then raise Exception.Create('Could not get device context!');

    // Create the rendering context
    with RenderOptions do
!   FRC := CreateRenderingContext(FDC, [opDoubleBuffered], numColorBits, numZBits, numStencilBits, numAccumBits, numAuxBuffers,0);

!   if FRC = 0 then raise Exception.Create('Could not create rendering context!');
    // Activate the rendering context
    ActivateRenderingContext(DC, RC);
***************
*** 473,477 ****

    SetBounds(Left, Top, Width, Height);
!   RenderOptions.UpdateOpenGL;

    if Assigned(FOnInitialize) then FOnInitialize(Self);
--- 483,489 ----

    SetBounds(Left, Top, Width, Height);
!   RenderOptions.Update;
! 
!   GLXNotifications.Notify([glx_ContextCreated]);

    if Assigned(FOnInitialize) then FOnInitialize(Self);
***************
*** 574,580 ****
  procedure TGLXDraw.SetTimer(const Value: TGLXTimer);
  begin
-   IF Assigned(Timer) then Timer.Unsubscribe(TimerEvent);
    FTimer := Value;
!   IF Assigned(Timer) then Timer.Subscribe(TimerEvent);
  end;

--- 586,591 ----
  procedure TGLXDraw.SetTimer(const Value: TGLXTimer);
  begin
    FTimer := Value;
!   IF Assigned(Timer) then Timer.OnTimer:=TimerEvent;
  end;

***************
*** 620,638 ****
  begin
    Bitmap:=TBitmap.Create;
!   Bitmap.Width := Self.Width;
!   Bitmap.Height:= Self.Height;
!   if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin
!      GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
!      FillChar(lpPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0);
!      lpPal^.palVersion := $300;
!      lpPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, lpPal^.palPalEntry);
!      if (lpPal^.PalNumEntries <> 0) then begin
!        Bitmap.Palette := CreatePalette(lpPal^);
!      end;
!      FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
    end;
-   BitBlt(Bitmap.Canvas.Handle, 0, 0, Self.Width, Self.Height, DC, 0, 0, SRCCOPY);
-   Bitmap.SaveToFile(FileName);
-   Bitmap.Free;
  end;

--- 631,652 ----
  begin
    Bitmap:=TBitmap.Create;
!   try
!     Bitmap.Width := Self.Width;
!     Bitmap.Height:= Self.Height;
!     if (GetDeviceCaps(dc, RASTERCAPS) AND RC_PALETTE = RC_PALETTE) then begin
!        GetMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
!        FillChar(lpPal^, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)), #0);
!        lpPal^.palVersion := $300;
!        lpPal^.palNumEntries := GetSystemPaletteEntries(DC, 0, 256, lpPal^.palPalEntry);
!        if (lpPal^.PalNumEntries <> 0) then begin
!          Bitmap.Palette := CreatePalette(lpPal^);
!        end;
!        FreeMem(lpPal, SizeOf(TLOGPALETTE) + (255 * SizeOf(TPALETTEENTRY)));
!     end;
!     BitBlt(Bitmap.Canvas.Handle, 0, 0, Self.Width, Self.Height, DC, 0, 0, SRCCOPY);
!     Bitmap.SaveToFile(FileName);
!   finally
!     Bitmap.Free;
    end;
  end;

***************
*** 787,798 ****
  constructor TGLXRenderOptions.Create(AOwner: TObject);
  begin
!   fColorBits                := 32;
!   fZBits                    := 16;
!   fStencilBits              := 0;
!   fAccumBits                := 0;
!   fAuxBuffers               := 0;

!   FdoDepthtest:=True;
    FOwner:=AOwner;
  end;
--- 801,818 ----
  constructor TGLXRenderOptions.Create(AOwner: TObject);
  begin
!   FColorBits                := 32;
!   FZBits                    := 16;
!   FStencilBits              := 0;
!   FAccumBits                := 0;
!   FAuxBuffers               := 0;

!   FdoDepthTest   := True;
!   FdoWireframe   := False;
!   FdoTexturing   := False;
!   FdoBlending    := False;
!   FdoLineStripple:= False;
!   FdoCulling     := False;
! 
    FOwner:=AOwner;
  end;
***************
*** 800,804 ****

  //------------------------------------------------------------------------------
! procedure TGLXRenderOptions.UpdateOpenGL;
  begin
    IF (FOwner <> nil) and (TGLXDraw(Fowner).RC <> 0) then begin
--- 820,824 ----

  //------------------------------------------------------------------------------
! procedure TGLXRenderOptions.Update;
  begin
    IF (FOwner <> nil) and (TGLXDraw(Fowner).RC <> 0) then begin
***************
*** 866,870 ****
  begin
    FdoWireframe:= Value;
!   UpdateOpenGL;
  end;

--- 886,890 ----
  begin
    FdoWireframe:= Value;
!   Update;
  end;

***************
*** 873,877 ****
  begin
    FdoBlending := Value;
!   UpdateOpenGL;
  end;

--- 893,897 ----
  begin
    FdoBlending := Value;
!   Update;
  end;

***************
*** 880,884 ****
  begin
    FdoCulling := Value;
!   UpdateOpenGL;
  end;

--- 900,904 ----
  begin
    FdoCulling := Value;
!   Update;
  end;

***************
*** 887,891 ****
  begin
    FdoLineStripple := Value;
!   UpdateOpenGL;
  end;

--- 907,911 ----
  begin
    FdoLineStripple := Value;
!   Update;
  end;

***************
*** 894,898 ****
  begin
    FdoTexturing := Value;
!   UpdateOpenGL;
  end;

--- 914,918 ----
  begin
    FdoTexturing := Value;
!   Update;
  end;

***************
*** 901,905 ****
  begin
    FdoDepthtest:= Value;
!   UpdateOpenGL;
  end;

--- 921,925 ----
  begin
    FdoDepthtest:= Value;
!   Update;
  end;

***************
*** 945,954 ****

  initialization
    //Has to be initialized only once per Application
    InitOpenGL;
- 
- 
- 
  end.

--- 965,973 ----

+ 
+ //------------------------------------------------------------------------------
  initialization
    //Has to be initialized only once per Application
    InitOpenGL;
  end.

Index: GLXNotification.pas
===================================================================
RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXNotification.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** GLXNotification.pas	10 Mar 2004 16:55:30 -0000	1.1
--- GLXNotification.pas	12 Mar 2004 07:31:20 -0000	1.2
***************
*** 1,5 ****
--- 1,30 ----
+ ////////////////////////////////////////////////////////////////////////////////
+ //                                                                            //
+ //      GLXTreem                                                              //
+ //                                                                            //
+ //      Date      : 2004-03-12                                                //
+ //                                                                            //
+ //      The contents of this file are used with permission, subject to        //
+ //      the Mozilla Public License Version 1.1 (the "License"); you may       //
+ //      not use this file except in compliance with the License. You may      //
+ //      obtain a copy of the License at                                       //
+ //      http://www.mozilla.org/MPL/MPL-1.1.html                               //
+ //                                                                            //
+ //      Software distributed under the License is distributed on an           //
+ //      "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or        //
+ //      implied. See the License for the specific language governing          //
+ //      rights and limitations under the License.                             //
+ //                                                                            //
+ ////////////////////////////////////////////////////////////////////////////////
+ 
+ {
+   @created(Mar 8, 2004)
+   @lastmod(Mar 12, 2004)
+ }
+ 
  unit GLXNotification;

  interface
+ 
  uses
    Classes;

Index: GLXPrimitives.pas
===================================================================
RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXPrimitives.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** GLXPrimitives.pas	10 Mar 2004 16:55:30 -0000	1.1
--- GLXPrimitives.pas	12 Mar 2004 07:31:20 -0000	1.2
***************
*** 108,112 ****

! var BufferItems: Array[TPrimitive] of  TBufferItem;
  var BufferData : TBufferData;
  var BufferSize : Integer;
--- 108,112 ----

! var BufferItems: Array[TPrimitive] of TBufferItem;
  var BufferData : TBufferData;
  var BufferSize : Integer;

Index: GLXTexture.pas
===================================================================
RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTexture.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** GLXTexture.pas	10 Mar 2004 16:55:30 -0000	1.1
--- GLXTexture.pas	12 Mar 2004 07:31:20 -0000	1.2
***************
*** 260,264 ****
  Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData24); overload;
  var X, Y: Integer;
! var Pix : TRGBTriple;
  var Line: PRGBTripleArray;
  begin
--- 260,264 ----
  Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData24); overload;
  var X, Y: Integer;
! var Index : Integer;
  var Line: PRGBTripleArray;
  begin
***************
*** 267,276 ****
    For Y:=0 to Bitmap.Height-1 do begin
      Line := Bitmap.ScanLine[Bitmap.Height-Y-1];
      For X:=0 to Bitmap.Width-1 do begin
!       Pix:=Line[X];

!       Data[X+(Y*Bitmap.Width)].Red  :=Pix.rgbtRed;
!       Data[X+(Y*Bitmap.Width)].Green:=Pix.rgbtGreen;
!       Data[X+(Y*Bitmap.Width)].Blue :=Pix.rgbtBlue;
      end;
    end;
--- 267,277 ----
    For Y:=0 to Bitmap.Height-1 do begin
      Line := Bitmap.ScanLine[Bitmap.Height-Y-1];
+     Index:= Bitmap.Width * Y;
      For X:=0 to Bitmap.Width-1 do begin
!       Data[Index].Red  :=Line[X].rgbtRed;
!       Data[Index].Green:=Line[X].rgbtGreen;
!       Data[Index].Blue :=Line[X].rgbtBlue;

!       Inc(Index);
      end;
    end;
***************
*** 280,286 ****
  //------------------------------------------------------------------------------
  Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData32); overload;
! var X, Y: Integer;
! var Pix : TRGBQuad ;
! var Line: PRGBQuadArray;
  begin
    SetLength(Data, Bitmap.Width * Bitmap.Height);
--- 281,287 ----
  //------------------------------------------------------------------------------
  Procedure CreateData(Bitmap: TBitmap; var Data: TTextureData32); overload;
! var X, Y  : Integer;
! var Index : Integer;
! var Line  : PRGBQuadArray;
  begin
    SetLength(Data, Bitmap.Width * Bitmap.Height);
***************
*** 288,298 ****
    For Y:=0 to Bitmap.Height-1 do begin
      Line := Bitmap.ScanLine[Bitmap.Height-Y-1];
      For X:=0 to Bitmap.Width-1 do begin
!       Pix:=Line[X];

!       Data[X+(Y*Bitmap.Width)].Red  :=Pix.rgbRed;
!       Data[X+(Y*Bitmap.Width)].Green:=Pix.rgbGreen;
!       Data[X+(Y*Bitmap.Width)].Blue :=Pix.rgbBlue;
!       Data[X+(Y*Bitmap.Width)].Alpha:=Pix.rgbReserved;
     end;
    end;
--- 289,300 ----
    For Y:=0 to Bitmap.Height-1 do begin
      Line := Bitmap.ScanLine[Bitmap.Height-Y-1];
+     Index:= Bitmap.Width * Y;
      For X:=0 to Bitmap.Width-1 do begin
!       Data[Index].Red  :=Line[X].rgbRed;
!       Data[Index].Green:=Line[X].rgbGreen;
!       Data[Index].Blue :=Line[X].rgbBlue;
!       Data[Index].Alpha:=Line[X].rgbReserved;

!       Inc(Index);
     end;
    end;
***************
*** 303,312 ****
  Procedure ScaleBitmap24(Source, Dest: TBitmap; Scale: Single);
  var X, Y: Integer;
- //var SPix : TRGBTriple ;
  var SLine: PRGBTripleArray;
  var DLine: PRGBTripleArray;
  begin
!   // Can't scale to 0
!   IF Scale = 0 then Scale:= 1;

    Dest.PixelFormat:=pf24Bit;
--- 305,313 ----
  Procedure ScaleBitmap24(Source, Dest: TBitmap; Scale: Single);
  var X, Y: Integer;
  var SLine: PRGBTripleArray;
  var DLine: PRGBTripleArray;
  begin
!   // Can't scale to zero
!   IF Scale <= 0 then Scale:= 1;

    Dest.PixelFormat:=pf24Bit;
***************
*** 326,335 ****
  Procedure ScaleBitmap32(Source, Dest: TBitmap; Scale: Single);
  var X, Y: Integer;
- //var SPix : TRGBTriple ;
  var SLine: PRGBQuadArray;
  var DLine: PRGBQuadArray;
  begin
!   // Can't scale to 0
!   IF Scale = 0 then Scale:= 1;

    Dest.PixelFormat:=pf24Bit;
--- 327,335 ----
  Procedure ScaleBitmap32(Source, Dest: TBitmap; Scale: Single);
  var X, Y: Integer;
  var SLine: PRGBQuadArray;
  var DLine: PRGBQuadArray;
  begin
!   // Can't scale to zero
!   IF Scale <= 0 then Scale:= 1;

    Dest.PixelFormat:=pf24Bit;

Index: GLXTimer.pas
===================================================================
RCS file: /cvsroot/glxtreem/GLXtreem/Source/GLXTimer.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** GLXTimer.pas	11 Mar 2004 02:00:25 -0000	1.3
--- GLXTimer.pas	12 Mar 2004 07:31:20 -0000	1.4
***************
*** 3,7 ****
  //      GLXTreem                                                              //
  //                                                                            //
! //      Date      : 2004-03- 08                                               //
  //                                                                            //
  //      The contents of this file are used with permission, subject to        //
--- 3,7 ----
  //      GLXTreem                                                              //
  //                                                                            //
! //      Date      : 2004-03-08                                                //
  //                                                                            //
  //      The contents of this file are used with permission, subject to        //
***************
*** 22,26 ****
    @author(Andreas Lago: an...@li...)
    @created(Mar 8, 2004)
!   @lastmod(Mar 8, 2004)
  }
  unit GLXTimer;
--- 22,26 ----
    @author(Andreas Lago: an...@li...)
    @created(Mar 8, 2004)
!   @lastmod(Mar 12, 2004)
  }
  unit GLXTimer;
***************
*** 32,38 ****

  { The type of event that is called by the timer. }
! Type
!   TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object;
!   PGLXTimerEvent = ^TGLXTimerEvent;

--- 32,36 ----

  { The type of event that is called by the timer. }
! Type TGLXTimerEvent = procedure(Sender: TObject; FrameTime: Single) of object;

***************
*** 44,50 ****
    full speed.<br>
    <br>
-   When reacing 500-1000 fps the movement can become somewhat chompy to solve this
-   just set the interval to a non-zero value.<br>
-   <br>
    <b>Note</b> that when using the timer the CPU utilization will raise to 100% even when the
    interval is higher than zero, this is normal.<br>
--- 42,45 ----
***************
*** 58,78 ****
      FInterval      : Cardinal;
      FInitialized   : Boolean;
-     FEventList     : TList;
      FFrequency     : Int64;

      // Time
      FAppStart      : Single;
      FLastTime      : Single;
-     FSuspendTime   : Single;

      // Frame information
      FFrameTimes      : Single;
      FFrameCount      : Int64;
!     FFrameRate       : Single;
      FFrameRateCounter: Integer;
      FFrameRateTime   : Single;

!     function  GetCount:Single;
!     function  GetElapsedTime:Single;
      function  AppProc(var Message: TMessage): Boolean;
      procedure AppIdle(Sender: TObject; var Done: Boolean);
--- 53,76 ----
      FInterval      : Cardinal;
      FInitialized   : Boolean;
      FFrequency     : Int64;

+     // Event
+     FOnTimer       : TGLXTimerEvent;
+ 
      // Time
      FAppStart      : Single;
      FLastTime      : Single;

      // Frame information
      FFrameTimes      : Single;
      FFrameCount      : Int64;
!     FFrameRate       : Integer;
      FFrameRateCounter: Integer;
      FFrameRateTime   : Single;

!     function  GetCurrentTime: Single;
!     function  GetElapsedTime: Single;
! 
! 
      function  AppProc(var Message: TMessage): Boolean;
      procedure AppIdle(Sender: TObject; var Done: Boolean);
***************
*** 87,96 ****
      procedure SetInterval  (Value: Cardinal);
    protected
-     { Protected declarations }
- 
      {@exclude}
      procedure Loaded; override;
    public
-     { Public declarations }
      {@exclude}
      constructor Create(AOwner: TComponent); override;
--- 85,91 ----
***************
*** 98,109 ****
      destructor  Destroy; override;

-     { TGLXDraw or other objects that want to be notified by the Timer subscribe here.  }
-     procedure   Subscribe(Event:TGLXTimerEvent);
-     { TGLXDraw or other objects that no longer want to be notified by the Timer unsubscribe here.  }
-     procedure   UnSubscribe(Event:TGLXTimerEvent);
- 
- 
      { The current framerate, is weighted over the last 500 ms. }
!     property FrameRate  : Single   read FFrameRate;
      { The number of frames rendered since program start. }
      property FrameCount : Int64    read FFrameCount;
--- 93,98 ----
      destructor  Destroy; override;

      { The current framerate, is weighted over the last 500 ms. }
!     property FrameRate  : Integer  read FFrameRate;
      { The number of frames rendered since program start. }
      property FrameCount : Int64    read FFrameCount;
***************
*** 117,122 ****
--- 106,115 ----
      { This tells if the timer shall be disabled when the window loses focus. }
      property ActiveOnly : Boolean        read FActiveOnly write SetActiveOnly;
+     { The main timer event, this is called with the interval in milliseconds. }
+     property OnTimer     : TGLXTimerEvent read FOnTimer      write FOnTimer;
    end;

+ 
+ 
  implementation

***************
*** 129,133 ****
  begin
    inherited Create(AOwner);
-   FEventList := TList.Create;
    FActiveOnly:= True;
    FActive    := True;
--- 122,125 ----
***************
*** 137,141 ****

    QueryPerformanceFrequency(FFrequency);
!   FAppStart         :=GetCount;
    FFramerateTime    :=FAppStart;
    FLastTime         :=FAppStart;
--- 129,133 ----

    QueryPerformanceFrequency(FFrequency);
!   FAppStart         :=GetCurrentTime;
    FFramerateTime    :=FAppStart;
    FLastTime         :=FAppStart;
***************
*** 150,198 ****
    Finalize;
    Application.UnHookMainWindow(AppProc);
-   FEventList.Free;
    inherited ;
  end;

- //------------------------------------------------------------------------------
- procedure TGLXTimer.Subscribe(Event:TGLXTimerEvent);
- var
-   NewEvent  : PGLXTimerEvent;
- begin
-   New(NewEvent);
-   NewEvent^:=Event;
-   FEventList.Add(NewEvent);
- end;
- 
- //------------------------------------------------------------------------------
- procedure TGLXTimer.UnSubscribe(Event:TGLXTimerEvent);
- var
-   i         : Integer;
-   TestEvent : TGLXTimerEvent;
- begin
-   if FEventList.Count>0 then begin
-     i:=0;
-     repeat
-       TestEvent:=PGLXTimerEvent(FEventList.Items[i])^;
-       if (@TestEvent=@Event) then begin
-         Dispose(PGLXTimerEvent(FEventList.Items[i]));
-         FEventList.Delete(i);
-         i := 0;
-       end else Inc(i);
-     until (i>=FEventList.Count);
-   end;
- end;
- 

  //------------------------------------------------------------------------------
  procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean);
! var
!   FrameTime, FrameRateTime: Single;
!   i: Integer;
!   Event : TGLXTimerEvent;
  begin
    Done      := False;
!   FrameTime := (GetCount - FLastTime);
    IF (FrameTime >= FInterval) then begin
!     FLastTime:=GetCount;

      Inc(FFramerateCounter);
--- 142,158 ----
    Finalize;
    Application.UnHookMainWindow(AppProc);
    inherited ;
  end;

  //------------------------------------------------------------------------------
  procedure TGLXTimer.AppIdle(Sender: TObject; var Done: Boolean);
! var FrameTime    : Single;
! var FrameRateTime: Single;
  begin
    Done      := False;
!   FrameTime := (GetCurrentTime - FLastTime);
    IF (FrameTime >= FInterval) then begin
!     FLastTime:=GetCurrentTime;

      Inc(FFramerateCounter);
***************
*** 203,213 ****
        FFrameRate        := Round(1000/(FrameRateTime/FFramerateCounter));
        FFramerateCounter := 0;
!       FFramerateTime    := GetCount();
      end;

!     for i:=0 to FEventList.Count-1 do begin
!       Event:=PGLXTimerEvent(FEventList.Items[i])^;
!       if Assigned(Event) then Event(Self,FrameTime);
!     end;
      FFrameTimes:=FrameTime;

--- 163,170 ----
        FFrameRate        := Round(1000/(FrameRateTime/FFramerateCounter));
        FFramerateCounter := 0;
!       FFramerateTime    := GetCurrentTime();
      end;

!     if Assigned(FOnTimer) then FOnTimer(Self, (FFrameTimes + FrameTime) / 2);
      FFrameTimes:=FrameTime;

***************
*** 242,247 ****
  procedure TGLXTimer.Finalize;
  begin
!   if FInitialized then
!   begin
      Suspend;
      FInitialized := False;
--- 199,203 ----
  procedure TGLXTimer.Finalize;
  begin
!   if FInitialized then begin
      Suspend;
      FInitialized := False;
***************
*** 260,265 ****
  procedure TGLXTimer.Resume;
  begin
!   FLastTime:=GetCount;
!  // FAppStart:=FAppStart+ (FLastTime-FSuspendTime);

    Application.OnIdle:= AppIdle;
--- 216,221 ----
  procedure TGLXTimer.Resume;
  begin
! //  FAppStart:=FAppStart      + (GetCurrentTime-FSuspendTime);
!   FLastTime:=GetCurrentTime;

    Application.OnIdle:= AppIdle;
***************
*** 269,273 ****
  procedure TGLXTimer.Suspend;
  begin
!   FSuspendTime:=GetCount;
    Application.OnIdle:= nil;
  end;
--- 225,229 ----
  procedure TGLXTimer.Suspend;
  begin
! //  FSuspendTime:=GetCurrentTime;
    Application.OnIdle:= nil;
  end;
***************
*** 302,318 ****
  end;

  //------------------------------------------------------------------------------
! function TGLXTimer.GetCount:Single;
! var
!   t : Int64;
  begin
!   QueryPerformanceCounter(t);
!   result:=1000*t/FFrequency;
  end;

  //------------------------------------------------------------------------------
! function TGLXTimer.GetElapsedTime:Single;
  begin
!   Result:=GetCount() - FAppStart;
  end;

--- 258,275 ----
  end;

+ 
+ 
  //------------------------------------------------------------------------------
! function TGLXTimer.GetCurrentTime: Single;
! var Time : Int64;
  begin
!   QueryPerformanceCounter(Time);
!   Result:= (Time / FFrequency) * 1000;
  end;

  //------------------------------------------------------------------------------
! function TGLXTimer.GetElapsedTime: Single;
  begin
!   Result:=GetCurrentTime - FAppStart;
  end;

[Glxtreem-commits] GLXtreem/Source GLXDraws.pas,1.2,1.3 GLXNotification.pas,1.1,1.2 GLXPrimitives.pa

[Glxtreem-commits] GLXtreem/Source GLXDraws.pas,1.2,1.3 GLXNotification.pas,1.1,1.2 GLXPrimitives.pas,1.1,1.2 GLXTexture.pas,1.1,1.2 GLXTimer.pas,1.3,1.4