paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-29 09:50:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

Starts separating gtkproc for gtk2 in gtk2proc.

Browse Source 
git-svn-id: trunk@14854 -
This commit is contained in:
sekelsenmat 2008-04-17 01:55:53 +00:00
parent 341d9e3850
commit f098565cff
8 changed files with 255 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -3148,6 +3148,7 @@ lcl/interfaces/gtk/tests/lclclipboardunit.lrs svneol=native#text/plain
lcl/interfaces/gtk/tests/lclclipboardunit.pas svneol=native#text/plain
lcl/interfaces/gtk/tnotebook_close_tab.xpm -text svneol=native#image/x-xpixmap
lcl/interfaces/gtk2/README.txt svneol=native#text/plain
lcl/interfaces/gtk2/gtk2callback.inc svneol=native#text/plan
lcl/interfaces/gtk2/gtk2cellrenderer.pas svneol=native#text/plain
lcl/interfaces/gtk2/gtk2def.pp svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2devicecontext.inc svneol=native#text/pascal
@ -3161,6 +3162,7 @@ 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/gtk2proc.pp svneol=native#text/plan
lcl/interfaces/gtk2/gtk2themes.pas svneol=native#text/pascal
lcl/interfaces/gtk2/gtk2trayicon.inc -text
lcl/interfaces/gtk2/gtk2widgetset.inc svneol=native#text/pascal

