From 8d72ce46b657389294c960d0451e043de6ede273 Mon Sep 17 00:00:00 2001 From: graemeg Date: Sat, 15 Dec 2007 14:41:35 +0000 Subject: * Added a new WindowAttribute called waStayOnTop. * Modified the SplashScreen example to use the new window attribute. * Modified gfx_x11 to use the new waStayOnTop attribute and also to define a window type SplashScreen via newlayers. --- examples/gui/splashscreen/frm_splashscreen.pas | 12 +++++++++++- src/corelib/gdi/gfx_gdi.pas | 4 ++++ src/corelib/gfxbase.pas | 2 +- src/corelib/x11/gfx_x11.pas | 7 ++++++- 4 files changed, 22 insertions(+), 3 deletions(-) diff --git a/examples/gui/splashscreen/frm_splashscreen.pas b/examples/gui/splashscreen/frm_splashscreen.pas index c8dcb468..894ba11a 100644 --- a/examples/gui/splashscreen/frm_splashscreen.pas +++ b/examples/gui/splashscreen/frm_splashscreen.pas @@ -14,6 +14,8 @@ uses type + { TSplashForm } + TSplashForm = class(TfpgForm) procedure SplashFormShow(Sender: TObject); procedure TimerFired(Sender: TObject); @@ -21,6 +23,7 @@ type tmr: TfpgTimer; protected procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override; + procedure AdjustWindowStyle; override; public {@VFD_HEAD_BEGIN: SplashForm} pnlName1: TfpgBevel; @@ -59,10 +62,17 @@ begin TimerFired(nil); end; +procedure TSplashForm.AdjustWindowStyle; +begin + inherited AdjustWindowStyle; + +end; + constructor TSplashForm.Create(AOwner: TComponent); begin inherited Create(AOwner); - WindowType := wtPopup; + WindowType := wtPopup; // removes borders and title bar + Include(WindowAttributes, waStayOnTop); // well, it lets the window stay on top. :) tmr := TfpgTimer.Create(3000); tmr.OnTimer := @TimerFired; diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas index e35023ba..d7ef5a70 100644 --- a/src/corelib/gdi/gfx_gdi.pas +++ b/src/corelib/gdi/gfx_gdi.pas @@ -1045,6 +1045,10 @@ begin DoMoveWindow(FLeft, FTop); end; + if waStayOnTop in FWindowAttributes then + SetWindowPos(FWinHandle, HWND_TOPMOST, 0, 0, 0, 0, + SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE); + // the forms require some adjustments before the Window appears SetWindowParameters; end; diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas index 97438276..12522b61 100644 --- a/src/corelib/gfxbase.pas +++ b/src/corelib/gfxbase.pas @@ -21,7 +21,7 @@ type TWindowType = (wtChild, wtWindow, wtModalForm, wtPopup); - TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos); + TWindowAttribute = (waSizeable, waAutoPos, waScreenCenterPos, waStayOnTop); TWindowAttributes = set of TWindowAttribute; TMouseCursor = (mcDefault, mcArrow, mcCross, mcIBeam, mcSizeEW, mcSizeNS, diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas index f77b6f8e..04a9f9b4 100644 --- a/src/corelib/x11/gfx_x11.pas +++ b/src/corelib/x11/gfx_x11.pas @@ -1109,7 +1109,12 @@ begin //XSetTransientForHint(xapplication.display, FWinHandle, TfpgWindowImpl(Parent).FWinHandle); end; end; - + + // todo: This needs testing!! + if (FWindowType = wtPopup) and (waStayOnTop in FWindowAttributes) then + // we have a Splash screen + fpgApplication.netlayer.WindowSetType(FWinHandle, nwtSplash); + XSelectInput(xapplication.Display, wh, KeyPressMask or KeyReleaseMask or ButtonPressMask or ButtonReleaseMask or EnterWindowMask or LeaveWindowMask or -- cgit v1.2.3-70-g09d2