paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 16:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

added published properties for gtkglarea

Browse Source 
git-svn-id: trunk@4142 -
This commit is contained in:
mattias 2003-05-09 14:21:25 +00:00
parent fd99e419e3
commit f44c4f4556
3 changed files with 51 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
components/gtk/gtkglarea/gtkglarea.pp
View File

@ -20,25 +20,55 @@ unit GTKGLArea;
interface
uses
Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals, GTKGLArea_Int,
InterfaceBase, GTKInt, LResources, NVGLX;
Classes, SysUtils, Controls, Graphics, LMessages, VCLGlobals,
InterfaceBase, GTKInt, LResources, GLib, NVGL, NVGLX, GTKGLArea_Int;
type
TCustomGTKGLAreaControl = class(TWinControl)
private
FCanvas: TCanvas; // only valid at designtime
FOnPaint: TNotifyEvent;
protected
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
function GetWidget: PGtkGLArea;
procedure CreateComponent(TheOwner: TComponent); override;
public
property Widget: PGtkGLArea read GetWidget;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
Procedure Paint; virtual;
procedure DoOnResize; override;
public
property Widget: PGtkGLArea read GetWidget;
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
end;
TGTKGLAreaControl = class(TCustomGTKGLAreaControl)
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;
procedure Register;
@ -84,6 +114,18 @@ begin
inherited Destroy;
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);
begin
Include(FControlState, csCustomPaint);
@ -98,6 +140,10 @@ begin
MoveTo(0,Height);
LineTo(Width,0);
end;
end else begin
if (Widget<>nil)
and (gint(True) = gtk_gl_area_make_current(Widget)) then
Paint;
end;
Exclude(FControlState, csCustomPaint);
end;

2
components/gtk/gtkglarea/gtkopengl.pas
View File

@ -8,7 +8,7 @@ unit GTKOpenGL;
interface
uses
GTKGLArea, GTKGLArea_Int, NVGL, NVGLX, LazarusPackageIntf;
GTKGLArea, GTKGLArea_Int, nvGL, NVGLX, LazarusPackageIntf;
implementation

1
packager/pkgmanager.pas
View File

@ -981,6 +981,7 @@ begin
end;
for i:=0 to APackage.FileCount-1 do begin
CurFile:=APackage.Files[i];
//writeln('TPkgManager.CheckIfPackageNeedsCompilation CurFile.Filename="',CurFile.Filename,'" ',FileExists(CurFile.Filename),' ',StateFileAge<FileAge(CurFile.Filename));
if FileExists(CurFile.Filename)
and (StateFileAge<FileAge(CurFile.Filename)) then begin
writeln('TPkgManager.CheckIfPackageNeedsCompilation Src has changed ',APackage.IDAsString,' ',CurFile.Filename);