jvsystempopup.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvSystemPopup.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is S閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  - the associated TPopupMenu would also be changed during the process :(

Modifications:
  2002.11.22. by Hofi att fw dott hu
    - REMOVED the original TMenuItemPrivateAccess hack, overwriting Handle of FPopup
      changes the original popup menu itself, not so nice ;)
    - ADDED WM_INITMENU handler and a new hack to synchronize the system menu
      with the popup menu (because GetSystemMenu( hWnd, True) does not work correctly
      inside a WM_INITMENU handler.
-----------------------------------------------------------------------------}
// $Id: JvSystemPopup.pas,v 1.16 2005/02/17 10:20:54 marquardt Exp $

unit JvSystemPopup;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
  JvTypes, JvComponent;

type
  TJvPositionInMenu = (pmTop, pmBottom);

  TJvSystemPopup = class(TJvComponent)
  private
    FPopup: TPopupMenu;
    FOwnerForm: TForm;
    FIsHooked: Boolean;
    FPosition: TJvPopupPosition;
    FPositionInMenu: TJvPositionInMenu;
    procedure Hook;
    procedure UnHook;
    procedure ResetSystemMenu(SystemReset: Boolean = True);
    function HandleWndProc(var Msg: TMessage): Boolean;
    procedure SetPopup(const Value: TPopupMenu);
    procedure PopulateMenu;
    procedure SetPosition(const Value: TJvPopupPosition);
    procedure SetPositionInMenu(const Value: TJvPositionInMenu);
    function GetMenu: HMENU;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure Refresh(SystemReset: Boolean = True);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Popup: TPopupMenu read FPopup write SetPopup;
    property PositionInMenu: TJvPositionInMenu read FPositionInMenu write
      SetPositionInMenu default pmTop;
    property Position: TJvPopupPosition read FPosition write SetPosition default ppNone;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvSystemPopup.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2005/02/17 10:20:54 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvWndProcHook, JvConsts, JvResources;

type
  TMenuItemAccessProtected = class(TMenuItem);

constructor TJvSystemPopup.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPosition := ppNone;
  FPopup := nil;
  FPositionInMenu := pmTop;

  while Assigned(AOwner) and not (AOwner is TForm) do
    AOwner := AOwner.Owner;
  FOwnerForm := AOwner as TForm;
end;

destructor TJvSystemPopup.Destroy;
begin
  Position := ppNone;
  inherited Destroy;
end;

function TJvSystemPopup.GetMenu: HMENU;
begin
  { Return a handle to the copy of the window menu currently in use }
  Result := 0;
  case FPosition of
    ppNone:
      ;
    ppForm:
      if Assigned(FOwnerForm) then
        Result := GetSystemMenu(FOwnerForm.Handle, False);
    ppApplication:
      Result := GetSystemMenu(Application.Handle, False);
  end;
end;

function TJvSystemPopup.HandleWndProc(var Msg: TMessage): Boolean;

  function Iterate(MenuItem: TMenuItem): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to MenuItem.Count - 1 do
      if MenuItem[I].Command = Cardinal(Msg.WParam) then
      begin
        Result := True;
        MenuItem[I].Click;
      end
      else
      if MenuItem[I].Count > 0 then
        Result := Iterate(MenuItem[I]);
  end;

var
  SaveIndex: Integer;
  MenuItem: TMenuItem;
  Canvas: TControlCanvas;
  DC: HDC;
begin
  Result := False;
  case Msg.Msg of
    WM_INITMENU:
        // Hack, the original GetSystemMenu( , True) version called by Refresh
        // does not have affect immediately in a WM_INITMENU state/handler
        // (at least on Win Xp surely not)
        Refresh(True);
    WM_SYSCOMMAND:
      { Catch commands }
      if Assigned(FPopup) then
        Result := Iterate(FPopup.Items);
    WM_DRAWITEM:
      { Copied from Forms.pas }
      with PDrawItemStruct(Msg.LParam)^ do
        if (CtlType = ODT_MENU) and Assigned(FPopup) then
        begin
          MenuItem := FPopup.FindItem(itemID, fkCommand);
          Result := MenuItem <> nil;
          if Result then
          begin
            Canvas := TControlCanvas.Create;
            with Canvas do
            try
              SaveIndex := SaveDC(hDC);
              try
                Handle := hDC;
                Font := Screen.MenuFont;
                Menus.DrawMenuItem(MenuItem, Canvas, rcItem,
                  TOwnerDrawState(LongRec(itemState).Lo));
              finally
                Handle := 0;
                RestoreDC(hDC, SaveIndex)
              end;
            finally
              Free;
            end;
          end;
        end;
    WM_MEASUREITEM:
      { Copied from Forms.pas }
      with PMeasureItemStruct(Msg.LParam)^ do
        if (CtlType = ODT_MENU) and Assigned(FPopup) then
        begin
          MenuItem := FPopup.FindItem(itemID, fkCommand);
          Result := MenuItem <> nil;
          if Result then
          begin
            DC := GetWindowDC(Application.Handle);
            try
              Canvas := TControlCanvas.Create;
              with Canvas do
              try
                SaveIndex := SaveDC(DC);
                try
                  Handle := DC;
                  Font := Screen.MenuFont;
                  TMenuItemAccessProtected(MenuItem).MeasureItem(Canvas,
                    Integer(itemWidth), Integer(itemHeight));
                finally
                  Handle := 0;
                  RestoreDC(DC, SaveIndex);
                end;
              finally
                Free;
              end;
            finally
              ReleaseDC(Application.Handle, DC);
            end;
          end
        end;
  end;
end;

procedure TJvSystemPopup.Hook;
begin
  { Hook the application's window or the owner window of TJvSystemPopup }
  case FPosition of
    ppNone:
      ;
    ppForm:
      begin
        if not Assigned(FOwnerForm) then
          Exit;
        if FIsHooked then
          raise EJVCLException.CreateRes(@RsEAlreadyHooked);
        RegisterWndProcHook(FOwnerForm, HandleWndProc, hoBeforeMsg);
        FIsHooked := True;
      end;
    ppApplication:
      begin
        if FIsHooked then
          raise EJVCLException.CreateRes(@RsEAlreadyHooked);
        Application.HookMainWindow(HandleWndProc);
        FIsHooked := True;
      end;
  end;
end;

const
  RightToLeftMenuFlag = MFT_RIGHTORDER or MFT_RIGHTJUSTIFY;
  Checks: array [Boolean] of DWORD = (MF_UNCHECKED, MF_CHECKED);
  Enables: array [Boolean] of DWORD = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  Breaks: array [TMenuBreak] of DWORD = (0, MF_MENUBREAK, MF_MENUBARBREAK);
  Separators: array [Boolean] of DWORD = (MF_STRING, MF_SEPARATOR);

{ AppendMenuItemTo is copied from TMenuItem.AppendTo from Menus.pas }

function AppendMenuItemTo(Menu: HMENU; AMenuItem: TMenuItem;
  ARightToLeft: Boolean; InsertAt: Integer; var SubMenu: HMENU): Boolean;
const
  IBreaks: array [TMenuBreak] of DWORD =
    (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  IChecks: array [Boolean] of DWORD = (MFS_UNCHECKED, MFS_CHECKED);
  IDefaults: array [Boolean] of DWORD = (0, MFS_DEFAULT);