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

* fixed crash in checklistbox

Browse Source 
* fixed overwrite of privateclass on inherited update
* fixed overwrite of privateclass with a "lower" class

git-svn-id: trunk@13663 -
This commit is contained in:
marc 2008-01-07 23:58:16 +00:00
parent 07c1e8c99a
commit a174b6e889
11 changed files with 160 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -2961,6 +2961,7 @@ lcl/interfaces/gtk/gtk1extrah.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1int.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtk1memostrings.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1memostringsh.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1privatelist.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1trayicon.inc -text
lcl/interfaces/gtk/gtk1widgetset.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1wsprivate.pp svneol=native#text/pascal
@ -2985,6 +2986,7 @@ lcl/interfaces/gtk/gtklistsl.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtklistslh.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkmsgqueue.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkpagecallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkprivatelist.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkprivatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk/gtkproc.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkproc.pp svneol=native#text/pascal
@ -3042,6 +3044,7 @@ lcl/interfaces/gtk2/gtk2interface.pas svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2lclintf.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2lclintfh.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2memostrings.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2privatelist.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2privatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk2/gtk2themes.pas svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2trayicon.inc -text

26
lcl/interfaces/gtk/gtk1privatelist.inc Normal file
View File

@ -0,0 +1,26 @@
{%mainunit gtk1wsprivate.pp}
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{ TGtk1PrivateList }
class procedure TGtk1PrivateList.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
GTKWidgetSet.SetCallback(LM_SELCHANGE, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
end;

17
lcl/interfaces/gtk/gtk1wsprivate.pp
View File

@ -38,7 +38,7 @@ uses
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc, GtkWSPrivate;
GtkDef, GtkProc, GtkWSPrivate, GtkWsControls, GtkInt;
type
@ -101,6 +101,20 @@ type
public
end;
{ TGtk1PrivateList }
{ Private class for gtklists }
TGtk1PrivateList = class(TGtkPrivateList)
private
protected
public
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
end;
{ TGtk1PrivateNotebook }
{ Private class for gtknotebooks }
TGtk1PrivateNotebook = class(TGtkPrivateNotebook)
private
protected
@ -109,6 +123,7 @@ type
implementation
// {$I Gtk1PrivateWidget.inc}
{$I Gtk1PrivateList.inc}
end.

5
lcl/interfaces/gtk/gtkint.pp
View File

@ -74,7 +74,7 @@ uses
Graphics, Menus, Maps, Themes,
// widgetset
GtkDebug,
GtkFontCache, gtkDef, GtkProc, gtkMsgQueue, GtkExtra, gtkWSPrivate, WSLCLClasses;
GtkFontCache, gtkDef, GtkProc, gtkMsgQueue, GtkExtra, WSLCLClasses;
type
@ -326,8 +326,9 @@ uses
GtkWSSpin,
GtkWSStdCtrls,
// GtkWSToolwin,
GtkThemes,
////////////////////////////////////////////////////
GtkWSPrivate,
GtkThemes,
Buttons, StdCtrls, PairSplitter,
GTKWinApiWindow, ComCtrls, CListBox, Calendar, Arrow, Spin,
ExtCtrls, FileCtrl, LResources, gtkglobals;

24
lcl/interfaces/gtk/gtkprivatelist.inc Normal file
View File

@ -0,0 +1,24 @@
{%mainunit gtk1wsprivate.pp}
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
{ TGtkPrivateList }
class procedure TGtkPrivateList.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
begin
end;

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

@ -37,10 +37,6 @@ uses
SysUtils, Classes, Controls, LMessages, InterfaceBase,
WSControls, WSLCLClasses, WSProc,
Graphics, ComCtrls, Forms, LCLType,
GTKWSPrivate,
{$ifdef gtk1}
GTK1WSPrivate,
{$endif}
GtkDef, GTKExtra;
type
@ -150,6 +146,10 @@ function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
implementation
uses
GTKWSPrivate,
{$ifdef gtk1}
GTK1WSPrivate,
{$endif}
GtkInt, gtkglobals, gtkproc, GTKWinApiWindow,
StdCtrls, LCLProc, LCLIntf;

17
lcl/interfaces/gtk/gtkwsprivate.pp
View File

@ -44,7 +44,7 @@ uses
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc;
GtkDef, GtkProc, GtkWsControls;
type
@ -153,6 +153,16 @@ type
public
end;
{ TGtkPrivateList }
{ Private class for gtklists }
TGtkPrivateListClass = class of TGtkPrivateList;
TGtkPrivateList = class(TGtkPrivateScrolling)
private
protected
public
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
end;
{ TGtkPrivateNotebook }
{ Private class for gtknotebooks }
@ -178,6 +188,10 @@ procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; ARecursive: Boo
implementation
// some circles are needed.
uses
GtkInt;
// Helper functions
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
@ -314,6 +328,7 @@ begin
end;
{$I gtkprivatewidget.inc}
{$I gtkprivatelist.inc}
end.

12
lcl/interfaces/gtk/gtkwsstdctrls.pp
View File

@ -119,7 +119,6 @@ type
protected
public
{$IFDEF GTK1}
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetIndexAtY(const ACustomListBox: TCustomListBox; y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
@ -441,12 +440,6 @@ end;
{ TGtkWSCustomListBox }
{$IFDEF GTK1}
class procedure TGtkWSCustomListBox.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
TGtkWidgetset(Widgetset).SetCallback(LM_SELCHANGE, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
end;
class function TGtkWSCustomListBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
@ -483,7 +476,8 @@ begin
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Set_RC_Name(AWinControl, Widget);
SetCallbacks(Widget, WidgetInfo);
TGtkPrivateListClass(WSPrivate).SetCallbacks(Widget, WidgetInfo);
end;
class function TGtkWSCustomListBox.GetIndexAtY(
@ -2049,12 +2043,12 @@ initialization
// RegisterWSComponent(TGroupBox, TGtkWSGroupBox);
RegisterWSComponent(TCustomComboBox, TGtkWSCustomComboBox);
// RegisterWSComponent(TComboBox, TGtkWSComboBox);
RegisterWSComponent(TCustomListBox, TGtkWSCustomListBox, TGtkPrivateScrolling);
// RegisterWSComponent(TListBox, TGtkWSListBox);
RegisterWSComponent(TCustomEdit, TGtkWSCustomEdit, TGtkPrivateEntry);
RegisterWSComponent(TCustomMemo, TGtkWSCustomMemo, TGtkPrivateScrolling);
// RegisterWSComponent(TButtonControl, TGtkWSButtonControl);
{$ifdef gtk1}
RegisterWSComponent(TCustomListBox, TGtkWSCustomListBox, TGtk1PrivateList);
RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk1PrivateButton);
{$else}
RegisterWSComponent(TCustomButton, TGtkWSButton, TGtk2PrivateButton);

45
lcl/interfaces/gtk2/gtk2privatelist.inc Normal file
View File

@ -0,0 +1,45 @@
{%mainunit gtk2wsprivate.pp}
{
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL, included in this distribution, *
* for details about the copyright. *
* *
* This program is distributed in the hope that it will be useful, *
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
* *
*****************************************************************************
}
procedure Gtk2WS_ListBoxChange(Selection: PGtkTreeSelection; WidgetInfo: PWidgetInfo); cdecl;
var
Mess: TLMessage;
begin
{$IFDEF EventTrace}
EventTrace('Gtk2WS_ListBoxChange', WidgetInfo^.LCLObject);
{$ENDIF}
FillChar(Mess,SizeOf(Mess),0);
Mess.msg := LM_SelChange;
DeliverMessage(WidgetInfo^.LCLObject, Mess);
end;
{ TGtk2PrivateList }
class procedure TGtk2PrivateList.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
var
Selection: PGtkTreeSelection;
begin
TGtkWSBaseScrollingWinControl.SetCallbacks(AGtkWidget,AWidgetInfo);
Selection := gtk_tree_view_get_selection(PGtkTreeView(AWidgetInfo^.CoreWidget));
SignalConnect(PGtkWidget(Selection), 'changed', @Gtk2WS_ListBoxChange, AWidgetInfo);
end;

16
lcl/interfaces/gtk2/gtk2wsprivate.pp
View File

@ -38,7 +38,7 @@ uses
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc, GtkWSPrivate;
GtkDef, GtkProc, GtkWSPrivate, GtkWSControls;
type
@ -102,6 +102,19 @@ type
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
end;
{ TGtk2PrivateList }
{ Private class for gtklists }
TGtk2PrivateList = class(TGtkPrivateList)
private
protected
public
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
end;
{ TGtk2PrivateNotebook }
{ Private class for gtknotebooks }
TGtk2PrivateNotebook = class(TGtkPrivateNotebook)
private
protected
@ -120,6 +133,7 @@ type
implementation
{$I Gtk2PrivateWidget.inc}
{$I Gtk2PrivateList.inc}
end.

32
lcl/interfaces/gtk2/gtk2wsstdctrls.pp
View File

@ -38,7 +38,8 @@ uses
////////////////////////////////////////////////////
glib2, gdk2, gtk2, Pango,
WSControls, WSProc, WSStdCtrls, WSLCLClasses, GtkWSStdCtrls, Gtk2Int, LCLType, GtkDef,
LCLProc, Gtk2CellRenderer, GTKWinApiWindow, gtkglobals, gtkproc, InterfaceBase;
LCLProc, Gtk2CellRenderer, GTKWinApiWindow, gtkglobals, gtkproc, InterfaceBase,
GtkWsPrivate, Gtk2WsPrivate;
type
@ -144,7 +145,6 @@ type
TGtk2WSCustomListBox = class(TGtkWSCustomListBox)
private
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
public
class function GetIndexAtY(const ACustomListBox: TCustomListBox; y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
@ -333,18 +333,6 @@ end;
{ TGtk2WSCustomListBox }
procedure Gtk2WS_ListBoxChange(Selection: PGtkTreeSelection; WidgetInfo: PWidgetInfo); cdecl;
var
Mess: TLMessage;
begin
{$IFDEF EventTrace}
EventTrace('Gtk2WS_ListBoxChange', WidgetInfo^.LCLObject);
{$ENDIF}
FillChar(Mess,SizeOf(Mess),0);
Mess.msg := LM_SelChange;
DeliverMessage(WidgetInfo^.LCLObject, Mess);
end;
procedure StoreFirstSelectedPath(model:PGtkTreeModel; path:PGtkTreePath;
iter:PGtkTreeIter; data:gpointer); cdecl;
begin
@ -575,18 +563,8 @@ begin
end;
WidgetInfo := GetWidgetInfo(p, False);
SetCallbacks(p, WidgetInfo);
end;
class procedure TGtk2WSCustomListBox.SetCallbacks(
const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
var
Selection: PGtkTreeSelection;
begin
TGtkWSBaseScrollingWinControl.SetCallbacks(AGtkWidget,AWidgetInfo);
Selection := gtk_tree_view_get_selection(PGtkTreeView(AWidgetInfo^.CoreWidget));
SignalConnect(PGtkWidget(Selection), 'changed', @Gtk2WS_ListBoxChange, AWidgetInfo);
TGtkPrivateListClass(WSPrivate).SetCallbacks(p, WidgetInfo);
end;
class function TGtk2WSCustomListBox.GetIndexAtY(
@ -1462,7 +1440,7 @@ initialization
// RegisterWSComponent(TGroupBox, TGtk2WSGroupBox);
RegisterWSComponent(TCustomComboBox, TGtk2WSCustomComboBox);
// RegisterWSComponent(TComboBox, TGtk2WSComboBox);
RegisterWSComponent(TCustomListBox, TGtk2WSCustomListBox);
RegisterWSComponent(TCustomListBox, TGtk2WSCustomListBox, TGtk2PrivateList);
// RegisterWSComponent(TListBox, TGtk2WSListBox);
RegisterWSComponent(TCustomEdit, TGtk2WSCustomEdit);
RegisterWSComponent(TCustomMemo, TGtk2WSCustomMemo);