fixed gtkglarea

git-svn-id: trunk@4143 -

components/gtk/gtkglarea/gtkglarea.pp

@@ -20,28 +20,41 @@ unit GTKGLArea;
 interface
 
 uses
-  Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals,
+  Classes, SysUtils, {$IFDEF VER1_0}Linux{$ELSE}Unix{$ENDIF}, Forms,
-  InterfaceBase, GTKInt, LResources, GLib, NVGL, NVGLX, GTKGLArea_Int;
+  Controls, Graphics, LMessages, VCLGlobals, InterfaceBase, GTKInt, LResources,
+  GLib, NVGL, NVGLX, GTKGLArea_Int;
   
 type
+  { TCustomGTKGLAreaControl }
+
   TCustomGTKGLAreaControl = class(TWinControl)
   private
     FCanvas: TCanvas; // only valid at designtime
     FOnPaint: TNotifyEvent;
+    FCurrentFrameTime: integer; // in msec
+    FLastFrameTime: integer; // in msec
+    FFrameDiffTime: integer; // in msec
+    FPaintOnIdle: boolean;
   protected
     procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
     function GetWidget: PGtkGLArea;
     procedure CreateComponent(TheOwner: TComponent); override;
+    procedure UpdateFrameTimeDiff;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     Procedure Paint; virtual;
     procedure DoOnResize; override;
+    procedure DoOnPaint; virtual;
   public
     property Widget: PGtkGLArea read GetWidget;
     property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
+    property FrameDiffTimeInMSecs: integer read FFrameDiffTime;
   end;
   
+  
+  { TGTKGLAreaControl }
+  
   TGTKGLAreaControl = class(TCustomGTKGLAreaControl)
   published
     property Align;
@@ -76,7 +89,6 @@ procedure Register;
 
 implementation
 
-
 const
   InitAttrList: array [1..11] of LongInt = (
     GDK_GL_RGBA,
@@ -116,16 +128,26 @@ end;
 
 procedure TCustomGTKGLAreaControl.Paint;
 begin
-  if Assigned(OnPaint) then OnPaint(Self);
+  if (not (csDesigning in ComponentState))
+  and Enabled and Visible and HandleAllocated
+  and (gint(True) = gtk_gl_area_make_current(Widget)) then begin
+    UpdateFrameTimeDiff;
+    DoOnPaint;
+  end;
 end;
 
 procedure TCustomGTKGLAreaControl.DoOnResize;
 begin
-  if (gint(True) = gtk_gl_area_make_current(Widget)) then
+  if HandleAllocated and (gint(True) = gtk_gl_area_make_current(Widget)) then
     glViewport (0, 0, Width, Height);
   inherited DoOnResize;
 end;
 
+procedure TCustomGTKGLAreaControl.DoOnPaint;
+begin
+  if Assigned(OnPaint) then OnPaint(Self);
+end;
+
 procedure TCustomGTKGLAreaControl.WMPaint(var Message: TLMPaint);
 begin
   Include(FControlState, csCustomPaint);
@@ -141,9 +163,7 @@ begin
       LineTo(Width,0);
     end;
   end else begin
-    if (Widget<>nil)
+    Paint;
-    and (gint(True) = gtk_gl_area_make_current(Widget)) then
-      Paint;
   end;
   Exclude(FControlState, csCustomPaint);
 end;
@@ -169,6 +189,20 @@ begin
   end;
 end;
 
+procedure TCustomGTKGLAreaControl.UpdateFrameTimeDiff;
+var
+  hour, minutes, secs, msecs, usecs: word;
+begin
+  GetTime(hour, minutes, secs, msecs, usecs);
+  FCurrentFrameTime:=(((minutes*60)+secs) * 1000)+msecs;
+  if FLastFrameTime=0 then
+    FLastFrameTime:=FCurrentFrameTime;
+  // calculate time since last call:
+  FFrameDiffTime:=FCurrentFrameTime-FLastFrameTime;
+  // if the hour changed, the minutes restarts:
+  if (FFrameDiffTime<0) then inc(FFrameDiffTime,60*60*1000);
+end;
+
 initialization
   {$i gtkglarea.lrs}
 

ide/compileroptions.pp

@@ -4078,13 +4078,13 @@ begin
     AButton:=TPathEditorButton(Sender);
     if AButton=OtherUnitsPathEditBtn then begin
       OldPath:=edtOtherUnits.Text;
-      Templates:=
+      Templates:=SetDirSeparators(
             '$(LazarusDir)/lcl/units'
           +';$(LazarusDir)/lcl/units/$(LCLWidgetType)'
           +';$(LazarusDir)/components/units'
           +';$(LazarusDir)/components/custom'
           +';$(LazarusDir)/packager/units'
-          ;
+          );
     end else
     if AButton=IncludeFilesPathEditBtn then begin
       OldPath:=edtIncludeFiles.Text;

packager/pkgoptionsdlg.pas

@@ -166,7 +166,14 @@ begin
   AnEdit:=GetEditForPathButton(AButton);
   OldPath:=AnEdit.Text;
   if AButton=UnitPathButton then begin
-    Templates:='$(PkgOutDir)';
+    Templates:=SetDirSeparators(
+           '$(PkgOutDir)'
+          +';$(LazarusDir)/lcl/units'
+          +';$(LazarusDir)/lcl/units/$(LCLWidgetType)'
+          +';$(LazarusDir)/components/units'
+          +';$(LazarusDir)/components/custom'
+          +';$(LazarusDir)/packager/units'
+          );
   end;
   if AButton=IncludePathButton then begin
     Templates:='include';