537 lines
16 KiB
ObjectPascal
537 lines
16 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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ébastien Buysse [sbuysse att buypin dott com]
|
|
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien 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 10612 2006-05-19 19:04:09Z jfudickar $
|
|
|
|
unit JvSystemPopup;
|
|
|
|
{$I jvcl.inc}
|
|
{$I vclonly.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus,
|
|
JvTypes, JvComponentBase;
|
|
|
|
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: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvSystemPopup.pas $';
|
|
Revision: '$Revision: 10612 $';
|
|
Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
|
|
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);
|
|
IEnables: array [Boolean] of DWORD = (MFS_DISABLED or MFS_GRAYED, MFS_ENABLED);
|
|
IRadios: array [Boolean] of DWORD = (MFT_STRING, MFT_RADIOCHECK);
|
|
ISeparators: array [Boolean] of DWORD = (MFT_STRING, MFT_SEPARATOR);
|
|
IRTL: array [Boolean] of DWORD = (0, RightToLeftMenuFlag);
|
|
IOwnerDraw: array [Boolean] of DWORD = (MFT_STRING, MFT_OWNERDRAW);
|
|
var
|
|
MenuItemInfo: TMenuItemInfo;
|
|
Caption: string;
|
|
NewFlags: Integer;
|
|
IsOwnerDraw: Boolean;
|
|
ParentMenu: TMenu;
|
|
begin
|
|
Result := AMenuItem.Visible;
|
|
if not Result then
|
|
Exit;
|
|
|
|
Caption := AMenuItem.Caption;
|
|
if AMenuItem.Count > 0 then
|
|
begin
|
|
SubMenu := CreatePopupMenu;
|
|
MenuItemInfo.hSubMenu := SubMenu;
|
|
end
|
|
else
|
|
if (AMenuItem.ShortCut <> scNone) and ((AMenuItem.Parent = nil) or
|
|
(AMenuItem.Parent.Parent <> nil) or not (AMenuItem.Parent.Owner is TMainMenu)) then
|
|
Caption := Caption + Tab + ShortCutToText(AMenuItem.ShortCut);
|
|
if Lo(GetVersion) >= 4 then
|
|
begin
|
|
MenuItemInfo.cbSize := 44; // Required for Windows 95
|
|
MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
|
|
MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
|
|
ParentMenu := AMenuItem.GetParentMenu;
|
|
// IsOwnerDraw := Assigned(ParentMenu) and ParentMenu.IsOwnerDraw or
|
|
IsOwnerDraw := Assigned(ParentMenu) and
|
|
(ParentMenu.OwnerDraw or (AMenuItem.GetImageList <> nil)) or
|
|
Assigned(AMenuItem.Bitmap) and not AMenuItem.Bitmap.Empty;
|
|
MenuItemInfo.fType := IRadios[AMenuItem.RadioItem] or
|
|
IBreaks[AMenuItem.Break] or
|
|
ISeparators[AMenuItem.Caption = cLineCaption] or IRTL[ARightToLeft] or
|
|
IOwnerDraw[IsOwnerDraw];
|
|
MenuItemInfo.fState := IChecks[AMenuItem.Checked] or
|
|
IEnables[AMenuItem.Enabled] or IDefaults[AMenuItem.Default];
|
|
MenuItemInfo.wID := AMenuItem.Command;
|
|
MenuItemInfo.hSubMenu := 0;
|
|
MenuItemInfo.hbmpChecked := 0;
|
|
MenuItemInfo.hbmpUnchecked := 0;
|
|
MenuItemInfo.dwTypeData := PChar(Caption);
|
|
if AMenuItem.Count > 0 then
|
|
begin
|
|
MenuItemInfo.hSubMenu := SubMenu;
|
|
end;
|
|
InsertMenuItem(Menu, DWORD(InsertAt), True, MenuItemInfo);
|
|
end
|
|
else
|
|
begin
|
|
NewFlags := Breaks[AMenuItem.Break] or Checks[AMenuItem.Checked] or
|
|
Enables[AMenuItem.Enabled] or
|
|
Separators[AMenuItem.Caption = cLineCaption] or MF_BYPOSITION;
|
|
if AMenuItem.Count > 0 then
|
|
InsertMenu(Menu, DWORD(InsertAt), MF_POPUP or NewFlags,
|
|
SubMenu, PChar(AMenuItem.Caption))
|
|
else
|
|
InsertMenu(Menu, DWORD(InsertAt), NewFlags, AMenuItem.Command,
|
|
PChar(AMenuItem.Caption));
|
|
end;
|
|
end;
|
|
|
|
procedure IterateMenu(AMenu: HMENU; AMenuItem: TMenuItem;
|
|
ARightToLeft: Boolean; InsertAt: Integer);
|
|
var
|
|
I: Integer;
|
|
SubMenu: HMENU;
|
|
begin
|
|
with AMenuItem do
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
if AppendMenuItemTo(AMenu, Items[I], ARightToLeft, InsertAt, SubMenu) and
|
|
(InsertAt >= 0) then
|
|
Inc(InsertAt);
|
|
|
|
if SubMenu > 0 then
|
|
IterateMenu(SubMenu, Items[I], ARightToLeft, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (AComponent = FPopup) and (Operation = opRemove) then
|
|
Popup := nil;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.PopulateMenu;
|
|
var
|
|
Menu: HMENU;
|
|
MenuItemInfo: TMenuItemInfo;
|
|
MenuRightToLeft: Boolean;
|
|
InsertAt: Integer;
|
|
begin
|
|
{ Add all MenuItems to the systemmenu }
|
|
if (ComponentState * [csDesigning, csLoading] <> []) or
|
|
(FPosition = ppNone) or (FPopup = nil) then
|
|
Exit;
|
|
|
|
MenuRightToLeft := FPopup.IsRightToLeft;
|
|
|
|
Menu := GetMenu;
|
|
if Menu = 0 then
|
|
Exit;
|
|
|
|
if PositionInMenu = pmTop then
|
|
InsertAt := 0
|
|
else
|
|
InsertAt := -1;
|
|
|
|
if FPopup.Items.Count > 0 then
|
|
begin
|
|
{ Add a seperator }
|
|
FillChar(MenuItemInfo, SizeOf(MenuItemInfo), #0);
|
|
MenuItemInfo.cbSize := 44; //SizeOf(MenuItemInfo);
|
|
MenuItemInfo.fMask := MIIM_CHECKMARKS or MIIM_DATA or
|
|
MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE;
|
|
MenuItemInfo.fType := MFT_SEPARATOR;
|
|
{ Give the seperator menu id $EFFF so we can seperate these from the
|
|
normal seperators (with id=0), that we don't want to remove in procedure
|
|
RemoveNonDefaultItems }
|
|
MenuItemInfo.wID := $EFFF;
|
|
InsertMenuItem(Menu, DWORD(InsertAt), True, MenuItemInfo);
|
|
end;
|
|
|
|
IterateMenu(Menu, FPopup.Items, MenuRightToLeft, InsertAt);
|
|
end;
|
|
|
|
procedure TJvSystemPopup.Refresh(SystemReset: Boolean = True);
|
|
begin
|
|
ResetSystemMenu(SystemReset);
|
|
PopulateMenu;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.ResetSystemMenu(SystemReset: Boolean);
|
|
|
|
// Hack, the original GetSystemMenu( , True) version called by Refresh
|
|
// does not have affect immediately in WM_INITMENU state
|
|
// (at least on Win Xp surely not)
|
|
procedure RemoveNonDefaultItems(Menu: HMENU);
|
|
var
|
|
Id: Longword;
|
|
C: Integer;
|
|
begin
|
|
if GetMenuItemCount(Menu) > 0 then
|
|
begin
|
|
for C := GetMenuItemCount(Menu) - 1 downto 0 do
|
|
begin
|
|
Id := GetMenuItemID(Menu, C);
|
|
{ MSDN : All predefined window menu items have identifier numbers
|
|
greater than $F000. If an application adds commands to the window
|
|
menu, it should use identifier numbers less than $F000.
|
|
|
|
NOTE : SC_SIZE = $F000, seperators seem to have id = 0, although
|
|
SC_SEPARATOR is defined as $F00F.
|
|
}
|
|
// non default system command or an item with submenuitems
|
|
if ((Id > 0) and (Id < $F000)) or (Id = $FFFFFFFF) then
|
|
begin
|
|
if GetMenuItemCount(GetSubMenu(Menu, C)) > 0 then
|
|
RemoveNonDefaultItems(GetSubMenu(Menu, C));
|
|
DeleteMenu(Menu, C, MF_BYPOSITION);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
{ Reset the window menu back to the default state. The previous window
|
|
menu, if any, is destroyed. }
|
|
if ComponentState * [csDesigning, csLoading] <> [] then
|
|
Exit;
|
|
case FPosition of
|
|
ppNone:
|
|
;
|
|
ppForm:
|
|
if Assigned(FOwnerForm) and not (csDestroying in FOwnerForm.ComponentState) then
|
|
if SystemReset then
|
|
RemoveNonDefaultItems(GetMenu)
|
|
else
|
|
GetSystemMenu(FOwnerForm.Handle, True);
|
|
ppApplication:
|
|
if SystemReset then
|
|
RemoveNonDefaultItems(GetMenu)
|
|
else
|
|
GetSystemMenu(Application.Handle, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.SetPopup(const Value: TPopupMenu);
|
|
begin
|
|
if Assigned(FPopup) then
|
|
FPopup.OnChange := nil;
|
|
FPopup := Value;
|
|
if Assigned(FPopup) then
|
|
begin
|
|
//FPopup.OnChange := MenuChanged;
|
|
FPopup.FreeNotification(Self);
|
|
end;
|
|
//if not (csLoading in ComponentState) then
|
|
// Refresh;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.SetPosition(const Value: TJvPopupPosition);
|
|
begin
|
|
if FPosition = Value then
|
|
Exit;
|
|
|
|
if csDesigning in ComponentState then
|
|
begin
|
|
FPosition := Value;
|
|
Exit;
|
|
end;
|
|
|
|
UnHook;
|
|
ResetSystemMenu;
|
|
FPosition := Value;
|
|
Hook;
|
|
//PopulateMenu;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.SetPositionInMenu(const Value: TJvPositionInMenu);
|
|
begin
|
|
FPositionInMenu := Value;
|
|
//if ComponentState * [csLoading, csDesigning] = [] then
|
|
// Refresh;
|
|
end;
|
|
|
|
procedure TJvSystemPopup.UnHook;
|
|
begin
|
|
if not FIsHooked then
|
|
Exit;
|
|
|
|
case FPosition of
|
|
ppNone:
|
|
;
|
|
ppForm:
|
|
begin
|
|
if not Assigned(FOwnerForm) then
|
|
Exit;
|
|
UnRegisterWndProcHook(FOwnerForm, HandleWndProc, hoBeforeMsg);
|
|
FIsHooked := False;
|
|
end;
|
|
ppApplication:
|
|
begin
|
|
Application.UnhookMainWindow(HandleWndProc);
|
|
FIsHooked := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|
|
|