140
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -1183,106 +1183,6 @@ begin
DeliverMouseMoveMessage(Widget,Event,TWinControl(Data));
end;
{$IFDEF Gtk2}
function GTKWindowStateEventCB(widget: PGtkWidget;
state: PGdkEventWindowState; data: gpointer): gboolean; cdecl;
var
TheForm: TCustomForm;
SizeMsg: TLMSize;
GtkWidth: LongInt;
GtkHeight: LongInt;
{$IFDEF HasX}
NetAtom: TGdkAtom;
AtomType: TGdkAtom;
AIndex, ADesktop: pguint;
AFormat: gint;
ALength: gint;
{$ENDIF}
begin
Result := CallBackDefaultReturn;
// if iconified in changed then OnIconify...
if GTK_WIDGET_REALIZED(Widget) then
begin
if (GDK_WINDOW_STATE_WITHDRAWN and state^.changed_mask) = 1 then // visibility changed - this is another message block
exit;
if TObject(Data) is TCustomForm then
begin
TheForm := TCustomForm(Data);
//DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
if TheForm.Parent = nil then begin
// toplevel window
// send a WMSize Message (see TCustomForm.WMSize)
// ToDo: this might be too early to use the Widget^.Allocation
// Either send this message later or find a better way to determine the size (including the client area)
GtkWidth:=Widget^.Allocation.Width;
if GtkWidth<0 then GtkWidth:=0;
GtkHeight:=Widget^.Allocation.Height;
if GtkHeight<0 then GtkHeight:=0;
//debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget));
if ((GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state)>0) then
begin
{$IFDEF HasX}
NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True);
if NetAtom > 0 then begin
if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL,
0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex)
then begin
NetAtom := gdk_atom_intern('_NET_CURRENT_DESKTOP', True);
if gdk_property_get(gdk_get_default_root_window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @ADesktop)
then if ADesktop^ <> AIndex^ then begin
// form is not on active desktop => ignore
g_free(ADesktop);
g_free(AIndex);
exit;
end
else begin
g_free(ADesktop);
g_free(AIndex);
end;
end;
end;
{$ENDIF}
SizeMsg.SizeType:=SIZEICONIC;
end
else if (GDK_WINDOW_STATE_MAXIMIZED and state^.new_window_state)>0 then
begin
if (state^.changed_mask and GDK_WINDOW_STATE_MAXIMIZED)=0 then Exit;
SizeMsg.SizeType:=SIZEFULLSCREEN;
end
else
SizeMsg.SizeType:=SIZENORMAL;
// don't bother the LCL if nothing changed
case SizeMsg.SizeType of
SIZENORMAL: if TheForm.WindowState=wsNormal then exit;
SIZEICONIC: if TheForm.WindowState=wsMinimized then exit;
SIZEFULLSCREEN: if TheForm.WindowState=wsMaximized then exit;
end;
with SizeMsg do
begin
Result := 0;
Msg := LM_SIZE;
SizeType := SizeType+Size_SourceIsInterface;
Width := SmallInt(GtkWidth);
Height := SmallInt(GtkHeight);
end;
{$IFDEF VerboseSizeMsg}
DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),
' GTK=',GtkWidth,'x',GtkHeight,
' LCL=',TheForm.Width,'x',TheForm.Height,
' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface'
]);
{$ENDIF}
DeliverMessage(TheForm, SizeMsg);
end;
end;
end;
end;
{$ENDIF}
{-------------------------------------------------------------------------------
function ControlGetsMouseDownBefore(AControl: TControl): boolean;
@ -1645,46 +1545,6 @@ begin
DeliverMouseDownMessage(Widget,Event,TWinControl(Data));
end;
{$IFDEF Gtk2}
function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll;
data: gPointer): GBoolean; cdecl;
var
AWinControl: TWinControl;
EventXY: TPoint;
ShiftState: TShiftState;
MappedXY: TPoint;
MessE : TLMMouseEvent;
begin
Result := CallBackDefaultReturn;
AWinControl:=TWinControl(Data);
EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
ShiftState := GTKEventStateToShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(AWinControl.Handle));
//DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
// this is a mouse wheel event
FillChar(MessE,SizeOf(MessE),0);
MessE.Msg := LM_MOUSEWHEEL;
case event^.direction of
GDK_SCROLL_UP: MessE.WheelDelta := 1;
GDK_SCROLL_DOWN: MessE.WheelDelta := -1;
else
exit;
end;
MessE.X := MappedXY.X;
MessE.Y := MappedXY.Y;
MessE.State := ShiftState;
MessE.UserData := AWinControl;
MessE.Button := 0;
// send the message directly to the LCL
NotifyApplicationUserInput(MessE.Msg);
DeliverMessage(AWinControl, MessE);
end;
{$ENDIF}
{-------------------------------------------------------------------------------
function ControlGetsMouseUpBefore(AControl: TControl): boolean;

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

@ -56,7 +56,7 @@ uses
InterfaceBase,
// gtk
{$IFDEF gtk2}
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
glib2, gdk2pixbuf, gdk2, gtk2, Pango, gtk2proc,
{$ifdef HasGdk2X}
gdk2x,
{$endif}

10
lcl/interfaces/gtk/gtkproc.pp
View File

@ -105,12 +105,6 @@ function gtkchanged_editbox( widget: PGtkWidget; data: gPointer): GBoolean; cdec
function gtkdaychanged(Widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
function gtktoggledCB( widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
{$IFDEF Gtk2}
function GTKWindowStateEventCB(widget: PGtkWidget;
state: PGdkEventWindowState;
data: gpointer): gboolean; cdecl;
{$ENDIF}
{$Ifdef GTK1}
function gtkDrawCB(Widget: PGtkWidget; area: PGDKRectangle;
data: gPointer): GBoolean; cdecl;
@ -164,10 +158,6 @@ function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton;
data: gPointer): GBoolean; cdecl;
function gtkMouseBtnPressAfter(widget: PGtkWidget; event: pgdkEventButton;
data: gPointer): GBoolean; cdecl;
{$IFDEF Gtk2}
function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll;
data: gPointer): GBoolean; cdecl;
{$ENDIF}
function ControlGetsMouseUpBefore(AControl: TControl): boolean;
procedure DeliverMouseUpMessage(widget: PGtkWidget; event: pgdkEventButton;
AWinControl: TWinControl);

14
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -266,6 +266,7 @@ end;
class procedure TGtkWSCustomForm.SetCallbacks(const AWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
{$IFDEF Gtk1}
TGtkWSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then
with TGTKWidgetSet(Widgetset) do
@ -276,15 +277,10 @@ begin
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
end;
{$IFDEF GTK1}
gtk_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget),'map-event', TGtkSignalFunc(@GtkWSFormMapEvent), AWidgetInfo);
gtk_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget),'unmap-event', TGtkSignalFunc(@GtkWSFormUnMapEvent), AWidgetInfo);
{$ENDIF}
{$IFDEF Gtk2}
g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), 'window-state-event',
gtk_signal_func(@GTKWindowStateEventCB),
AWidgetInfo^.LCLObject);
{$ENDIF}
gtk_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget),'map-event', TGtkSignalFunc(@GtkWSFormMapEvent), AWidgetInfo);
gtk_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget),'unmap-event', TGtkSignalFunc(@GtkWSFormUnMapEvent), AWidgetInfo);
{$ENDIF}
end;
class function TGtkWSCustomForm.CreateHandle(const AWinControl: TWinControl;

152
lcl/interfaces/gtk2/gtk2callback.inc Normal file
View File

@ -0,0 +1,152 @@
{%MainUnit gtk2proc.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. *
* *
*****************************************************************************
}
function GTKWindowStateEventCB(widget: PGtkWidget;
state: PGdkEventWindowState; data: gpointer): gboolean; cdecl;
var
TheForm: TCustomForm;
SizeMsg: TLMSize;
GtkWidth: LongInt;
GtkHeight: LongInt;
{$IFDEF HasX}
NetAtom: TGdkAtom;
AtomType: TGdkAtom;
AIndex, ADesktop: pguint;
AFormat: gint;
ALength: gint;
{$ENDIF}
begin
Result := CallBackDefaultReturn;
// if iconified in changed then OnIconify...
if GTK_WIDGET_REALIZED(Widget) then
begin
if (GDK_WINDOW_STATE_WITHDRAWN and state^.changed_mask) = 1 then // visibility changed - this is another message block
exit;
if TObject(Data) is TCustomForm then
begin
TheForm := TCustomForm(Data);
//DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),' new_window_state=',state^.new_window_state,' changed_mask=',state^.changed_mask]);
if TheForm.Parent = nil then begin
// toplevel window
// send a WMSize Message (see TCustomForm.WMSize)
// ToDo: this might be too early to use the Widget^.Allocation
// Either send this message later or find a better way to determine the size (including the client area)
GtkWidth:=Widget^.Allocation.Width;
if GtkWidth<0 then GtkWidth:=0;
GtkHeight:=Widget^.Allocation.Height;
if GtkHeight<0 then GtkHeight:=0;
//debugln('GTKWindowStateEventCB ',DbgSName(TObject(Data)),' ',dbgs(state^.new_window_state),' ',WidgetFlagsToString(Widget));
if ((GDK_WINDOW_STATE_ICONIFIED and state^.new_window_state)>0) then
begin
{$IFDEF HasX}
NetAtom := gdk_atom_intern('_NET_WM_DESKTOP', True);
if NetAtom > 0 then begin
if gdk_property_get(Widget^.window, NetAtom, XA_CARDINAL,
0, 4, 0, @AtomType, @AFormat, @ALength, @AIndex)
then begin
NetAtom := gdk_atom_intern('_NET_CURRENT_DESKTOP', True);
if gdk_property_get(gdk_get_default_root_window, NetAtom, XA_CARDINAL,0, 4, 0, @AtomType, @AFormat, @ALength, @ADesktop)
then if ADesktop^ <> AIndex^ then begin
// form is not on active desktop => ignore
g_free(ADesktop);
g_free(AIndex);
exit;
end
else begin
g_free(ADesktop);
g_free(AIndex);
end;
end;
end;
{$ENDIF}
SizeMsg.SizeType:=SIZEICONIC;
end
else if (GDK_WINDOW_STATE_MAXIMIZED and state^.new_window_state)>0 then
begin
if (state^.changed_mask and GDK_WINDOW_STATE_MAXIMIZED)=0 then Exit;
SizeMsg.SizeType:=SIZEFULLSCREEN;
end
else
SizeMsg.SizeType:=SIZENORMAL;
// don't bother the LCL if nothing changed
case SizeMsg.SizeType of
SIZENORMAL: if TheForm.WindowState=wsNormal then exit;
SIZEICONIC: if TheForm.WindowState=wsMinimized then exit;
SIZEFULLSCREEN: if TheForm.WindowState=wsMaximized then exit;
end;
with SizeMsg do
begin
Result := 0;
Msg := LM_SIZE;
SizeType := SizeType+Size_SourceIsInterface;
Width := SmallInt(GtkWidth);
Height := SmallInt(GtkHeight);
end;
{$IFDEF VerboseSizeMsg}
DebugLn(['GTKWindowStateEventCB ',DbgSName(TheForm),
' GTK=',GtkWidth,'x',GtkHeight,
' LCL=',TheForm.Width,'x',TheForm.Height,
' SizeType=',SizeMsg.SizeType-Size_SourceIsInterface,'+Size_SourceIsInterface'
]);
{$ENDIF}
DeliverMessage(TheForm, SizeMsg);
end;
end;
end;
end;
function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll;
data: gPointer): GBoolean; cdecl;
var
AWinControl: TWinControl;
EventXY: TPoint;
ShiftState: TShiftState;
MappedXY: TPoint;
MessE : TLMMouseEvent;
begin
Result := CallBackDefaultReturn;
AWinControl:=TWinControl(Data);
EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
ShiftState := GTKEventStateToShiftState(Event^.State);
MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
PGtkWidget(AWinControl.Handle));
//DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
// this is a mouse wheel event
FillChar(MessE,SizeOf(MessE),0);
MessE.Msg := LM_MOUSEWHEEL;
case event^.direction of
GDK_SCROLL_UP: MessE.WheelDelta := 1;
GDK_SCROLL_DOWN: MessE.WheelDelta := -1;
else
exit;
end;
MessE.X := MappedXY.X;
MessE.Y := MappedXY.Y;
MessE.State := ShiftState;
MessE.UserData := AWinControl;
MessE.Button := 0;
// send the message directly to the LCL
NotifyApplicationUserInput(MessE.Msg);
DeliverMessage(AWinControl, MessE);
end;

