mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-30 23:42:41 +02:00
Fixes form events in gtk2 and further separates the widgetsets.
git-svn-id: trunk@14862 -
This commit is contained in:
sekelsenmat
parent
1490cecace
commit
58d9858249
@ -156,7 +156,7 @@ uses
|
||||
Gtk2WSExtCtrls,
|
||||
// Gtk2WSExtDlgs,
|
||||
// Gtk2WSFileCtrl,
|
||||
// Gtk2WSForms,
|
||||
Gtk2WSForms,
|
||||
// Gtk2WSGrids,
|
||||
// Gtk2WSImgList,
|
||||
// Gtk2WSMaskEdit,
|
||||
|
||||
@ -27,21 +27,22 @@ unit Gtk2WSForms;
|
||||
interface
|
||||
|
||||
uses
|
||||
////////////////////////////////////////////////////
|
||||
// I M P O R T A N T
|
||||
////////////////////////////////////////////////////
|
||||
// To get as little as posible circles,
|
||||
// uncomment only when needed for registration
|
||||
////////////////////////////////////////////////////
|
||||
// Forms,
|
||||
////////////////////////////////////////////////////
|
||||
WSForms, WSLCLClasses, Forms, GTKProc;
|
||||
// Bindings
|
||||
Gtk2, Glib2, gdk2,
|
||||
// RTL, FCL, LCL
|
||||
SysUtils, Classes, LCLProc, LCLType, Controls, LMessages, InterfaceBase,
|
||||
Graphics, Dialogs,Forms, Math,
|
||||
// Widgetset
|
||||
WSDialogs, WSLCLClasses, WSControls, WSForms, WSProc,
|
||||
Gtk2Int, GtkProc, gtk2proc, GtkDef, GtkExtra, GtkGlobals, Gtk2WSControls,
|
||||
// Gtk 1 stuff
|
||||
gtkwsforms;
|
||||
|
||||
type
|
||||
|
||||
{ TGtk2WSScrollingWinControl }
|
||||
|
||||
TGtk2WSScrollingWinControl = class(TWSScrollingWinControl)
|
||||
TGtk2WSScrollingWinControl = class(TGtkWSScrollingWinControl)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -49,7 +50,7 @@ type
|
||||
|
||||
{ TGtk2WSScrollBox }
|
||||
|
||||
TGtk2WSScrollBox = class(TWSScrollBox)
|
||||
TGtk2WSScrollBox = class(TGtkWSScrollBox)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -57,7 +58,7 @@ type
|
||||
|
||||
{ TGtk2WSCustomFrame }
|
||||
|
||||
TGtk2WSCustomFrame = class(TWSCustomFrame)
|
||||
TGtk2WSCustomFrame = class(TGtkWSCustomFrame)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -65,7 +66,7 @@ type
|
||||
|
||||
{ TGtk2WSFrame }
|
||||
|
||||
TGtk2WSFrame = class(TWSFrame)
|
||||
TGtk2WSFrame = class(TGtkWSFrame)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -73,21 +74,23 @@ type
|
||||
|
||||
{ TGtk2WSCustomForm }
|
||||
|
||||
TGtk2WSCustomForm = class(TWSCustomForm)
|
||||
TGtk2WSCustomForm = class(TGtkWSCustomForm)
|
||||
private
|
||||
protected
|
||||
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
|
||||
public
|
||||
class function GetDefaultClientRect(const AWinControl: TWinControl;
|
||||
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
|
||||
|
||||
{ class function GetDefaultClientRect(const AWinControl: TWinControl;
|
||||
const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
|
||||
): boolean; override;
|
||||
class procedure SetBorderIcons(const AForm: TCustomForm;
|
||||
const ABorderIcons: TBorderIcons); override;
|
||||
const ABorderIcons: TBorderIcons); override;}
|
||||
end;
|
||||
|
||||
{ TGtk2WSForm }
|
||||
|
||||
TGtk2WSForm = class(TWSForm)
|
||||
TGtk2WSForm = class(TGtkWSForm)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -95,7 +98,7 @@ type
|
||||
|
||||
{ TGtk2WSHintWindow }
|
||||
|
||||
TGtk2WSHintWindow = class(TWSHintWindow)
|
||||
TGtk2WSHintWindow = class(TGtkWSHintWindow)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -103,7 +106,7 @@ type
|
||||
|
||||
{ TGtk2WSScreen }
|
||||
|
||||
TGtk2WSScreen = class(TWSScreen)
|
||||
TGtk2WSScreen = class(TGtkWSScreen)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -111,7 +114,7 @@ type
|
||||
|
||||
{ TGtk2WSApplicationProperties }
|
||||
|
||||
TGtk2WSApplicationProperties = class(TWSApplicationProperties)
|
||||
TGtk2WSApplicationProperties = class(TGtkWSApplicationProperties)
|
||||
private
|
||||
protected
|
||||
public
|
||||
@ -127,7 +130,7 @@ class procedure TGtk2WSCustomForm.SetCallbacks(const AWidget: PGtkWidget;
|
||||
begin
|
||||
TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
|
||||
if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then
|
||||
with TGTKWidgetSet(Widgetset) do
|
||||
with TGTK2WidgetSet(Widgetset) do
|
||||
begin
|
||||
SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
|
||||
SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
|
||||
@ -140,7 +143,105 @@ begin
|
||||
gtk_signal_func(@GTKWindowStateEventCB), AWidgetInfo^.LCLObject);
|
||||
end;
|
||||
|
||||
class function TGtk2WSCustomForm.GetDefaultClientRect(
|
||||
class function TGtk2WSCustomForm.CreateHandle(const AWinControl: TWinControl;
|
||||
const AParams: TCreateParams): TLCLIntfHandle;
|
||||
var
|
||||
WidgetInfo: PWidgetInfo;
|
||||
p: pointer; // ptr to the newly created GtkWidget
|
||||
Box: Pointer;
|
||||
ABorderStyle: TFormBorderStyle;
|
||||
WindowType: TGtkWindowType;
|
||||
ACustomForm: TCustomForm;
|
||||
AResizable: gint;
|
||||
begin
|
||||
// Start of old CreateForm method
|
||||
|
||||
ACustomForm := TCustomForm(AWinControl);
|
||||
|
||||
if ACustomForm.Parent = nil then
|
||||
begin
|
||||
if csDesigning in ACustomForm.ComponentState then
|
||||
ABorderStyle:=bsSizeable
|
||||
else
|
||||
ABorderStyle:=ACustomForm.BorderStyle;
|
||||
end
|
||||
else
|
||||
ABorderStyle:=bsNone;
|
||||
|
||||
// Maps the border style
|
||||
WindowType := FormStyleMap[ABorderStyle];
|
||||
if (ABorderStyle=bsNone) and (ACustomForm.FormStyle in fsAllStayOnTop) then
|
||||
WindowType := GTK_WINDOW_POPUP;
|
||||
if (csDesigning in ACustomForm.ComponentState) then
|
||||
WindowType := GTK_WINDOW_TOPLEVEL;
|
||||
|
||||
if ACustomForm.Parent = nil then
|
||||
begin
|
||||
// create a floating form
|
||||
P := gtk_window_new(WindowType);
|
||||
|
||||
// Sets the window as resizable or not
|
||||
// Depends on the WM supporting this
|
||||
if (csDesigning in ACustomForm.ComponentState) then AResizable := 1
|
||||
else AResizable := FormResizableMap[ABorderStyle];
|
||||
|
||||
// gtk_window_set_policy is deprecated in Gtk2
|
||||
{$IFDEF Gtk2}
|
||||
gtk_window_set_resizable(GTK_WINDOW(P), gboolean(AResizable));
|
||||
{$ELSE}
|
||||
gtk_window_set_policy(GTK_WINDOW(P), AResizable, AResizable, 0);
|
||||
{$ENDIF}
|
||||
|
||||
// Sets the title
|
||||
gtk_window_set_title(PGtkWindow(P), AParams.Caption);
|
||||
|
||||
// the clipboard needs a widget
|
||||
if (ClipboardWidget = nil) then
|
||||
Gtk2WidgetSet.SetClipboardWidget(P);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// create a form as child control
|
||||
P := gtk_hbox_new(false, 0);
|
||||
end;
|
||||
|
||||
WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams);
|
||||
|
||||
Box := CreateFormContents(ACustomForm, P);
|
||||
gtk_container_add(PGtkContainer(P), Box);
|
||||
|
||||
{$IfDef GTK2}
|
||||
//so we can double buffer ourselves, eg, the Form Designer
|
||||
gtk_widget_set_double_buffered(Box, False);
|
||||
{$EndIf}
|
||||
|
||||
gtk_widget_show(Box);
|
||||
|
||||
// main menu
|
||||
if (ACustomForm.Menu <> nil) and (ACustomForm.Menu.HandleAllocated) then
|
||||
begin
|
||||
gtk_box_pack_start(Box, PGtkWidget(ACustomForm.Menu.Handle), False, False,0);
|
||||
end;
|
||||
|
||||
// End of the old CreateForm method
|
||||
|
||||
{$IFNDEF NoStyle}
|
||||
if (ACustomForm.Parent = nil) then
|
||||
gtk_widget_set_app_paintable(P, True);
|
||||
{$ENDIF}
|
||||
|
||||
if not (csDesigning in AWinControl.ComponentState) then
|
||||
WidgetInfo^.UserData := Pointer(1);
|
||||
|
||||
{$IFDEF DebugLCLComponents}
|
||||
DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl));
|
||||
{$ENDIF}
|
||||
Result := TLCLIntfHandle(PtrUInt(P));
|
||||
Set_RC_Name(AWinControl, P);
|
||||
SetCallbacks(P, WidgetInfo);
|
||||
end;
|
||||
|
||||
{class function TGtk2WSCustomForm.GetDefaultClientRect(
|
||||
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
|
||||
var aClientRect: TRect): boolean;
|
||||
begin
|
||||
@ -160,7 +261,7 @@ class procedure TGtk2WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
|
||||
const ABorderIcons: TBorderIcons);
|
||||
begin
|
||||
gtk_window_get_modal();
|
||||
end;
|
||||
end;}
|
||||
|
||||
initialization
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user