* part of restructuring

git-svn-id: trunk@10565 -
This commit is contained in:
marc 2007-02-02 01:46:23 +00:00
parent 493364664f
commit b242b1a2d7
11 changed files with 553 additions and 156 deletions

5
.gitattributes vendored
View File

@ -2449,6 +2449,7 @@ lcl/interfaces/gtk/gtk1extra.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1extrah.inc svneol=native#text/pascal lcl/interfaces/gtk/gtk1extrah.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1memostrings.inc 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/gtk1memostringsh.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtk1private.pp svneol=native#text/plain
lcl/interfaces/gtk/gtkcallback.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkcomboboxcallback.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkcomboboxcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkdef.pp svneol=native#text/pascal lcl/interfaces/gtk/gtkdef.pp svneol=native#text/pascal
@ -2470,6 +2471,8 @@ lcl/interfaces/gtk/gtklistviewcallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkmsgqueue.pp svneol=native#text/pascal lcl/interfaces/gtk/gtkmsgqueue.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkobject.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkobject.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkpagecallback.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkpagecallback.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkprivate.pp svneol=native#text/plain
lcl/interfaces/gtk/gtkprivatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk/gtkproc.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkproc.inc svneol=native#text/pascal
lcl/interfaces/gtk/gtkproc.pp svneol=native#text/pascal lcl/interfaces/gtk/gtkproc.pp svneol=native#text/pascal
lcl/interfaces/gtk/gtkwinapi.inc svneol=native#text/pascal lcl/interfaces/gtk/gtkwinapi.inc svneol=native#text/pascal
@ -2521,6 +2524,8 @@ lcl/interfaces/gtk2/gtk2lclintf.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2lclintfh.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/gtk2memostrings.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2object.inc svneol=native#text/pascal lcl/interfaces/gtk2/gtk2object.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2private.pp svneol=native#text/plain
lcl/interfaces/gtk2/gtk2privatewidget.inc svneol=native#text/plain
lcl/interfaces/gtk2/gtk2winapi.inc svneol=native#text/pascal lcl/interfaces/gtk2/gtk2winapi.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2winapih.inc svneol=native#text/pascal lcl/interfaces/gtk2/gtk2winapih.inc svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2wsactnlist.pp svneol=native#text/pascal lcl/interfaces/gtk2/gtk2wsactnlist.pp svneol=native#text/pascal

View File

