fix menuitem caption issue (partly by martin smat)

remove ShortCutToText and TextToShortCut wrapper functions

git-svn-id: trunk@6158 -
This commit is contained in:
micha 2004-10-24 14:50:31 +00:00
parent bda4272d04
commit eb5698fec0
4 changed files with 54 additions and 57 deletions

View File

@ -21,7 +21,7 @@ var
p: Pointer;
begin
Result := inherited Add(S);
ShortCut:=ShortCutTextToShortCut(S);
ShortCut:=TextToShortCut(S);
p:=Pointer(Cardinal(ShortCut));
Objects[Result] := TObject(p);
end;

View File

@ -85,6 +85,38 @@ implementation
{ TWin32WSMenuItem }
procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);
var
MenuInfo: MENUITEMINFO;
begin
with MenuInfo do
begin
cbsize:=sizeof(MENUITEMINFO);
if ACaption <> '-' then
begin
fType := MFT_STRING;
{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;
GetMenuItemInfo(AMenuItem.Parent.Handle,
AMenuItem.Command, false, @MenuInfo);
if AMenuItem.Enabled then
fState := fState and DWORD(not (MFS_DISABLED or MFS_GRAYED));
fMask:=MIIM_TYPE or MIIM_STATE;
dwTypeData:=LPSTR(ACaption);
cch := StrLen(dwTypeData);
end
else fType := MFT_SEPARATOR;
end;
SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
// owner could be a popupmenu too
if (AMenuItem.Owner is TWinControl) and
TWinControl(AMenuItem.Owner).HandleAllocated and
([csLoading,csDestroying] * TWinControl(AMenuItem.Owner).ComponentState = []) then
DrawMenuBar(TWinControl(AMenuItem.Owner).Handle);
end;
procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
var
MenuInfo: MENUITEMINFO;
@ -150,6 +182,8 @@ var
end;
end;
var
newCaption: string;
begin
ParentMenuHandle := AMenuItem.Parent.Handle;
@ -193,13 +227,11 @@ begin
if AMenuItem.Caption <> '-' then
begin
fType:=MFT_STRING;
newCaption:=AMenuItem.Caption;
if AMenuItem.ShortCut <> 0 then
begin
dwTypeData:=LPSTR(AMenuItem.Caption+#9+ShortCutToText(AMenuItem.ShortCut));
end else begin
dwTypeData:=LPSTR(AMenuItem.Caption);
end;
cch:=StrLen(dwTypeData);
newCaption:=newCaption+#9+ShortCutToText(AMenuItem.ShortCut);
dwTypeData:=LPSTR(newCaption);
cch:=Length(newCaption);
end else begin
fType:=MFT_SEPARATOR;
dwTypeData:=nil;
@ -244,38 +276,12 @@ begin
end;
procedure TWin32WSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
var
MenuInfo: MENUITEMINFO;
Style: integer;
var newCaption: string;
begin
if AMenuItem.Caption = '-' then
Style := MFT_SEPARATOR
else
Style := MFT_STRING;
with MenuInfo do
begin
cbsize:=sizeof(MENUITEMINFO);
{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;
GetMenuItemInfo(AMenuItem.Parent.Handle,
AMenuItem.Command, false, @MenuInfo);
if AMenuItem.Enabled then
fState := fState and DWORD(not (MFS_DISABLED or MFS_GRAYED));
fMask:=MIIM_TYPE or MIIM_STATE;
fType:=Style;
dwTypeData:=PChar(ACaption);
if dwTypeData <> nil then
cch := Length(ACaption);
end;
SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
// owner could be a popupmenu too
if (AMenuItem.Owner is TWinControl) and
TWinControl(AMenuItem.Owner).HandleAllocated and
([csLoading,csDestroying] * TWinControl(AMenuItem.Owner).ComponentState = []) then
DrawMenuBar(TWinControl(AMenuItem.Owner).Handle);
newCaption := ACaption;
if AMenuItem.ShortCut <> 0 then
newCaption := newCaption+#9+ShortCutToText(AMenuItem.ShortCut);
UpdateCaption(AMenuItem, newCaption);
end;
procedure TWin32WSMenuItem.SetShortCut(const AMenuItem: TMenuItem;
@ -284,7 +290,7 @@ var
NewKey: word;
NewModifier: TShiftState;
begin
SetCaption(AMenuItem, LPSTR(AMenuItem.Caption+#9+ShortCutToText(NewShortCut)));
UpdateCaption(AMenuItem, AMenuItem.Caption+#9+ShortCutToText(NewShortCut));
if (AMenuItem.Owner is TWinControl) and AMenuItem.HandleAllocated then
begin
ShortCutToKey(NewShortCut, NewKey, NewModifier);

View File

@ -57,8 +57,8 @@ type
end;
function ShortCutToShortCutText(ShortCut: TShortCut): string;
function ShortCutTextToShortCut(const ShortCutText: string): TShortCut;
function ShortCutToText(ShortCut: TShortCut): string;
function TextToShortCut(const ShortCutText: string): TShortCut;
// Hooks used to prevent unit circles
type
@ -250,7 +250,7 @@ begin
}
end;
function ShortCutToShortCutText(ShortCut: TShortCut): string;
function ShortCutToText(ShortCut: TShortCut): string;
var
Name: string;
begin
@ -281,7 +281,7 @@ begin
else Result := '';
end;
function ShortCutTextToShortCut(const ShortCutText: string): TShortCut;
function TextToShortCut(const ShortCutText: string): TShortCut;
function CompareFront(var StartPos: integer; const Front: string): Boolean;
begin
@ -318,7 +318,7 @@ begin
end;
if ShortCutText = '' then Exit;
for Key := $08 to $255 do begin { Copy range from table in ShortCutToText }
Name:=ShortCutToShortCutText(Key);
Name:=ShortCutToText(Key);
if (Name<>'') and (length(Name)=length(ShortCutText)-StartPos+1)
and (AnsiStrLIComp(@ShortCutText[StartPos], PChar(Name), length(Name)) = 0)
then begin

View File

@ -326,9 +326,6 @@ function ShortCut(const Key: Word; const Shift : TShiftState) : TShortCut;
procedure ShortCutToKey(const ShortCut : TShortCut; var Key: Word;
var Shift : TShiftState);
function TextToShortCut(const ShortCutText: string): TShortCut;
function ShortCutToText(ShortCut: TShortCut): string;
var
DesignerMenuItemClick: TNotifyEvent;
ActivePopupMenu: TPopupMenu;
@ -354,22 +351,12 @@ begin
CommandPool[Result] := True;
end;
function ShortCutToText(ShortCut: TShortCut): string;
begin
Result:=ShortCutToShortCutText(ShortCut);
end;
procedure Register;
begin
RegisterComponents('Standard',[TMainMenu,TPopupMenu]);
RegisterNoIcon([TMenuItem]);
end;
function TextToShortCut(const ShortCutText: string): TShortCut;
begin
Result:=ShortCutTextToShortCut(ShortCutText);
end;
{$I menu.inc}
{$I menuitem.inc}
{$I mainmenu.inc}
@ -413,6 +400,10 @@ end.
{
$Log$
Revision 1.73 2004/10/24 14:50:31 micha
fix menuitem caption issue (partly by martin smat)
remove ShortCutToText and TextToShortCut wrapper functions
Revision 1.72 2004/09/17 10:56:24 micha
convert LM_SHORTCUT message to interface methods