paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-01 08:32:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

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.

Browse Source 
git-svn-id: trunk@25531 -
This commit is contained in:
sekelsenmat 2010-05-20 09:28:21 +00:00
parent dde1038bfb
commit 9d7aa39624
8 changed files with 44 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -127,7 +127,7 @@ type
TCaption = TTranslateString;
TCursor = -32768..32767;
TFormStyle = (fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop, fsSplash);
TFormStyle = (fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop, fsSplash, fsSystemStayOnTop);
TFormBorderStyle = (bsNone, bsSingle, bsSizeable, bsDialog, bsToolWindow,
bsSizeToolWin);
TBorderStyle = bsNone..bsSingle;
@ -144,7 +144,8 @@ type
TMouseButton = (mbLeft, mbRight, mbMiddle, mbExtra1, mbExtra2);
const
fsAllStayOnTop = [fsStayOnTop, fsSplash];
fsAllStayOnTop = [fsStayOnTop, fsSplash, fsSystemStayOnTop];
fsAllNonSystemStayOnTop = [fsStayOnTop, fsSplash];
// Cursor constants
crHigh = TCursor(0);

2
lcl/include/application.inc
View File

@ -1271,7 +1271,7 @@ begin
AForm := Screen.CustomForms[i];
if (AForm.Parent <> nil) or not AForm.Visible then
Continue;
if (AForm.FormStyle in fsAllStayOnTop) then
if (AForm.FormStyle in fsAllNonSystemStayOnTop) then
begin
AForm.FormStyle := fsNormal;
if FRestoreStayOnTop = nil then

2
lcl/include/customform.inc
View File

@ -1793,7 +1793,7 @@ Begin
if OldFormStyle = fsSplash then
BorderStyle := bsSizeable;
if HandleAllocated then
TWSCustomFormClass(WidgetSetClass).SetFormStyle(Self, Value);
TWSCustomFormClass(WidgetSetClass).SetFormStyle(Self, Value, OldFormStyle);
end;
{------------------------------------------------------------------------------

4
lcl/interfaces/qt/qtwsforms.pp
View File

@ -83,7 +83,7 @@ type
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); 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 SetPopupParent(const ACustomForm: TCustomForm;
const APopupMode: TPopupMode; const APopupParent: TCustomForm); override;
@ -258,7 +258,7 @@ begin
end;
class procedure TQtWSCustomForm.SetFormStyle(const AForm: TCustomform;
const AFormStyle: TFormStyle);
const AFormStyle, AOldFormStyle: TFormStyle);
var
QtWin: TQtMainWindow;
begin

15
lcl/interfaces/win32/win32callback.inc
View File

@ -1437,12 +1437,12 @@ begin
if Window = TWin32WidgetSet(WidgetSet).FAppHandle then
if WParam = 0 then
begin
// RemoveStayOnTopFlags(Window);
RemoveStayOnTopFlags(Window);
DisabledForms := Screen.DisableForms(nil, DisabledForms);
end
else
begin
// RestoreStayOnTopFlags(Window);
RestoreStayOnTopFlags(Window);
Screen.EnableForms(DisabledForms);
end;
@ -1509,6 +1509,13 @@ begin
WM_HELP:
if Window = Win32WidgetSet.AppHandle then
Application.HelpCommand(0, LParam);
WM_HOTKEY:
begin
LMessage.Msg := WM_HOTKEY;
LMessage.WParam := WParam;
LMessage.LParam := LParam;
WinProcess := false;
end;
WM_HSCROLL,
WM_VSCROLL:
begin
@ -2178,14 +2185,14 @@ begin
if WParam <> 0 then // activated
begin
//WriteLn('Restore');
// RestoreStayOnTopFlags(Window);
RestoreStayOnTopFlags(Window);
if assigned(Application) then
Application.IntfAppActivate;
end
else
begin // deactivated
//WriteLn('Remove');
// RemoveStayOnTopFlags(Window);
RemoveStayOnTopFlags(Window);
if assigned(Application) then
Application.IntfAppDeactivate;
end;

12
lcl/interfaces/win32/win32proc.pp
View File

@ -1072,11 +1072,23 @@ function EnumStayOnTopRemove(Handle: HWND; Param: LPARAM): WINBOOL; stdcall;
var
AStyle: DWord;
StayOnTopWindowsInfo: PStayOnTopWindowsInfo absolute Param;
lWindowInfo: PWin32WindowInfo;
lWinControl: TWinControl;
begin
Result := True;
AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
if (AStyle and WS_EX_TOPMOST) <> 0 then // if stay on top then
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));
SetWindowPos(Handle, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOSENDCHANGING);

15
lcl/interfaces/win32/win32wsforms.pp
View File

@ -83,7 +83,7 @@ type
AWidth, AHeight: Integer); 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 ShowModal(const ACustomForm: TCustomForm); override;
class procedure SetPopupParent(const ACustomForm: TCustomForm;
@ -440,9 +440,18 @@ begin
end;
class procedure TWin32WSCustomForm.SetFormStyle(const AForm: TCustomform;
const AFormStyle: TFormStyle);
const AFormStyle, AOldFormStyle: TFormStyle);
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;
class procedure TWin32WSCustomForm.SetBounds(const AWinControl: TWinControl;

4
lcl/widgetset/wsforms.pp
View File

@ -88,7 +88,7 @@ type
const ABorderIcons: TBorderIcons); virtual;
class procedure SetFormBorderStyle(const AForm: TCustomForm;
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 ShowModal(const ACustomForm: TCustomForm); virtual;
class procedure SetPopupParent(const ACustomForm: TCustomForm;
@ -162,7 +162,7 @@ begin
end;
class procedure TWSCustomForm.SetFormStyle(const AForm: TCustomform;
const AFormStyle: TFormStyle);
const AFormStyle, AOldFormStyle: TFormStyle);
begin
end;