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

Gtk2: implemented AppRemoveStayOnTop, AppRestoreStayOnTop also normalize stayOnTop in appactivate & appdeactivate.

Browse Source 
git-svn-id: trunk@25540 -
This commit is contained in:
zeljko 2010-05-20 11:42:56 +00:00
parent 225616d66a
commit 891890b3ab
3 changed files with 89 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/interfaces/gtk/gtkwidgetset.inc
View File

@ -1394,9 +1394,14 @@ begin
begin
FAppActive := AValue;
if FAppActive then
Application.IntfAppActivate
else
begin
Application.IntfAppActivate;
AppRestoreStayOnTopFlags(False);
end else
begin
Application.IntfAppDeactivate;
AppRemoveStayOnTopFlags(False);
end;
end;
end;

6
lcl/interfaces/gtk2/gtk2int.pas
View File

@ -34,7 +34,7 @@ interface
{$I gtkdefines.inc}
uses
Types, Classes, SysUtils, Math,
Types, Classes, SysUtils, Math, maps,
{$IfNDef GTK2_2}
{$IfDef HasX}
XLib, X, //XUtil,
@ -52,6 +52,8 @@ type
{ TGtk2WidgetSet }
TGtk2WidgetSet = class(TGtkWidgetSet)
private
StayOnTopList: TMap;
protected
procedure AppendText(Sender: TObject; Str: PChar);
function GetText(Sender: TComponent; var Text: String): Boolean;
@ -68,6 +70,8 @@ type
procedure AppMinimize; override;
procedure AppRestore; override;
function AppHandle: THandle; override;
function AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; override;
function AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean = False): Boolean; override;
procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: Boolean);override;
procedure SetCommonCallbacks(const AGTKObject: PGTKObject; const ALCLObject: TObject); override;

77
lcl/interfaces/gtk2/gtk2widgetset.inc
View File

@ -565,6 +565,7 @@ end;
constructor TGtk2WidgetSet.Create;
begin
inherited Create;
StayOnTopList := nil;
im_context:=gtk_im_multicontext_new;
g_signal_connect (G_OBJECT (im_context), 'commit',
G_CALLBACK (@gtk_commit_cb), nil);
@ -575,6 +576,11 @@ begin
g_object_unref(im_context);
im_context:=nil;
im_context_widget:=nil;
if StayOnTopList <> nil then
begin
StayOnTopList.Free;
StayOnTopList := nil;
end;
inherited Destroy;
end;
@ -653,6 +659,77 @@ begin
{$endif}
end;
type
TGtk2TempFormStyleSet = Set of TFormStyle;
const
TGtk2TopForms: Array[Boolean] of TGtk2TempFormStyleSet = (fsAllNonSystemStayOnTop,
fsAllStayOnTop);
function TGtk2WidgetSet.AppRemoveStayOnTopFlags(const ASystemTopAlso: Boolean
): Boolean;
var
i: Integer;
AForm: TCustomForm;
W: PGtkWidget;
Flags: TGdkWindowState;
begin
Result := True;
if StayOnTopList = nil then
StayOnTopList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TGtkWidget));
for i := 0 to Screen.CustomFormZOrderCount - 1 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if AForm.HandleAllocated then
begin
W := PGtkWidget(AForm.Handle);
Flags := gdk_window_get_state(W^.Window);
if (AForm.Parent = nil) and
(AForm.FormStyle in TGtk2TopForms[ASystemTopAlso]) and
GTK_WIDGET_VISIBLE(W) and
not gtk_window_get_modal(PGtkWindow(W)) and
(Flags and GDK_WINDOW_STATE_ICONIFIED = 0) then
begin
gdk_window_set_keep_above(W^.Window, False);
if not StayOnTopList.HasId(W) then
StayOnTopList.Add(W, W);
end;
end;
end;
end;
function TGtk2WidgetSet.AppRestoreStayOnTopFlags(const ASystemTopAlso: Boolean
): Boolean;
var
i: Integer;
AForm: TCustomForm;
W: PGtkWidget;
Flags: TGdkWindowState;
begin
Result := True;
if StayOnTopList = nil then
exit;
for i := Screen.CustomFormZOrderCount - 1 downto 0 do
begin
AForm := Screen.CustomFormsZOrdered[i];
if AForm.HandleAllocated then
begin
W := PGtkWidget(AForm.Handle);
Flags := gdk_window_get_state(W^.Window);
if (AForm.Parent = nil) and
(AForm.FormStyle in TGtk2TopForms[ASystemTopAlso]) and
GTK_WIDGET_VISIBLE(W) and
not gtk_window_get_modal(PGtkWindow(W)) and
(Flags and GDK_WINDOW_STATE_ICONIFIED = 0) then
begin
if StayOnTopList.HasId(W) then
gdk_window_set_keep_above(W^.Window, True);
end;
end;
end;
StayOnTopList.Free;
StayOnTopList := nil;
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}