mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-13 12:09:21 +02:00
added published properties for gtkglarea
git-svn-id: trunk@4142 -
This commit is contained in:
parent
fd99e419e3
commit
f44c4f4556
@ -20,25 +20,55 @@ unit GTKGLArea;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals, GTKGLArea_Int,
|
Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals,
|
||||||
InterfaceBase, GTKInt, LResources, NVGLX;
|
InterfaceBase, GTKInt, LResources, GLib, NVGL, NVGLX, GTKGLArea_Int;
|
||||||
|
|
||||||
type
|
type
|
||||||
TCustomGTKGLAreaControl = class(TWinControl)
|
TCustomGTKGLAreaControl = class(TWinControl)
|
||||||
private
|
private
|
||||||
FCanvas: TCanvas; // only valid at designtime
|
FCanvas: TCanvas; // only valid at designtime
|
||||||
|
FOnPaint: TNotifyEvent;
|
||||||
protected
|
protected
|
||||||
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
|
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
|
||||||
function GetWidget: PGtkGLArea;
|
function GetWidget: PGtkGLArea;
|
||||||
procedure CreateComponent(TheOwner: TComponent); override;
|
procedure CreateComponent(TheOwner: TComponent); override;
|
||||||
public
|
public
|
||||||
property Widget: PGtkGLArea read GetWidget;
|
|
||||||
constructor Create(TheOwner: TComponent); override;
|
constructor Create(TheOwner: TComponent); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
Procedure Paint; virtual;
|
||||||
|
procedure DoOnResize; override;
|
||||||
|
public
|
||||||
|
property Widget: PGtkGLArea read GetWidget;
|
||||||
|
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TGTKGLAreaControl = class(TCustomGTKGLAreaControl)
|
TGTKGLAreaControl = class(TCustomGTKGLAreaControl)
|
||||||
published
|
published
|
||||||
|
property Align;
|
||||||
|
property Anchors;
|
||||||
|
property Enabled;
|
||||||
|
property OnClick;
|
||||||
|
property OnConstrainedResize;
|
||||||
|
property OnDblClick;
|
||||||
|
property OnEnter;
|
||||||
|
property OnExit;
|
||||||
|
property OnKeyDown;
|
||||||
|
property OnKeyPress;
|
||||||
|
property OnKeyUp;
|
||||||
|
property OnMouseDown;
|
||||||
|
property OnMouseEnter;
|
||||||
|
property OnMouseLeave;
|
||||||
|
property OnMouseMove;
|
||||||
|
property OnMouseUp;
|
||||||
|
property OnMouseWheel;
|
||||||
|
property OnMouseWheelDown;
|
||||||
|
property OnMouseWheelUp;
|
||||||
|
property OnPaint;
|
||||||
|
property OnResize;
|
||||||
|
property OnShowHint;
|
||||||
|
property PopupMenu;
|
||||||
|
property ShowHint;
|
||||||
|
property Visible;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
@ -84,6 +114,18 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TCustomGTKGLAreaControl.Paint;
|
||||||
|
begin
|
||||||
|
if Assigned(OnPaint) then OnPaint(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TCustomGTKGLAreaControl.DoOnResize;
|
||||||
|
begin
|
||||||
|
if (gint(True) = gtk_gl_area_make_current(Widget)) then
|
||||||
|
glViewport (0, 0, Width, Height);
|
||||||
|
inherited DoOnResize;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TCustomGTKGLAreaControl.WMPaint(var Message: TLMPaint);
|
procedure TCustomGTKGLAreaControl.WMPaint(var Message: TLMPaint);
|
||||||
begin
|
begin
|
||||||
Include(FControlState, csCustomPaint);
|
Include(FControlState, csCustomPaint);
|
||||||
@ -98,6 +140,10 @@ begin
|
|||||||
MoveTo(0,Height);
|
MoveTo(0,Height);
|
||||||
LineTo(Width,0);
|
LineTo(Width,0);
|
||||||
end;
|
end;
|
||||||
|
end else begin
|
||||||
|
if (Widget<>nil)
|
||||||
|
and (gint(True) = gtk_gl_area_make_current(Widget)) then
|
||||||
|
Paint;
|
||||||
end;
|
end;
|
||||||
Exclude(FControlState, csCustomPaint);
|
Exclude(FControlState, csCustomPaint);
|
||||||
end;
|
end;
|
||||||
|
@ -8,7 +8,7 @@ unit GTKOpenGL;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
GTKGLArea, GTKGLArea_Int, NVGL, NVGLX, LazarusPackageIntf;
|
GTKGLArea, GTKGLArea_Int, nvGL, NVGLX, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
@ -981,6 +981,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
for i:=0 to APackage.FileCount-1 do begin
|
for i:=0 to APackage.FileCount-1 do begin
|
||||||
CurFile:=APackage.Files[i];
|
CurFile:=APackage.Files[i];
|
||||||
|
//writeln('TPkgManager.CheckIfPackageNeedsCompilation CurFile.Filename="',CurFile.Filename,'" ',FileExists(CurFile.Filename),' ',StateFileAge<FileAge(CurFile.Filename));
|
||||||
if FileExists(CurFile.Filename)
|
if FileExists(CurFile.Filename)
|
||||||
and (StateFileAge<FileAge(CurFile.Filename)) then begin
|
and (StateFileAge<FileAge(CurFile.Filename)) then begin
|
||||||
writeln('TPkgManager.CheckIfPackageNeedsCompilation Src has changed ',APackage.IDAsString,' ',CurFile.Filename);
|
writeln('TPkgManager.CheckIfPackageNeedsCompilation Src has changed ',APackage.IDAsString,' ',CurFile.Filename);
|
||||||
|
Loading…
Reference in New Issue
Block a user