mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-07-31 13:35:56 +02:00
Implements a new form style: fsSystemStayOnTop, reverts win32 fsStayOnTop to mean staying on top of the App only and implements sending WM_HOTKEY messages to the user TMyForm.WndProc. Also adds the OldFormStyle to the parameters of TWSCustomForm.SetFormStyle so that it isn't always necessary to recreate the Wnd.
git-svn-id: trunk@25531 -
This commit is contained in:
parent
dde1038bfb
commit
9d7aa39624
@ -127,7 +127,7 @@ type
|
|||||||
TCaption = TTranslateString;
|
TCaption = TTranslateString;
|
||||||
TCursor = -32768..32767;
|
TCursor = -32768..32767;
|
||||||
|
|
||||||
TFormStyle = (fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop, fsSplash);
|
TFormStyle = (fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop, fsSplash, fsSystemStayOnTop);
|
||||||
TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow,
|
TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow,
|
||||||
bsSizeToolWin);
|
bsSizeToolWin);
|
||||||
TBorderStyle = bsNone..bsSingle;
|
TBorderStyle = bsNone..bsSingle;
|
||||||
@ -144,7 +144,8 @@ type
|
|||||||
TMouseButton = (mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2);
|
TMouseButton = (mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2);
|
||||||
|
|
||||||
const
|
const
|
||||||
fsAllStayOnTop = [fsStayOnTop, fsSplash];
|
fsAllStayOnTop = [fsStayOnTop, fsSplash, fsSystemStayOnTop];
|
||||||
|
fsAllNonSystemStayOnTop = [fsStayOnTop, fsSplash];
|
||||||
|
|
||||||
// Cursor constants
|
// Cursor constants
|
||||||
crHigh = TCursor(0);
|
crHigh = TCursor(0);
|
||||||
|
@ -1271,7 +1271,7 @@ begin
|
|||||||
AForm := Screen.CustomForms[i];
|
AForm := Screen.CustomForms[i];
|
||||||
if (AForm.Parent <> nil) or not AForm.Visible then
|
if (AForm.Parent <> nil) or not AForm.Visible then
|
||||||
Continue;
|
Continue;
|
||||||
if (AForm.FormStyle in fsAllStayOnTop) then
|
if (AForm.FormStyle in fsAllNonSystemStayOnTop) then
|
||||||
begin
|
begin
|
||||||
AForm.FormStyle := fsNormal;
|
AForm.FormStyle := fsNormal;
|
||||||
if FRestoreStayOnTop = nil then
|
if FRestoreStayOnTop = nil then
|
||||||
|
@ -1793,7 +1793,7 @@ Begin
|
|||||||
if OldFormStyle = fsSplash then
|
if OldFormStyle = fsSplash then
|
||||||
BorderStyle := bsSizeable;
|
BorderStyle := bsSizeable;
|
||||||
if HandleAllocated then
|
if HandleAllocated then
|
||||||
TWSCustomFormClass(WidgetSetClass).SetFormStyle(Self, Value);
|
TWSCustomFormClass(WidgetSetClass).SetFormStyle(Self, Value, OldFormStyle);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{------------------------------------------------------------------------------
|
{------------------------------------------------------------------------------
|
||||||
|
@ -83,7 +83,7 @@ type
|
|||||||
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
class procedure DestroyHandle(const AWinControl: TWinControl); override;
|
||||||
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
|
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
|
||||||
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
|
class procedure SetFormBorderStyle(const AForm: TCustomForm; const AFormBorderStyle: TFormBorderStyle); override;
|
||||||
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); override;
|
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
|
||||||
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
|
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
|
||||||
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
||||||
const APopupMode: TPopupMode; const APopupParent: TCustomForm); override;
|
const APopupMode: TPopupMode; const APopupParent: TCustomForm); override;
|
||||||
@ -258,7 +258,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
class procedure TQtWSCustomForm.SetFormStyle(const AForm: TCustomform;
|
class procedure TQtWSCustomForm.SetFormStyle(const AForm: TCustomform;
|
||||||
const AFormStyle: TFormStyle);
|
const AFormStyle, AOldFormStyle: TFormStyle);
|
||||||
var
|
var
|
||||||
QtWin: TQtMainWindow;
|
QtWin: TQtMainWindow;
|
||||||
begin
|
begin
|
||||||
|
@ -1437,12 +1437,12 @@ begin
|
|||||||
if Window = TWin32WidgetSet(WidgetSet).FAppHandle then
|
if Window = TWin32WidgetSet(WidgetSet).FAppHandle then
|
||||||
if WParam = 0 then
|
if WParam = 0 then
|
||||||
begin
|
begin
|
||||||
// RemoveStayOnTopFlags(Window);
|
RemoveStayOnTopFlags(Window);
|
||||||
DisabledForms := Screen.DisableForms(nil, DisabledForms);
|
DisabledForms := Screen.DisableForms(nil, DisabledForms);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
// RestoreStayOnTopFlags(Window);
|
RestoreStayOnTopFlags(Window);
|
||||||
Screen.EnableForms(DisabledForms);
|
Screen.EnableForms(DisabledForms);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1509,6 +1509,13 @@ begin
|
|||||||
WM_HELP:
|
WM_HELP:
|
||||||
if Window = Win32WidgetSet.AppHandle then
|
if Window = Win32WidgetSet.AppHandle then
|
||||||
Application.HelpCommand(0, LParam);
|
Application.HelpCommand(0, LParam);
|
||||||
|
WM_HOTKEY:
|
||||||
|
begin
|
||||||
|
LMessage.Msg := WM_HOTKEY;
|
||||||
|
LMessage.WParam := WParam;
|
||||||
|
LMessage.LParam := LParam;
|
||||||
|
WinProcess := false;
|
||||||
|
end;
|
||||||
WM_HSCROLL,
|
WM_HSCROLL,
|
||||||
WM_VSCROLL:
|
WM_VSCROLL:
|
||||||
begin
|
begin
|
||||||
@ -2178,14 +2185,14 @@ begin
|
|||||||
if WParam <> 0 then // activated
|
if WParam <> 0 then // activated
|
||||||
begin
|
begin
|
||||||
//WriteLn('Restore');
|
//WriteLn('Restore');
|
||||||
// RestoreStayOnTopFlags(Window);
|
RestoreStayOnTopFlags(Window);
|
||||||
if assigned(Application) then
|
if assigned(Application) then
|
||||||
Application.IntfAppActivate;
|
Application.IntfAppActivate;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin // deactivated
|
begin // deactivated
|
||||||
//WriteLn('Remove');
|
//WriteLn('Remove');
|
||||||
// RemoveStayOnTopFlags(Window);
|
RemoveStayOnTopFlags(Window);
|
||||||
if assigned(Application) then
|
if assigned(Application) then
|
||||||
Application.IntfAppDeactivate;
|
Application.IntfAppDeactivate;
|
||||||
end;
|
end;
|
||||||
|
@ -1072,11 +1072,23 @@ function EnumStayOnTopRemove(Handle: HWND; Param: LPARAM): WINBOOL; stdcall;
|
|||||||
var
|
var
|
||||||
AStyle: DWord;
|
AStyle: DWord;
|
||||||
StayOnTopWindowsInfo: PStayOnTopWindowsInfo absolute Param;
|
StayOnTopWindowsInfo: PStayOnTopWindowsInfo absolute Param;
|
||||||
|
lWindowInfo: PWin32WindowInfo;
|
||||||
|
lWinControl: TWinControl;
|
||||||
begin
|
begin
|
||||||
Result := True;
|
Result := True;
|
||||||
AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
|
AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
|
||||||
if (AStyle and WS_EX_TOPMOST) <> 0 then // if stay on top then
|
if (AStyle and WS_EX_TOPMOST) <> 0 then // if stay on top then
|
||||||
begin
|
begin
|
||||||
|
// Don't remove system-wide stay on top
|
||||||
|
lWindowInfo := GetWin32WindowInfo(Handle);
|
||||||
|
if (lWindowInfo <> nil) then
|
||||||
|
begin
|
||||||
|
lWinControl := lWindowInfo^.WinControl;
|
||||||
|
if (lWinControl <> nil) and (lWinControl is TCustomForm)
|
||||||
|
and (TCustomForm(lWinControl).FormStyle = fsSystemStayOnTop) then
|
||||||
|
Exit;
|
||||||
|
end;
|
||||||
|
|
||||||
StayOnTopWindowsInfo^.StayOnTopList.Add(Pointer(Handle));
|
StayOnTopWindowsInfo^.StayOnTopList.Add(Pointer(Handle));
|
||||||
SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
|
SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
|
||||||
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING);
|
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING);
|
||||||
|
@ -83,7 +83,7 @@ type
|
|||||||
AWidth, AHeight: Integer); override;
|
AWidth, AHeight: Integer); override;
|
||||||
class procedure SetFormBorderStyle(const AForm: TCustomForm;
|
class procedure SetFormBorderStyle(const AForm: TCustomForm;
|
||||||
const AFormBorderStyle: TFormBorderStyle); override;
|
const AFormBorderStyle: TFormBorderStyle); override;
|
||||||
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); override;
|
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); override;
|
||||||
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
|
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override;
|
||||||
class procedure ShowModal(const ACustomForm: TCustomForm); override;
|
class procedure ShowModal(const ACustomForm: TCustomForm); override;
|
||||||
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
||||||
@ -440,9 +440,18 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
class procedure TWin32WSCustomForm.SetFormStyle(const AForm: TCustomform;
|
class procedure TWin32WSCustomForm.SetFormStyle(const AForm: TCustomform;
|
||||||
const AFormStyle: TFormStyle);
|
const AFormStyle, AOldFormStyle: TFormStyle);
|
||||||
begin
|
begin
|
||||||
RecreateWnd(AForm);
|
// Some changes don't require RecreateWnd
|
||||||
|
|
||||||
|
// From normal to StayOnTop
|
||||||
|
if (AOldFormStyle = fsNormal) and (AFormStyle in fsAllStayOnTop) then
|
||||||
|
SetWindowPos(AForm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
|
||||||
|
// From StayOnTop to normal
|
||||||
|
else if (AOldFormStyle in fsAllStayOnTop) and (AFormStyle = fsNormal) then
|
||||||
|
SetWindowPos(AForm.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
|
||||||
|
else
|
||||||
|
RecreateWnd(AForm);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
class procedure TWin32WSCustomForm.SetBounds(const AWinControl: TWinControl;
|
class procedure TWin32WSCustomForm.SetBounds(const AWinControl: TWinControl;
|
||||||
|
@ -88,7 +88,7 @@ type
|
|||||||
const ABorderIcons: TBorderIcons); virtual;
|
const ABorderIcons: TBorderIcons); virtual;
|
||||||
class procedure SetFormBorderStyle(const AForm: TCustomForm;
|
class procedure SetFormBorderStyle(const AForm: TCustomForm;
|
||||||
const AFormBorderStyle: TFormBorderStyle); virtual;
|
const AFormBorderStyle: TFormBorderStyle); virtual;
|
||||||
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle: TFormStyle); virtual;
|
class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, AOldFormStyle: TFormStyle); virtual;
|
||||||
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); virtual;
|
class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); virtual;
|
||||||
class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
|
class procedure ShowModal(const ACustomForm: TCustomForm); virtual;
|
||||||
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
class procedure SetPopupParent(const ACustomForm: TCustomForm;
|
||||||
@ -162,7 +162,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
class procedure TWSCustomForm.SetFormStyle(const AForm: TCustomform;
|
class procedure TWSCustomForm.SetFormStyle(const AForm: TCustomform;
|
||||||
const AFormStyle: TFormStyle);
|
const AFormStyle, AOldFormStyle: TFormStyle);
|
||||||
begin
|
begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user