Subversion Repositories delphiutils

Rev

Rev 42 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit QuerySystemMenu;
  2.  
  3. (*
  4.  
  5. QuerySystemMenu.pas
  6. (C) 2010 Daniel Marschall
  7.  
  8. *)
  9.  
  10. interface
  11.  
  12. uses
  13.   Windows, WindowsCompat, Classes;
  14.  
  15. type
  16.   TQuerySystemMenu = class(TObject)
  17.   private
  18.     FOnSystemMenuOpen: TNotifyEvent;
  19.     FOnSystemMenuClose: TNotifyEvent;
  20.     FSystemMenuOpened: boolean;
  21.     FHandle: HWnd;
  22.     FPrevWndProc: LONG_PTR;
  23.     MsgProcPointer: Pointer;
  24.     function MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
  25.   public
  26.     constructor Create(AHandle: Hwnd);
  27.     destructor Destroy; override;
  28.   published
  29.     property IsSystemMenuOpened: boolean read FSystemMenuOpened;
  30.     property OnSystemMenuOpen: TNotifyEvent read FOnSystemMenuOpen write FOnSystemMenuOpen;
  31.     property OnSystemMenuClose: TNotifyEvent read FOnSystemMenuClose write FOnSystemMenuClose;
  32.   end;
  33.  
  34. implementation
  35.  
  36. uses
  37.   Messages, MethodPtr;
  38.  
  39. function TQuerySystemMenu.MsgProc(Handle: HWnd; Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
  40. begin
  41.   if Msg = WM_INITMENUPOPUP then
  42.   begin
  43.     // if Cardinal(WParam) = GetSystemMenu(FHandle, False) then
  44.     if LongBool(HiWord(lParam)) then
  45.     begin
  46.       FSystemMenuOpened := true;
  47.       if Assigned(FOnSystemMenuOpen) then
  48.       begin
  49.         FOnSystemMenuOpen(Self);
  50.       end;
  51.     end;
  52.   end;
  53.   if Msg = WM_UNINITMENUPOPUP then
  54.   begin
  55.     // if Cardinal(WParam) = GetSystemMenu(FHandle, False) then
  56.     if HiWord(lParam) = MF_SYSMENU then
  57.     begin
  58.       FSystemMenuOpened := false;
  59.       if Assigned(FOnSystemMenuClose) then
  60.       begin
  61.         FOnSystemMenuClose(Self);
  62.       end;
  63.     end;
  64.   end;
  65.   Result := Windows.CallWindowProc(WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam);
  66. end;
  67.  
  68. constructor TQuerySystemMenu.Create(AHandle: Hwnd);
  69. var
  70.   f: TMethod;
  71. begin
  72.   FHandle := AHandle;
  73.  
  74.   FPrevWndProc := GetWindowLongPtr(FHandle, GWL_WNDPROC);
  75.  
  76.   f.Code := @TQuerySystemMenu.MsgProc;
  77.   f.Data := Self;
  78.   MsgProcPointer := MakeProcInstance(f);
  79.  
  80.   // Kann es zu Komplikationen mit mehreren msg handlern kommen?
  81.   SetWindowLongPtr(FHandle, GWL_WNDPROC, MsgProcPointer);
  82. end;
  83.  
  84. destructor TQuerySystemMenu.Destroy;
  85. begin
  86.   SetWindowLongPtr(FHandle, GWL_WNDPROC, FPrevWndProc);
  87.  
  88.   FreeProcInstance(MsgProcPointer);
  89. end;
  90.  
  91. end.
  92.