summaryrefslogtreecommitdiff
path: root/plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas
diff options
context:
space:
mode:
authorVadim Dashevskiy <watcherhd@gmail.com>2012-10-08 09:10:06 +0000
committerVadim Dashevskiy <watcherhd@gmail.com>2012-10-08 09:10:06 +0000
commit194923c172167eb3fc33807ec8009b255f86337e (patch)
tree1effc97a1bd872cc3a5eac7a361250cf283e0efd /plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas
parentb2943645fed61d0c0cfee1225654e5ff44fd96f8 (diff)
Plugin is not adapted until someone can compile it and tell others how to do the same
git-svn-id: http://svn.miranda-ng.org/main/trunk@1809 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c
Diffstat (limited to 'plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas')
-rw-r--r--plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas74
1 files changed, 74 insertions, 0 deletions
diff --git a/plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas b/plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas
new file mode 100644
index 0000000000..47ded58c89
--- /dev/null
+++ b/plugins/!NotAdopted/Chess4Net/NonMainFormStayOnTopUnit.pas
@@ -0,0 +1,74 @@
+////////////////////////////////////////////////////////////////////////////////
+// All code below is exclusively owned by author of Chess4Net - Pavel Perminov
+// (packpaul@mail.ru, packpaul1@gmail.com).
+// Any changes, modifications, borrowing and adaptation are a subject for
+// explicit permition from the owner.
+
+unit NonMainFormStayOnTopUnit;
+
+// Inclusion of this unit enables all non-main forms with FormStyle = fsStayOnTop
+// to stay on top even if application is deactivated
+
+interface
+
+implementation
+
+uses
+ Forms, SysUtils, Classes, Messages, Windows;
+
+type
+ TApplicationObjSubclasser = class
+ private
+ m_NewObj, m_OldObj: pointer;
+ procedure FWndProc(var Message: TMessage);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+var
+ g_ApplicationObjSubclasserInstance: TApplicationObjSubclasser = nil;
+
+////////////////////////////////////////////////////////////////////////////////
+// TApplicationObjSubclasser
+
+constructor TApplicationObjSubclasser.Create;
+begin
+ inherited Create;
+
+ m_NewObj := Classes.MakeObjectInstance(FWndProc);
+ m_OldObj := Pointer (SetWindowLong(Application.Handle, GWL_WNDPROC,
+ Cardinal(m_NewObj)));
+end;
+
+
+destructor TApplicationObjSubclasser.Destroy;
+begin
+ SetWindowLong(Application.Handle, GWL_WNDPROC, Cardinal(m_OldObj));
+ Classes.FreeObjectInstance(m_NewObj);
+
+ inherited;
+end;
+
+
+procedure TApplicationObjSubclasser.FWndProc(var Message: TMessage);
+begin
+ Message.Result := CallWindowProc (m_OldObj, Application.Handle,
+ Message.Msg, Message.wParam, Message.lParam);
+
+ case Message.Msg of
+ WM_ACTIVATEAPP:
+ begin
+ if (not TWMActivateApp(Message).Active) then
+ Application.RestoreTopMosts;
+ end;
+ end;
+end;
+
+initialization
+ g_ApplicationObjSubclasserInstance := TApplicationObjSubclasser.Create;
+
+finalization
+ FreeAndNil(g_ApplicationObjSubclasserInstance);
+
+end. \ No newline at end of file