paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-05 18:37:58 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL+gtk intf: improved debugging missing FWidgetSetClass and fixed crash on calling SetCCCallbacks in TGtkWSCustomControl.CreateHandle

Browse Source 
git-svn-id: trunk@13509 -
This commit is contained in:
mattias 2007-12-28 20:52:21 +00:00
parent fb2f004237
commit b0ad5fd977
5 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/include/wincontrol.inc
View File

@ -6462,6 +6462,7 @@ begin
Assert((parent <> nil) or (WndParent = 0), 'TODO: find parent if parent=nil and WndParent <> 0');
end;
//DebugLn(['TWinControl.CreateWnd ',DbgSName(WidgetSetClass),' ',DbgSName(Self)]);
FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params);
if not HandleAllocated then
RaiseGDBException('Handle creation failed creating '+DbgSName(Self));

7
lcl/interfaces/gtk/gtkwscontrols.pp
View File

@ -104,9 +104,8 @@ type
{ TGtkWSCustomControl }
TGtkWSCustomControl = class(TWSCustomControl)
private
protected
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class procedure SetCCCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
public
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
end;
@ -883,7 +882,7 @@ end;
{ TGtkWSCustomControl }
class procedure TGtkWSCustomControl.SetCallbacks(const AWidget: PGtkWidget;
class procedure TGtkWSCustomControl.SetCCCallbacks(const AWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
@ -921,7 +920,7 @@ begin
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
SetCallbacks(Widget, WidgetInfo);
SetCCCallbacks(Widget, WidgetInfo);
end;
initialization

2
lcl/interfaces/gtk/gtkwsgrids.pp
View File

@ -88,4 +88,4 @@ initialization
// RegisterWSComponent(TDrawGrid, TGtkWSDrawGrid);
// RegisterWSComponent(TStringGrid, TGtkWSStringGrid);
////////////////////////////////////////////////////
end.
end.

2
lcl/interfaces/gtk2/gtk2wscontrols.pp
View File

@ -37,6 +37,7 @@ uses
////////////////////////////////////////////////////
Gtk2, Gdk2, Glib2, GtkGlobals,
GtkWsControls,
gtkProc, LCLType,
WSControls, WSLCLClasses, WSProc;
@ -95,7 +96,6 @@ type
implementation
uses gtkproc, lcltype;
{ TGtk2WSWinControl }

7
lcl/lclclasses.pp
View File

@ -106,8 +106,11 @@ class function TLCLComponent.NewInstance: TObject;
begin
Result := inherited NewInstance;
TLCLComponent(Result).FWidgetSetClass := FindWSComponentClass(Self);
if TLCLComponent(Result).FWidgetSetClass = nil
then TLCLComponent(Result).FWidgetSetClass := TWSLCLComponent;
if TLCLComponent(Result).FWidgetSetClass = nil then
begin
DebugLn(['TLCLComponent.NewInstance WARNING: missing FWidgetSetClass ',ClassName]);
TLCLComponent(Result).FWidgetSetClass := TWSLCLComponent;
end;
end;
procedure TLCLComponent.RemoveAllHandlersOfObject(AnObject: TObject);