paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-26 06:49:34 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed gtkareacontrol

Browse Source 
git-svn-id: trunk@5332 -
This commit is contained in:
mattias 2004-03-19 22:13:46 +00:00
parent 61581c5f21
commit 7dc0dfe431
2 changed files with 39 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
components/codetools/definetemplates.pas
View File

@ -3343,6 +3343,7 @@ var
i: Integer;
CurCPU, CurOS, CurWidgetSet, ExtraSrcPath: string;
ElseTemplate: TDefineTemplate;
LCLWidgetSetDir: TDefineTemplate;
begin
Result:=nil;
if (LazarusSrcDir='') or (WidgetType='') then exit;
@ -3569,9 +3570,17 @@ begin
'include',da_Define));
DirTempl.AddChild(TDefineTemplate.Create('LCL path addition',
Format(ctsAddsDirToSourcePath,['widgetset']),
ExternalMacroStart+'SrcPath',d('widgetset;'+SrcPath),da_Define));
ExternalMacroStart+'SrcPath','widgetset;'+SrcPath,da_Define));
MainDir.AddChild(DirTempl);
// <LazarusSrcDir>/lcl/widgetset
LCLWidgetSetDir:=TDefineTemplate.Create('WidgetSet',Format(ctsNamedDirectory,['WidgetSet']),
'','widgetset',da_Directory);
LCLWidgetSetDir.AddChild(TDefineTemplate.Create('LCL path addition',
Format(ctsAddsDirToSourcePath,['..']),
ExternalMacroStart+'SrcPath','..;'+SrcPath,da_Define));
DirTempl.AddChild(LCLWidgetSetDir);
// <LazarusSrcDir>/lcl/units
LCLUnitsDir:=TDefineTemplate.Create('Units',Format(ctsNamedDirectory,['Units']),
'','units',da_Directory);

46
components/gtk/gtkglarea/gtkglareacontrol.pas
View File

@ -21,7 +21,8 @@ interface
uses
Classes, SysUtils, {$IFDEF VER1_0}Linux{$ELSE}Unix{$ENDIF}, Forms,
Controls, Graphics, LMessages, VCLGlobals, InterfaceBase, GTKInt, LResources,
Controls, Graphics, LMessages, VCLGlobals, InterfaceBase, GTKInt,
WSLCLClasses, LResources,
GLib, NVGL, GTKGLArea_Int;
type
@ -41,7 +42,6 @@ type
protected
procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
function GetWidget: PGtkGLArea;
function CreateWindowHandle(const AParams: TCreateParams): THandle; override;
procedure UpdateFrameTimeDiff;
public
constructor Create(TheOwner: TComponent); override;
@ -92,6 +92,15 @@ type
property Visible;
end;
{ TWSGTKGLAreaControl }
TWSGTKGLAreaControl = class(TWSLCLComponent)
public
class function CreateHandle(const AComponent: TComponent;
const AParams: TCreateParams): THandle; override;
end;
function GetCurrentGtkGLAreaControl: TGTKGLAreaControl;
@ -259,20 +268,6 @@ begin
Result:=nil;
end;
function TCustomGTKGLAreaControl.CreateWindowHandle(const AParams: TCreateParams
): THandle;
var
NewWidget: Pointer;
begin
if csDesigning in ComponentState then
Result:=inherited CreateWindowHandle(AParams)
else begin
NewWidget:=gtk_gl_area_new(Plongint(@InitAttrList));
Result:=longint(NewWidget);
TGTKWidgetSet(InterfaceObject).FinishComponentCreate(Self,NewWidget,true);
end;
end;
procedure TCustomGTKGLAreaControl.UpdateFrameTimeDiff;
var
hour, minutes, secs, msecs, usecs: word;
@ -288,10 +283,27 @@ begin
FLastFrameTime:=FCurrentFrameTime;
end;
{ TWSGTKGLAreaControl }
function TWSGTKGLAreaControl.CreateHandle(const AComponent: TComponent;
const AParams: TCreateParams): THandle;
var
NewWidget: Pointer;
begin
if csDesigning in AComponent.ComponentState then
Result:=inherited CreateHandle(AComponent,AParams)
else begin
NewWidget:=gtk_gl_area_new(Plongint(@InitAttrList));
Result:=longint(NewWidget);
TGTKWidgetSet(InterfaceObject).FinishComponentCreate(AComponent,NewWidget,true);
end;
end;
initialization
{$i gtkglarea.lrs}
GtkGLAreaControlStack:=nil;
RegisterWSComponent(TCustomGTKGLAreaControl,TWSGTKGLAreaControl);
finalization
FreeAndNil(GtkGLAreaControlStack);