76
lcl/interfaces/gtk2/gtk2proc.pp Normal file
View File

@ -0,0 +1,76 @@
{
----------------------------------
gtk2proc.pp - gtk 2 interface procs
----------------------------------
This unit contains procedures/functions needed for the gtk 2 <-> LCL interface
}
{
*****************************************************************************
* *
* 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 gtk2proc;
{$mode objfpc}{$H+}
interface
{$I gtkdefines.inc}
uses
{$IFDEF windows}
// use windows unit first,
// if not, Rect and Point are taken from the windows unit instead of classes.
Windows, // needed for keyboard handling
{$endif}
{$IFDEF Unix}
baseunix, unix,
{$ENDIF}
SysUtils, Classes, FPCAdds,
{$IFDEF HasX}
XAtom, X, XLib, XUtil, //Font retrieval and Keyboard handling
{$ENDIF}
InterfaceBase,
// gtk2
glib2, gdk2pixbuf, gdk2, gtk2, Pango,
{$ifdef HasGdk2X}
gdk2x,
{$endif}
// Other units
Math, // Math after gtk to get the correct Float type
LMessages, LCLProc, LCLStrConsts, LCLIntf, LCLType, DynHashArray, Maps, Masks,
GraphType, GraphMath, Graphics, GTKWinApiWindow, LResources, Controls, Forms,
Buttons, Menus, StdCtrls, ComCtrls, ExtCtrls, Dialogs, ExtDlgs,
FileUtil, ImgList, GtkFontCache, GTKGlobals, gtkDef, GtkExtra, GtkDebug;
{
Callbacks for events
gtk2callback.inc headers
}
function GTKWindowStateEventCB(widget: PGtkWidget;
state: PGdkEventWindowState;
data: gpointer): gboolean; cdecl;
function gtkMouseWheelCB(widget: PGtkWidget; event: PGdkEventScroll;
data: gPointer): GBoolean; cdecl;
implementation
uses gtkproc; // Remove when separation is complete
{$include gtk2callback.inc}
end.

19
lcl/interfaces/gtk2/gtk2wsforms.pp
View File

@ -76,6 +76,7 @@ type
TGtk2WSCustomForm = class(TWSCustomForm)
private
protected
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
public
class function GetDefaultClientRect(const AWinControl: TWinControl;
const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
@ -121,6 +122,24 @@ implementation
{ TGtk2WSCustomForm }
class procedure TGtk2WSCustomForm.SetCallbacks(const AWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then
with TGTKWidgetSet(Widgetset) do
begin
SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallBack(LM_Activate, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
end;
g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), 'window-state-event',
gtk_signal_func(@GTKWindowStateEventCB), AWidgetInfo^.LCLObject);
end;
class function TGtk2WSCustomForm.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;