unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, LMessages,
Windows;
type
{ TForm1 }
TForm1 = class(TForm)
private
fOnUnFocus: TNotifyEvent;//event storage
lastMessage: UINT; //to avoid double calls
fOldWindowProc, fNewWindowProc: TWndMethod;//old and new WindowProcedures
procedure chkwnd(var TheMessage: TLMessage);//WindowProcedure(real)
public
property WindowProc: TWndMethod read fNewWindowProc write fNewWindowProc;
//Property for custom WindowProcedure, if you need to set it...
Constructor Create(TheOwner: TComponent); override;
//Constructor
Property onUnFocus: TNotifyEvent read fOnUnFocus write fOnUnFocus;
//Here the event stored
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
constructor TForm1.Create(TheOwner: TComponent);
begin
Inherited; //Call form creating routines
fOldWindowProc := inherited WindowProc;//get the old WindowProcedure
Inherited WindowProc := @Self.chkwnd; //Set the real WindowProcedure to ours
end;
procedure TForm1.chkwnd(var TheMessage: TLMessage);
var I: integer;//iter
ForeGroundHWND: HWND;//it talks for itself
Call: boolean;//to be, or not to be? to do a call, or not to do a call?
begin
if (TheMessage.msg = LM_CANCELMODE) and (lastMessage <> TheMessage.Msg) then
begin //If message is WindowMessage about focus cancelling
Call := true; //here we set the existential variable
ForeGroundHWND := GetForeGroundWindow;//Gets the current Top Window, ForeGround
For I := 0 to Screen.FormCount-1 do //iterate throught forms
if Screen.Forms[I].Handle = ForeGroundHWND then
//if the new focus handle is exist in form list
begin
//then, break from circle and DO NOT CALL THE Event
Call := False;
break;
end;
//Else call the event
{
P.s maybe i'm just doesn't uderstand, what i can use 'Else' instead
of variable inside the iteration, but...
i haven't tested circles in FPC yet.
}
if Call and Assigned(fOnUnfocus) then
fOnUnfocus(Self as TObject);
end;
// set the trigger-variable
lastMessage := TheMessage.msg;
// and... send message to the parent & nested procedures
if Assigned(fOldWindowProc) then
fOldWindowProc(TheMessage);
if Assigned(fNewWindowProc) then
fNewWindowProc(TheMessage);
end;
end.