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

gtk: another attempt to fix focus of controls on another forms (bug #0013004). Now without endless flickering.

Browse Source 
git-svn-id: trunk@18455 -
This commit is contained in:
paul 2009-01-27 03:29:02 +00:00
parent 777ba7c055
commit 7f8bec55bf
3 changed files with 37 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -633,6 +633,7 @@ function gtkfrmactivateAfter(widget: PGtkWidget; Event : PgdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Mess: TLMActivate;
Info: PWidgetInfo;
{$IFDEF VerboseFocus}
LCLObject: TObject;
CurFocusWidget: PGtkWidget;
@ -677,14 +678,22 @@ begin
DebugLn('');
{$ENDIF}
Info := GetWidgetInfo(Widget, false);
try
if (Info <> nil) then
Include(Info^.Flags, wwiActivating);
Mess.Msg := LM_ACTIVATE;
Mess.Active:=true;
Mess.Minimized:=false;
Mess.Active := True;
Mess.Minimized := False;
Mess.ActiveWindow := 0;
if GtkWidgetIsA(Widget, gtk_window_get_type) then
Mess.ActiveWindow := HWnd(PtrUInt(PGTKWindow(Widget)^.focus_widget));
Mess.Result := 0;
DeliverMessage(Data, Mess); // send message directly (not Post)
finally
if Info <> nil then
Exclude(Info^.Flags, wwiActivating);
end;
Result := CallBackDefaultReturn;
end;

3
lcl/interfaces/gtk/gtkdef.pp
View File

@ -412,7 +412,8 @@ type
wwiNotOnParentsClientArea,
wwiValidQueuedEvent, // Mark this widgetinfo as valid queued proc
// see gtkwsmenus.pp: gtkWSPopupMenuDeactivate
wwiDeactivating // during gtk deactivate
wwiDeactivating, // during gtk deactivate
wwiActivating // during gtk activate
);
TWidgetInfoFlags = set of TWidgetInfoFlag;
tGtkStateEnumRange = 0..31;

21
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -8603,6 +8603,7 @@ function TGtkWidgetSet.SetFocus(hWnd: HWND): HWND;
{off $DEFINE VerboseFocus}
var
Widget, TopLevel, NewFocusWidget: PGtkWidget;
Info: PWidgetInfo;
{$IfDef VerboseFocus}
AWinControl: TWinControl;
{$EndIf}
@ -8662,9 +8663,7 @@ begin
DebugLn(' there is a modal form above -> focus forbidden');
{$EndIf}
exit;
end{
else
SetForegroundWindow(NewForm.Handle)};
end;
end;
NewFocusWidget := FindFocusWidget(Widget);
@ -8678,9 +8677,10 @@ begin
write(' TopLvlVisible=',GTK_WIDGET_VISIBLE(PGtkWidget(TopLevel)));
DebugLn('');
{$EndIf}
if (NewFocusWidget<>nil) and GTK_WIDGET_CAN_FOCUS(NewFocusWidget) then begin
if (PGtkWindow(TopLevel)^.Focus_Widget<>NewFocusWidget)
then begin
if (NewFocusWidget<>nil) and GTK_WIDGET_CAN_FOCUS(NewFocusWidget) then
begin
if (PGtkWindow(TopLevel)^.Focus_Widget<>NewFocusWidget) then
begin
{$IfDef VerboseFocus}
DebugLn(' H SETTING NewFocusWidget=',dbgs(NewFocusWidget),' ',DbgSName(GetNearestLCLObject(NewFocusWidget)));
{$EndIf}
@ -8700,9 +8700,10 @@ begin
begin
// grab the focus to the parent window
NewTopLevelWidget := gtk_widget_get_toplevel(NewFocusWidget);
NewTopLevelObject := GetNearestLCLObject(NewTopLevelWidget);
if (Screen<>nil)
and (Screen.GetCurrentModalForm<>nil)
and (GetNearestLCLObject(NewTopLevelWidget)<>Screen.GetCurrentModalForm)
and (NewTopLevelObject <>Screen.GetCurrentModalForm)
then begin
{$IFDEF VerboseFocus}
DebugLn('[TGtkWidgetSet.SetFocus] there is a modal form -> not grabbing');
@ -8711,6 +8712,12 @@ begin
{$IfDef VerboseFocus}
DebugLn(' J Grabbing focus ',GetWidgetDebugReport(NewFocusWidget));
{$EndIf}
if NewTopLevelObject is TCustomForm then
begin
Info := GetWidgetInfo(NewTopLevelWidget, False);
if (Info <> nil) and not (wwiActivating in Info^.Flags) then
SetForegroundWindow(TCustomForm(NewTopLevelObject).Handle);
end;
gtk_widget_grab_focus(NewFocusWidget);
end;
end;