paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 15:48:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

applied win32 menu patch from Micha Nelissen

Browse Source 
git-svn-id: trunk@4308 -
This commit is contained in:
mattias 2003-06-24 15:57:55 +00:00
parent 71f77609fd
commit b3a9406869
5 changed files with 91 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
lcl/include/menu.inc
View File

@ -106,10 +106,30 @@ end;
------------------------------------------------------------------------------}
function TMenu.FindItem(Value: Integer; Kind: TFindItemKind): TMenuItem;
function TMenu.FindItem(AValue: Integer; Kind: TFindItemKind): TMenuItem;
function Find(Item: TMenuItem): TMenuItem;
var
I: Integer;
begin
Result := nil;
if Item=nil then exit;
if ((Kind = fkCommand) and (AValue = Item.Command))
or ((Kind = fkHandle) and (AValue = Integer(Item.FHandle)))
or ((Kind = fkShortCut) and (AValue = Item.ShortCut)) then
begin
Result := Item;
end
else
for I := 0 to Item.GetCount - 1 do begin
Result:=Find(Item[I]);
if Result<>nil then
Exit;
end;
end;
begin
//TODO: FINISH TMenu:FINDITEM
Result:=nil;
Result:=Find(Items);
end;
{------------------------------------------------------------------------------
@ -186,6 +206,19 @@ begin
if not HandleAllocated then CreateHandle;
end;
function TMenu.DispatchCommand(ACommand: Word): Boolean;
var
Item: TMenuItem;
begin
Result := False;
Item := FindItem(ACommand, fkCommand);
if Item <> nil then
begin
Item.Click;
Result := True;
end;
end;
{------------------------------------------------------------------------------
Function: TMenu.IsRightToLeft
Params:
@ -204,6 +237,9 @@ end;
{ =============================================================================
$Log$
Revision 1.18 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.17 2003/06/13 06:05:49 mattias
started context diff

8
lcl/include/menuitem.inc
View File

@ -89,6 +89,7 @@ begin
FChecked := False;
FVisible := True;
FEnabled := True;
FCommand := UniqueCommand;
//writeln('TMenuItem.Create END TheOwner=',TheOwner.Name,':',TheOwner.ClassName);
end;
@ -169,6 +170,7 @@ begin
FItems:=nil;
if FParent<>nil then
FParent.FItems.Remove(Self);
if FCommand <> 0 then CommandPool[FCommand] := False;
inherited Destroy;
end;
@ -953,6 +955,9 @@ end;
{ =============================================================================
$Log$
Revision 1.35 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.34 2003/05/18 10:42:58 mattias
implemented deleting empty submenus
@ -1083,6 +1088,9 @@ end;
$Log$
Revision 1.35 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.34 2003/05/18 10:42:58 mattias
implemented deleting empty submenus

21
lcl/interfaces/win32/win32object.inc
View File

@ -18,6 +18,7 @@
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
{------------------------------------------------------------------------------
Method: TWin32Object.Create
Params: None
@ -228,14 +229,17 @@ Procedure TWin32Object.SetLabel(Sender: TObject; Data: Pointer);
{In Win32 Menu items that are created without a initial caption default to disabled,
the next three lines are to counter that.}
fMask:=MIIM_STATE or MIIM_TYPE or MIIM_ID;
GetMenuItemInfo((Sender as TMenuItem).Parent.Handle, integer((Sender as TMenuItem).Handle) and $FFFF, false, @MenuInfo);
if (Sender as TMenuItem).Enabled then fState := fState and (not (MFS_DISABLED or MFS_GRAYED));
GetMenuItemInfo((Sender as TMenuItem).Parent.Handle,
(Sender as TMenuItem).Command, false, @MenuInfo);
if (Sender as TMenuItem).Enabled then
fState := fState and (not (MFS_DISABLED or MFS_GRAYED));
fMask:=MIIM_TYPE or MIIM_STATE;
fType:=Style;
dwTypeData:=Data;
end;
SetMenuItemInfo((Sender as TMenuItem).Parent.Handle, integer((Sender as TMenuItem).Handle) and $FFFF, false, @MenuInfo);
SetMenuItemInfo((Sender as TMenuItem).Parent.Handle,
(Sender as TMenuItem).Command, false, @MenuInfo);
DrawMenuBar(((Sender as TMenuItem).Owner as TWinControl).Handle);
End;
@ -532,6 +536,7 @@ Begin
Else If Sender Is TMenuItem Then
Begin
DeleteMenu((Sender as TMenuItem).Parent.Handle, Handle, MF_BYCOMMAND);
{ release menu item id }
DrawMenuBar(((Sender as TMenuItem).Owner as TWinControl).Handle);
End
Else
@ -2591,11 +2596,13 @@ Begin
cbSize:=sizeof(MENUITEMINFO);
fMask:=MIIM_SUBMENU;
end;
GetMenuItemInfo(ParentOfParent, (ParentMenuHandle) and $FFFF, false, @MenuInfo);
GetMenuItemInfo(ParentOfParent, (Sender as TMenuItem).Command,
false, @MenuInfo);
if MenuInfo.hSubmenu=0 then // the parent menu item is not yet defined with submenu flag
begin
MenuInfo.hSubmenu:=ParentMenuHandle;
SetMenuItemInfo(ParentOfParent, Integer(ParentMenuHandle) and $FFFF, false, MenuInfo);
SetMenuItemInfo(ParentOfParent, (Sender as TMenuItem).Command,
false, MenuInfo);
end;
end;
@ -2607,7 +2614,6 @@ Begin
fMask:=Mask;
fType:=Style;
{fState:=MFS_ENABLED;} {not needed}
wID:=integer(MenuHandle) and $FFFF; {value is only 16 bit wide!}
hSubmenu:=MenuHandle;
{hbmpChecked:=0;
hbmpUnchecked:=0;} {not needed}
@ -2659,6 +2665,9 @@ End;
{
$Log$
Revision 1.53 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.52 2003/06/24 08:32:03 mattias
applied menu fix from Micha Nelissen

7
lcl/interfaces/win32/win32winapi.inc
View File

@ -162,7 +162,7 @@ Begin
if BChecked then CheckFlag := MF_CHECKED
else CheckFlag := MF_UNCHECKED;
CheckFlag := CheckFlag or MF_BYCOMMAND;
PrevState := Windows.CheckMenuItem(FMenu, HndMenu, CheckFlag);
PrevState := Windows.CheckMenuItem(FMenu, UIDEnableItem, CheckFlag);
Result := PrevState = MF_ENABLED;
End;
@ -822,7 +822,7 @@ Begin
if BEnable then EnableFlag := MF_ENABLED
else EnableFlag := MF_GRAYED;
EnableFlag := EnableFlag or MF_BYCOMMAND;
Result := Windows.EnableMenuItem(FMenu, HndMenu, EnableFlag);
Result := Windows.EnableMenuItem(FMenu, UIDEnableItem, EnableFlag);
End;
{------------------------------------------------------------------------------
@ -2322,6 +2322,9 @@ end;
{ =============================================================================
$Log$
Revision 1.34 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.33 2003/03/25 08:12:39 mattias
patch from Martin Smat for menu items and default messages

25
lcl/menus.pp
View File

@ -184,6 +184,7 @@ type
property Items[Index: Integer]: TMenuItem read GetItem; default;
property MenuIndex: Integer read GetMenuIndex write SetMenuIndex;
property Parent: TMenuItem read GetParent;
property Command: integer read FCommand;
published
property AutoCheck: boolean read FAutoCheck write SetAutoCheck default False;
property Caption: String read FCaption write SetCaption
@ -240,10 +241,12 @@ type
FCompStyle: LongInt;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function FindItem(Value: Integer; Kind: TFindItemKind) : TMenuItem;
function FindItem(AValue: Integer; Kind: TFindItemKind) : TMenuItem;
function HandleAllocated: Boolean;
Function IsRightToLeft: Boolean;
procedure HandleNeeded;
function DispatchCommand(ACommand: Word): Boolean;
public
property Handle: HMenu read GetHandle;
property Parent: TComponent read FParent write SetParent;
published
@ -309,6 +312,19 @@ procedure Register;
implementation
{ Menu command managment }
var
CommandPool: TBits;
function UniqueCommand: Word;
begin
if CommandPool=nil then
CommandPool:=TBits.Create(32);
Result := CommandPool.OpenBit;
CommandPool[Result] := True;
end;
function ShortCutToText(ShortCut: TShortCut): string;
begin
Result:=ShortCutToShortCutText(ShortCut);
@ -358,11 +374,18 @@ end;
initialization
DesignerMenuItemClick:=nil;
ActivePopupMenu:=nil;
CommandPool := nil;
finalization
FreeThenNil(CommandPool);
end.
{
$Log$
Revision 1.48 2003/06/24 15:57:55 mattias
applied win32 menu patch from Micha Nelissen
Revision 1.47 2003/06/24 15:23:10 mattias
deleted unused code