@ -0,0 +1,106 @@
{ $Id: $ }
{
----------------------------------------
gtk1private.pp - Gtk1 internal classes
----------------------------------------
@created(Thu Feb 1st WET 2007)
@lastmod($Date: $)
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
This unit contains the private classhierarchy for the gtk implemetations
This hierarchy reflects (more or less) the gtk widget hierarchy
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
unit Gtk1Private;
{$mode objfpc}{$H+}
interface
uses
// libs
// LCL
LCLType, LMessages, LCLProc, Controls, Classes, SysUtils, Forms,
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc, GtkPrivate;
type
{ TGtk1PrivateWidget }
{ Private class for gtkwidgets }
TGtk1PrivateWidget = class(TGtkPrivateWidget)
private
protected
public
end;
{ TGtk1PrivateContainer }
{ Private class for gtkcontainers }
TGtk1PrivateContainer = class(TGtkPrivateContainer)
private
protected
public
end;
{ TGtk1PrivateBin }
{ Private class for gtkbins }
TGtk1PrivateBin = class(TGtkPrivateBin)
private
protected
public
end;
{ TGtk1PrivateWindow }
{ Private class for gtkwindows }
TGtk1PrivateWindow = class(TGtkPrivateWindow)
private
protected
public
end;
{ TGtk1PrivateDialog }
{ Private class for gtkdialogs }
TGtk1PrivateDialog = class(TGtkPrivateDialog)
private
protected
public
end;
{ TGtk1PrivateButton }
{ Private class for gtkbuttons }
TGtk1PrivateButton = class(TGtkPrivateButton)
private
protected
public
end;
implementation
end.

View File

@ -40,7 +40,7 @@ interface
{$endif} {$endif}
{$ifdef gtk2} {$ifdef gtk2}
{$I gtk2extrah.inc} {$I ../gtk2/gtk2extrah.inc}
{$endif} {$endif}
@ -51,7 +51,7 @@ implementation
{$endif} {$endif}
{$ifdef gtk2} {$ifdef gtk2}
{$I gtk2extra.inc} {$I ../gtk2/gtk2extra.inc}
{$endif} {$endif}
end. end.

View File

@ -0,0 +1,249 @@
{ $Id: $ }
{
----------------------------------------
Gtkprivate.pp - Gtk internal classes
----------------------------------------
@created(Thu Feb 1st WET 2007)
@lastmod($Date: $)
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
This unit contains the private classhierarchy for the gtk implemetations
This hierarchy reflects (more or less) the gtk widget hierarchy
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
unit GtkPrivate;
{$mode objfpc}{$H+}
interface
uses
// libs
{$IFDEF GTK2}
Gtk2, Glib2, Gdk2,
{$ELSE}
Gtk, Glib, Gdk,
{$ENDIF}
// LCL
LCLType, LMessages, LCLProc, Controls, Classes, SysUtils, Forms,
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc;
type
{ TGtkPrivate }
{ Generic base class, don't know if it is needed }
TGtkPrivate = class(TWSPrivate)
private
protected
public
end;
{ TGtkPrivateWidget }
{ Private class for all gtk widgets }
TGtkPrivateWidget = class(TGtkPrivate)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
class procedure UpdateCursor(AInfo: PWidgetInfo); virtual;
end;
TGtkPrivateWidgetClass = class of TGtkPrivateWidget;
{ TGtkPrivateContainer }
{ Private class for gtkcontainers }
TGtkPrivateContainer = class(TGtkPrivateWidget)
private
protected
public
end;
{ ------------------------------------}
{ temp classes to keep things working }
{ TGtkWSScrollingPrivate }
{ we may want to use something like a compund class }
TGtkPrivateScrolling = class(TGtkPrivateContainer)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
end;
TGtkPrivateScrollingWinControl = class(TGtkPrivateScrolling)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
end;
{ ------------------------------------}
{ TGtkPrivateBin }
{ Private class for gtkbins }
TGtkPrivateBin = class(TGtkPrivateContainer)
private
protected
public
end;
{ TGtkPrivateWindow }
{ Private class for gtkwindows }
TGtkPrivateWindow = class(TGtkPrivateBin)
private
protected
public
end;
{ TGtkPrivateDialog }
{ Private class for gtkdialogs }
TGtkPrivateDialog = class(TGtkPrivateWindow)
private
protected
public
end;
{ TGtkPrivateButton }
{ Private class for gtkbuttons }
TGtkPrivateButton = class(TGtkPrivateBin)
private
protected
public
end;
implementation
// Helper functions
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
var
Children: PGList;
begin
Result := PGTKWidget(AHandle);
while (Result <> nil) and GTK_WIDGET_NO_WINDOW(Result)
and GtkWidgetIsA(Result,gtk_container_get_type) do
begin
Children := gtk_container_children(PGtkContainer(Result));
if Children = nil
then Result := nil
else Result := Children^.Data;
end;
end;
{ TGtkPrivateScrolling }
{ temp class to keep things working }
class procedure TGtkPrivateScrolling.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
ScrollWidget: PGtkScrolledWindow;
// WidgetInfo: PWidgetInfo;
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
ScrollWidget := Pointer(AWinControl.Handle);
// WidgetInfo := GetWidgetInfo(ScrollWidget);
// Some controls have viewports, so we get the first window.
Widget := GetWidgetWithWindow(AWinControl.Handle);
case APosition of
wszpBack: begin
//gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
gdk_window_lower(Widget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
end;
wszpFront: begin
//gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
gdk_window_raise(Widget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
end;
end;
end;
{ TGtkPrivateScrollingWinControl }
class procedure TGtkPrivateScrollingWinControl.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
Widget: PGtkWidget;
ScrollWidget: PGtkScrolledWindow;
// WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
//TODO: when all scrolling controls are "derived" from TGtkWSBaseScrollingWinControl
// retrieve scrollbars from WidgetInfo^.Userdata. In that case, the following
// code can be removed and a call to TGtkWSBaseScrollingWinControl.SetZPosition
// can be made. This is not possible now since we have a frame around us
Widget := Pointer(AWinControl.Handle);
// WidgetInfo := GetWidgetInfo(Widget);
ScrollWidget := PGtkScrolledWindow(PGtkFrame(Widget)^.Bin.Child);
// Only do the scrollbars, leave the core to the default (we might have a viewport)
TGtkPrivateWidget.SetZPosition(AWinControl, APosition);
case APosition of
wszpBack: begin
// gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
end;
wszpFront: begin
// gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
end;
end;
end;
{$I gtkprivatewidget.inc}
end.

View File

@ -0,0 +1,46 @@
{%mainunit gtkprivate.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. *
* *
*****************************************************************************
}
{ TGtkPrivateWidget }
class procedure TGtkPrivateWidget.UpdateCursor(AInfo: PWidgetInfo);
begin
//move code from gtkproc.inc here
end;
class procedure TGtkPrivateWidget.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
Widget := GetWidgetWithWindow(AWincontrol.Handle);
if Widget = nil then Exit;
if Widget^.Window=nil then exit;
case APosition of
wszpBack: begin
gdk_window_lower(Widget^.Window);
end;
wszpFront: begin
gdk_window_raise(Widget^.Window);
end;
end;
end;

View File

@ -39,7 +39,7 @@ uses
// widgetset // widgetset
WSComCtrls, WSLCLClasses, WSProc, WSControls, WSComCtrls, WSLCLClasses, WSProc, WSControls,
// interface // interface
GtkDef, GtkExtra; GtkDef, GtkExtra, GtkPrivate;
type type
@ -449,7 +449,7 @@ initialization
RegisterWSComponent(TStatusBar, TGtkWSStatusBar); RegisterWSComponent(TStatusBar, TGtkWSStatusBar);
// RegisterWSComponent(TCustomTabSheet, TGtkWSTabSheet); // RegisterWSComponent(TCustomTabSheet, TGtkWSTabSheet);
// RegisterWSComponent(TCustomPageControl, TGtkWSPageControl); // RegisterWSComponent(TCustomPageControl, TGtkWSPageControl);
RegisterWSComponent(TCustomListView, TGtkWSCustomListView, TGtkWSScrollingPrivate); RegisterWSComponent(TCustomListView, TGtkWSCustomListView, TGtkPrivateScrolling);
// RegisterWSComponent(TCustomListView, TGtkWSListView); // RegisterWSComponent(TCustomListView, TGtkWSListView);
RegisterWSComponent(TCustomProgressBar, TGtkWSProgressBar); RegisterWSComponent(TCustomProgressBar, TGtkWSProgressBar);
// RegisterWSComponent(TCustomUpDown, TGtkWSCustomUpDown); // RegisterWSComponent(TCustomUpDown, TGtkWSCustomUpDown);

View File

@ -36,7 +36,12 @@ uses
{$ENDIF} {$ENDIF}
SysUtils, Classes, Controls, LMessages, InterfaceBase, SysUtils, Classes, Controls, LMessages, InterfaceBase,
WSControls, WSLCLClasses, WSProc, WSControls, WSLCLClasses, WSProc,
Graphics, ComCtrls, GtkDef, GTKExtra, LCLType; Graphics, ComCtrls, LCLType,
GTKPrivate,
{$ifdef gtk1}
GTK1Private,
{$endif}
GtkDef, GTKExtra;
type type
@ -56,16 +61,6 @@ type
public public
end; end;
{ TGtkWSWinControlPrivate }
TGtkWSWinControlPrivate = class(TWSPrivate)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
end;
TGtkWSWinControlPrivateClass = class of TGtkWSWinControlPrivate;
{ TGtkWSWinControl } { TGtkWSWinControl }
@ -146,16 +141,6 @@ type
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
end; end;
{ TGtkWSScrollingPrivate }
TGtkWSScrollingPrivate = class(TGtkWSWinControlPrivate)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
end;
procedure GtkWindowShowModal(GtkWindow: PGtkWindow); procedure GtkWindowShowModal(GtkWindow: PGtkWindow);
function GetWidgetHAdjustment(AWidget: PGTKWidget): PGTKAdjustment; function GetWidgetHAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment; function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
@ -167,23 +152,6 @@ uses
StdCtrls, LCLProc, LCLIntf; StdCtrls, LCLProc, LCLIntf;
// Helper functions
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
var
Children: PGList;
begin
Result := PGTKWidget(AHandle);
while (Result <> nil) and GTK_WIDGET_NO_WINDOW(Result)
and GtkWidgetIsA(Result,gtk_container_get_type) do
begin
Children := gtk_container_children(PGtkContainer(Result));
if Children = nil
then Result := nil
else Result := Children^.Data;
end;
end;
{ TGtkWSWinControl } { TGtkWSWinControl }
@ -369,7 +337,7 @@ begin
begin begin
child := TWinControlHack(AChildren[n]); child := TWinControlHack(AChildren[n]);
if child.HandleAllocated if child.HandleAllocated
then TGtkWSWinControlPrivateClass(child.WidgetSetClass.WSPrivate). then TGtkPrivateWidgetClass(child.WidgetSetClass.WSPrivate).
SetZPosition(child, wszpBack); SetZPosition(child, wszpBack);
end; end;
end end
@ -379,7 +347,7 @@ begin
begin begin
child := TWinControlHack(AChildren[n]); child := TWinControlHack(AChildren[n]);
if child.HandleAllocated if child.HandleAllocated
then TGtkWSWinControlPrivateClass(child.WidgetSetClass.WSPrivate).SetZPosition(child, wszpFront); then TGtkPrivateWidgetClass(child.WidgetSetClass.WSPrivate).SetZPosition(child, wszpFront);
end; end;
end; end;
end; end;
@ -626,29 +594,6 @@ begin
Assert(False, Format('trace: [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName])); Assert(False, Format('trace: [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName]));
end; end;
{ TGtkWSWinControlPrivate }
class procedure TGtkWSWinControlPrivate.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
Widget := GetWidgetWithWindow(AWincontrol.Handle);
if Widget = nil then Exit;
if Widget^.Window=nil then exit;
case APosition of
wszpBack: begin
gdk_window_lower(Widget^.Window);
end;
wszpFront: begin
gdk_window_raise(Widget^.Window);
end;
end;
end;
{ helper/common routines } { helper/common routines }
@ -881,42 +826,6 @@ begin
); );
end; end;
{ TGtkWSScrollingPrivate }
class procedure TGtkWSScrollingPrivate.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
ScrollWidget: PGtkScrolledWindow;
// WidgetInfo: PWidgetInfo;
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
ScrollWidget := Pointer(AWinControl.Handle);
// WidgetInfo := GetWidgetInfo(ScrollWidget);
// Some controls have viewports, so we get the first window.
Widget := GetWidgetWithWindow(AWinControl.Handle);
case APosition of
wszpBack: begin
//gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
gdk_window_lower(Widget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
end;
wszpFront: begin
//gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
gdk_window_raise(Widget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
end;
end;
end;
initialization initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
@ -927,7 +836,7 @@ initialization
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
// RegisterWSComponent(TDragImageList, TGtkWSDragImageList); // RegisterWSComponent(TDragImageList, TGtkWSDragImageList);
// RegisterWSComponent(TControl, TGtkWSControl); // RegisterWSComponent(TControl, TGtkWSControl);
RegisterWSComponent(TWinControl, TGtkWSWinControl, TGtkWSWinControlPrivate); RegisterWSComponent(TWinControl, TGtkWSWinControl, TGtkPrivateWidget);
// RegisterWSComponent(TGraphicControl, TGtkWSGraphicControl); // RegisterWSComponent(TGraphicControl, TGtkWSGraphicControl);
// RegisterWSComponent(TCustomControl, TGtkWSCustomControl); // RegisterWSComponent(TCustomControl, TGtkWSCustomControl);
// RegisterWSComponent(TImageList, TGtkWSImageList); // RegisterWSComponent(TImageList, TGtkWSImageList);

View File

@ -35,7 +35,7 @@ uses
SysUtils, Classes, LCLProc, LCLType, Controls, LMessages, InterfaceBase, SysUtils, Classes, LCLProc, LCLType, Controls, LMessages, InterfaceBase,
Graphics, Dialogs,Forms, Math, Graphics, Dialogs,Forms, Math,
WSDialogs, WSLCLClasses, WSControls, WSForms, WSProc, WSDialogs, WSLCLClasses, WSControls, WSForms, WSProc,
gtkInt, gtkProc, gtkWSControls, gtkDef, gtkExtra; gtkInt, gtkProc, gtkWSControls, gtkDef, gtkExtra, GtkPrivate;
type type
@ -48,13 +48,6 @@ type
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override; class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
end; end;
TGtkWSScrollingWinControlPrivate = class(TGtkWSScrollingPrivate)
private
protected
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
end;
{ TGtkWSScrollBox } { TGtkWSScrollBox }
TGtkWSScrollBox = class(TWSScrollBox) TGtkWSScrollBox = class(TWSScrollBox)
@ -139,47 +132,7 @@ class procedure TGtkWSScrollingWinControl.ScrollBy(const AWinControl: TScrolling
begin begin
end; end;
{ TGtkWSScrollingWinControlPrivate }
class procedure TGtkWSScrollingWinControlPrivate.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
var
Widget: PGtkWidget;
ScrollWidget: PGtkScrolledWindow;
// WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
then Exit;
//TODO: when all scrolling controls are "derived" from TGtkWSBaseScrollingWinControl
// retrieve scrollbars from WidgetInfo^.Userdata. In that case, the following
// code can be removed and a call to TGtkWSBaseScrollingWinControl.SetZPosition
// can be made. This is not possible now since we have a frame around us
Widget := Pointer(AWinControl.Handle);
// WidgetInfo := GetWidgetInfo(Widget);
ScrollWidget := PGtkScrolledWindow(PGtkFrame(Widget)^.Bin.Child);
// Only do the scrollbars, leave the core to the default (we might have a viewport)
TGtkWSWinControlPrivate.SetZPosition(AWinControl, APosition);
case APosition of
wszpBack: begin
// gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
end;
wszpFront: begin
// gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
if ScrollWidget^.hscrollbar <> nil
then gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
if ScrollWidget^.vscrollbar <> nil
then gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
end;
end;
end;
{ TGtkWSCustomForm } { TGtkWSCustomForm }
{$IFDEF GTK1} {$IFDEF GTK1}
@ -335,7 +288,7 @@ initialization
// To improve speed, register only classes // To improve speed, register only classes
// which actually implement something // which actually implement something
//////////////////////////////////////////////////// ////////////////////////////////////////////////////
RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl, TGtkWSScrollingWinControlPrivate); RegisterWSComponent(TScrollingWinControl, TGtkWSScrollingWinControl, TGtkPrivateScrollingWinControl);
// RegisterWSComponent(TScrollBox, TGtkWSScrollBox); // RegisterWSComponent(TScrollBox, TGtkWSScrollBox);
// RegisterWSComponent(TCustomFrame, TGtkWSCustomFrame); // RegisterWSComponent(TCustomFrame, TGtkWSCustomFrame);
// RegisterWSComponent(TFrame, TGtkWSFrame); // RegisterWSComponent(TFrame, TGtkWSFrame);

View File

@ -34,7 +34,7 @@ uses
glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache, glib, gdk, gtk, {$Ifndef NoGdkPixbufLib}gdkpixbuf,{$EndIf} GtkFontCache,
{$ENDIF} {$ENDIF}
WSStdCtrls, WSLCLClasses, WSProc, WSControls, GtkInt, LCLType, GtkDef, LCLProc, WSStdCtrls, WSLCLClasses, WSProc, WSControls, GtkInt, LCLType, GtkDef, LCLProc,
GTKWinApiWindow, gtkglobals, gtkproc, gtkExtra, InterfaceBase; GTKWinApiWindow, gtkglobals, gtkproc, gtkExtra, GtkPrivate, InterfaceBase;
type type
@ -1208,10 +1208,10 @@ initialization
// RegisterWSComponent(TGroupBox, TGtkWSGroupBox); // RegisterWSComponent(TGroupBox, TGtkWSGroupBox);
RegisterWSComponent(TCustomComboBox, TGtkWSCustomComboBox); RegisterWSComponent(TCustomComboBox, TGtkWSCustomComboBox);
// RegisterWSComponent(TComboBox, TGtkWSComboBox); // RegisterWSComponent(TComboBox, TGtkWSComboBox);
RegisterWSComponent(TCustomListBox, TGtkWSCustomListBox, TGtkWSScrollingPrivate); RegisterWSComponent(TCustomListBox, TGtkWSCustomListBox, TGtkPrivateScrolling);
// RegisterWSComponent(TListBox, TGtkWSListBox); // RegisterWSComponent(TListBox, TGtkWSListBox);
RegisterWSComponent(TCustomEdit, TGtkWSCustomEdit); RegisterWSComponent(TCustomEdit, TGtkWSCustomEdit);
RegisterWSComponent(TCustomMemo, TGtkWSCustomMemo, TGtkWSScrollingPrivate); RegisterWSComponent(TCustomMemo, TGtkWSCustomMemo, TGtkPrivateScrolling);
// RegisterWSComponent(TButtonControl, TGtkWSButtonControl); // RegisterWSComponent(TButtonControl, TGtkWSButtonControl);
RegisterWSComponent(TCustomCheckBox, TGtkWSCustomCheckBox); RegisterWSComponent(TCustomCheckBox, TGtkWSCustomCheckBox);
// RegisterWSComponent(TCheckBox, TGtkWSCheckBox); // RegisterWSComponent(TCheckBox, TGtkWSCheckBox);

View File

@ -0,0 +1,107 @@
{ $Id: $ }
{
----------------------------------------
gtk2private.pp - Gtk2 internal classes
----------------------------------------
@created(Thu Feb 1st WET 2007)
@lastmod($Date: $)
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
This unit contains the private classhierarchy for the gtk implemetations
This hierarchy reflects (more or less) the gtk widget hierarchy
*****************************************************************************
* *
* 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. *
* *
*****************************************************************************
}
unit Gtk2Private;
{$mode objfpc}{$H+}
interface
uses
// libs
// LCL
LCLType, LMessages, LCLProc, Controls, Classes, SysUtils, Forms,
// widgetset
WSControls, WSLCLClasses, WSProc,
// interface
GtkDef, GtkProc, GtkPrivate;
type
{ TGtk2PrivateWidget }
{ Private class for gtkwidgets }
TGtk2PrivateWidget = class(TGtkPrivateWidget)
private
protected
public
end;
{ TGtk2PrivateContainer }
{ Private class for gtkcontainers }
TGtk2PrivateContainer = class(TGtkPrivateContainer)
private
protected
public
end;
{ TGtk2PrivateBin }
{ Private class for gtkbins }
TGtk2PrivateBin = class(TGtkPrivateBin)
private
protected
public
end;
{ TGtk2PrivateWindow }
{ Private class for gtkwindows }
TGtk2PrivateWindow = class(TGtkPrivateWindow)
private
protected
public
end;
{ TGtk2PrivateDialog }
{ Private class for gtkdialogs }
TGtk2PrivateDialog = class(TGtkPrivateDialog)
private
protected
public
end;
{ TGtk2PrivateButton }
{ Private class for gtkbuttons }
TGtk2PrivateButton = class(TGtkPrivateButton)
private
protected
public
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
end;
implementation
end.

View File

@ -0,0 +1,22 @@
{%mainunit gtkprivate.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. *
* *
*****************************************************************************
}
class procedure TGtk2PrivateWidget.UpdateCursor(AInfo: PWidgetInfo);
begin
//specific button code here
end;