9,23 → 9,49 |
|
interface |
|
// TODO: DefWindowProc() verwenden? |
|
uses |
Windows, WindowsCompat, Classes; |
Windows, WindowsCompat, Classes, SysUtils; |
|
type |
TQuerySystemMenu = class(TObject) |
TWndProcIntercept = class(TObject) |
private |
FOnSystemMenuOpen: TNotifyEvent; |
FOnSystemMenuClose: TNotifyEvent; |
FSystemMenuOpened: boolean; |
FHandle: HWnd; |
FPrevWndProc: LONG_PTR; |
MsgProcPointer: Pointer; |
function MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; |
FIsRegistered: boolean; |
function MsgProcVirtualCall(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; |
procedure RegisterCB; |
procedure UnregisterCB; |
protected |
function MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; virtual; stdcall; |
public |
constructor Create(AHandle: Hwnd); |
destructor Destroy; override; |
end; |
|
TQueryMenu = class(TWndProcIntercept) |
private |
FOnMenuOpen: TNotifyEvent; |
FOnMenuClose: TNotifyEvent; |
FMenuOpened: boolean; |
protected |
function MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; override; stdcall; |
published |
property IsMenuOpened: boolean read FMenuOpened; |
property OnMenuOpen: TNotifyEvent read FOnMenuOpen write FOnMenuOpen; |
property OnMenuClose: TNotifyEvent read FOnMenuClose write FOnMenuClose; |
end; |
|
TQuerySystemMenu = class(TWndProcIntercept) |
private |
FOnSystemMenuOpen: TNotifyEvent; |
FOnSystemMenuClose: TNotifyEvent; |
FSystemMenuOpened: boolean; |
protected |
function MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; override; stdcall; |
published |
property IsSystemMenuOpened: boolean read FSystemMenuOpened; |
property OnSystemMenuOpen: TNotifyEvent read FOnSystemMenuOpen write FOnSystemMenuOpen; |
property OnSystemMenuClose: TNotifyEvent read FOnSystemMenuClose write FOnSystemMenuClose; |
36,10 → 62,97 |
uses |
Messages, MethodPtr; |
|
function TQuerySystemMenu.MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall; |
{ TWndProcIntercept } |
|
constructor TWndProcIntercept.Create(AHandle: Hwnd); |
begin |
FHandle := AHandle; |
|
RegisterCB; |
end; |
|
destructor TWndProcIntercept.Destroy; |
begin |
UnregisterCB; |
|
inherited; |
end; |
|
function TWndProcIntercept.MsgProc(Handle: HWnd; Msg: UInt; |
WParam: Windows.WParam; LParam: Windows.LParam): LResult; |
begin |
result := Windows.CallWindowProc(WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam) |
end; |
|
function TWndProcIntercept.MsgProcVirtualCall(Handle: HWnd; Msg: UInt; |
WParam: Windows.WParam; LParam: Windows.LParam): LResult; |
begin |
// Virtual call |
result := MsgProc(Handle, Msg, WParam, LParam); |
end; |
|
procedure TWndProcIntercept.RegisterCB; |
var |
f: TMethod; |
begin |
if FIsRegistered then exit; |
FIsRegistered := true; |
|
FPrevWndProc := GetWindowLongPtr(FHandle, GWLP_WNDPROC); |
|
f.Code := @TWndProcIntercept.MsgProcVirtualCall; |
f.Data := Self; |
MsgProcPointer := MakeProcInstance(f); |
|
// Problem: Kann es zu Komplikationen mit mehreren msg handlern kommen? |
// (Beim vermischten register+unregister !) |
|
SetWindowLongPtr(FHandle, GWLP_WNDPROC, MsgProcPointer); |
end; |
|
procedure TWndProcIntercept.UnregisterCB; |
begin |
if not FIsRegistered then exit; |
FIsRegistered := false; |
|
SetWindowLongPtr(FHandle, GWLP_WNDPROC, FPrevWndProc); |
|
FreeProcInstance(MsgProcPointer); |
end; |
|
{ TQueryMenu } |
|
function TQueryMenu.MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; |
LParam: Windows.LParam): LResult; |
begin |
if Msg = WM_INITMENUPOPUP then |
begin |
FMenuOpened := true; |
if Assigned(FOnMenuOpen) then |
begin |
FOnMenuOpen(Self); |
end; |
end; |
if Msg = WM_UNINITMENUPOPUP then |
begin |
FMenuOpened := false; |
if Assigned(FOnMenuClose) then |
begin |
FOnMenuClose(Self); |
end; |
end; |
|
result := inherited MsgProc(Handle, Msg, WParam, LParam); |
end; |
|
{ TQuerySystemMenu } |
|
function TQuerySystemMenu.MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; |
begin |
// TODO bug: löst bei evtl vorhandenen submenus öfters aus |
|
if Msg = WM_INITMENUPOPUP then |
begin |
// if Cardinal(WParam) = GetSystemMenu(FHandle, False) then |
if LongBool(HiWord(lParam)) then |
begin |
62,30 → 175,8 |
end; |
end; |
end; |
Result := Windows.CallWindowProc(WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam); |
end; |
|
constructor TQuerySystemMenu.Create(AHandle: Hwnd); |
var |
f: TMethod; |
begin |
FHandle := AHandle; |
|
FPrevWndProc := GetWindowLongPtr(FHandle, GWL_WNDPROC); |
|
f.Code := @TQuerySystemMenu.MsgProc; |
f.Data := Self; |
MsgProcPointer := MakeProcInstance(f); |
|
// Kann es zu Komplikationen mit mehreren msg handlern kommen? |
SetWindowLongPtr(FHandle, GWL_WNDPROC, MsgProcPointer); |
result := inherited MsgProc(Handle, Msg, WParam, LParam); |
end; |
|
destructor TQuerySystemMenu.Destroy; |
begin |
SetWindowLongPtr(FHandle, GWL_WNDPROC, FPrevWndProc); |
|
FreeProcInstance(MsgProcPointer); |
end; |
|
end. |