paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 16:38:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat

Browse Source 
git-svn-id: trunk@7310 -
This commit is contained in:
mattias 2005-07-01 12:07:50 +00:00
parent 52e8720495
commit f2ecd38e12
14 changed files with 172 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lcl/include/intfbaselcl.inc
View File

@ -396,16 +396,6 @@ begin
Result:=true;
end;
function TWidgetSet.MenuItemSetCheck(AMenuItem: TComponent): Boolean;
begin
Result := False;
end;
function TWidgetSet.MenuItemSetEnable(AMenuItem: TComponent): Boolean;
begin
Result := False;
end;
Function TWidgetSet.LoadStockPixmap(StockID: longint) : HBitmap;
begin
Case StockID of
@ -584,11 +574,6 @@ begin
Result := false;
end;
function TWidgetSet.RightJustifyMenuItem(AMenuItem: TComponent): Boolean;
begin
Result := False;
end;
procedure TWidgetSet.SendCachedLCLMessages;
begin
end;
@ -626,6 +611,9 @@ end;
{ =============================================================================
$Log$
Revision 1.36 2005/07/01 12:07:49 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.35 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

18
lcl/include/lclintf.inc
View File

@ -294,16 +294,6 @@ begin
Result := InterfaceObject.LoadStockPixmap(StockID);
end;
function MenuItemSetCheck(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.MenuItemSetCheck(AMenuItem);
end;
function MenuItemSetEnable(AMenuItem: TComponent): Boolean;
begin
Result := InterfaceObject.MenuItemSetEnable(AMenuItem);
end;
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean;
begin
Result := InterfaceObject.MoveWindowOrgEx(DC, dX, dY);
@ -404,11 +394,6 @@ begin
Result := InterfaceObject.RequestInput(InputCaption, InputPrompt, MaskInput, Value);
end;
function RightJustifyMenuItem(AMenuItem: TComponent): boolean;
begin
Result := InterfaceObject.RightJustifyMenuItem(AMenuItem);
end;
procedure SendCachedLCLMessages;
begin
end;
@ -525,6 +510,9 @@ end;
{ =============================================================================
$Log$
Revision 1.31 2005/07/01 12:07:49 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.30 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

6
lcl/include/lclintfh.inc
View File

@ -88,8 +88,6 @@ function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; Border
function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MenuItemSetCheck(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MenuItemSetEnable(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function MoveWindowOrgEx(dc : hdc; dX,dY : Integer): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function PairSplitterAddSide(SplitterHandle, SideHandle: hWnd; Side: integer): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -108,7 +106,6 @@ function RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer): Boolean; {$IFDEF
function ReleaseDesignerDC(hWnd: HWND; DC: HDC): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RequestInput(const InputCaption, InputPrompt : String; MaskInput : Boolean; var Value : String) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function RightJustifyMenuItem(AMenuItem: TComponent): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure SendCachedLCLMessages; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DrawSplitter(DC: HDC; const ARect: TRect; Horizontal: boolean): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -150,6 +147,9 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.31 2005/07/01 12:07:49 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.30 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

12
lcl/include/menuitem.inc
View File

@ -849,7 +849,7 @@ begin
if (FParent <> nil)
and not (csReading in ComponentState)
and HandleAllocated
then MenuItemSetCheck(Self);
then TWSMenuItemClass(WidgetSetClass).SetCheck(Self, AValue);
OwnerFormDesignerModified(Self);
end;
end;
@ -879,7 +879,7 @@ begin
if FEnabled <> AValue then begin
FEnabled := AValue;
if HandleAllocated and (Parent <> nil)
then MenuItemSetEnable(Self);
then TWSMenuItemClass(WidgetSetClass).SetEnable(Self, AValue);
MenuChanged(False);
end;
end;
@ -967,7 +967,7 @@ begin
if FRightJustify=AValue then exit;
FRightJustify:=AValue;
if HandleAllocated then
RightJustifyMenuItem(Self);
TWSMenuItemClass(WidgetSetClass).SetRightJustify(Self, AValue);
end;
{------------------------------------------------------------------------------
@ -1212,6 +1212,9 @@ end;
{ =============================================================================
$Log$
Revision 1.69 2005/07/01 12:07:49 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.68 2005/06/08 08:02:09 mattias
added message parts to Help interface
@ -1446,6 +1449,9 @@ end;
$Log$
Revision 1.69 2005/07/01 12:07:49 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.68 2005/06/08 08:02:09 mattias
added message parts to Help interface

18
lcl/interfaces/carbon/carbonlclintf.inc
View File

@ -80,21 +80,6 @@ begin
Result:=inherited IntfSendsUTF8KeyPress;
end;
function TCarbonWidgetSet.MenuItemSetCheck(BaseMenuItem: TComponent): Boolean;
begin
Result:=inherited MenuItemSetCheck(BaseMenuItem);
end;
function TCarbonWidgetSet.MenuItemSetEnable(BaseMenuItem: TComponent): Boolean;
begin
Result:=inherited MenuItemSetEnable(BaseMenuItem);
end;
function TCarbonWidgetSet.RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean;
begin
Result:=inherited RightJustifyMenuItem(BaseMenuItem);
end;
function TCarbonWidgetSet.ReplaceBitmapMask(var Image, Mask: HBitmap;
NewMask: HBitmap): boolean;
begin
@ -124,6 +109,9 @@ end;
{ =============================================================================
$Log$
Revision 1.4 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.3 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

7
lcl/interfaces/carbon/carbonlclintfh.inc
View File

@ -42,10 +42,6 @@ function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRec
function IntfSendsUTF8KeyPress: boolean; override;
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
function RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean; override;
function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; override;
procedure StatusBarPanelUpdate(StatusBar: TObject; Index: integer); override;
@ -58,6 +54,9 @@ procedure StatusBarUpdate(StatusBar: TObject); override;
{ =============================================================================
$Log$
Revision 1.4 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.3 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

76
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -354,79 +354,6 @@ begin
Result:=true;
end;
{------------------------------------------------------------------------------
Function: MenuItemSetCheck
Params: BaseMenuItem
Returns: Nothing
Checks or unchecks the specified menu item.
------------------------------------------------------------------------------}
function TGtkWidgetSet.MenuItemSetCheck(BaseMenuItem: TComponent): Boolean;
var
IsRadio: Boolean;
Group: PGSList;
Item: Pointer;
AMenuItem: TMenuItem;
begin
AMenuItem:=BaseMenuItem as TMenuItem;
Item := Pointer(AMenuItem.Handle);
IsRadio := gtk_is_radio_menu_item(Item);
if IsRadio or gtk_is_check_menu_item(Item)
then begin
if IsRadio
then begin
Group := gtk_radio_menu_item_group(Item);
LockRadioGroupOnChange(Group, +1);
end
else LockOnChange(Item, +1);
gtk_check_menu_item_set_active(Item, AMenuItem.Checked);
if IsRadio
then LockRadioGroupOnChange(Group, -1)
else LockOnChange(Item, -1);
Result := True;
end
else begin
AMenuItem.RecreateHandle;
Result := True;
end;
end;
{------------------------------------------------------------------------------
Function: MenuItemSetEnable
Params: BaseMenuItem:
Returns:
Enables, disables, or grays the specified menu item.
------------------------------------------------------------------------------}
function TGtkWidgetSet.MenuItemSetEnable(BaseMenuItem: TComponent): Boolean;
var
AMenuItem: TMenuItem;
begin
AMenuItem:=BaseMenuItem as TMenuItem;
gtk_widget_set_sensitive(pgtkwidget(AMenuItem.Handle),
AMenuItem.Enabled and (AMenuItem.Caption<>'-'));
Result := True;
end;
{------------------------------------------------------------------------------
Function: RightJustifyMenuItem
Params: HndMenu: HMenu; bRightJustify: boolean
Returns: true on success
Sets left or right justification of a menuitem
-------------------------------------------------------------------------------}
function TGtkWidgetSet.RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean;
var
AMenuItem: TMenuItem;
MenuItemWidget: PGtkMenuItem;
begin
AMenuItem:=BaseMenuItem as TMenuItem;
MenuItemWidget:=PGtkMenuItem(AMenuItem.Handle);
gtk_menu_item_set_right_justified(MenuItemWidget, AMenuItem.RightJustify);
gtk_widget_queue_resize(GTK_WIDGET(MenuItemWidget));
Result:=false;
end;
{------------------------------------------------------------------------------
Procedure: ReplaceBitmapMask
Params: Image The HBitmap of the image
@ -487,6 +414,9 @@ end;
{ =============================================================================
$Log$
Revision 1.39 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.38 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

7
lcl/interfaces/gtk/gtklclintfh.inc
View File

@ -44,10 +44,6 @@ function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRec
function IntfSendsUTF8KeyPress: boolean; override;
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
function RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean; override;
function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean; override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
@ -55,6 +51,9 @@ function ReplaceBitmapMask(var Image, Mask: HBitmap; NewMask: HBitmap): boolean;
{ =============================================================================
$Log$
Revision 1.25 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.24 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

4
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -4239,7 +4239,6 @@ var
root, child: pointer;
winx, winy: Integer;
xmask: Cardinal;
TopList, List: PGList;
begin
Result := False;
@ -9028,6 +9027,9 @@ end;
{ =============================================================================
$Log$
Revision 1.424 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.423 2005/06/25 09:46:23 mattias
simplifies the gtk 1 and 2 Get/SetMousePos from Andrew Haines

48
lcl/interfaces/gtk/gtkwsmenus.pp
View File

@ -48,6 +48,9 @@ type
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); override;
class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
end;
{ TGtkWSMenu }
@ -187,6 +190,51 @@ begin
gtk_widget_hide(MenuItemWidget);
end;
function TGtkWSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean;
var
IsRadio: Boolean;
Group: PGSList;
Item: Pointer;
begin
Item := Pointer(AMenuItem.Handle);
IsRadio := gtk_is_radio_menu_item(Item);
if IsRadio or gtk_is_check_menu_item(Item)
then begin
if IsRadio
then begin
Group := gtk_radio_menu_item_group(Item);
LockRadioGroupOnChange(Group, +1);
end
else LockOnChange(Item, +1);
gtk_check_menu_item_set_active(Item, Checked);
if IsRadio
then LockRadioGroupOnChange(Group, -1)
else LockOnChange(Item, -1);
Result := True;
end
else begin
AMenuItem.RecreateHandle;
Result := True;
end;
end;
function TGtkWSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean;
begin
gtk_widget_set_sensitive(pgtkwidget(AMenuItem.Handle),
Enabled and (AMenuItem.Caption<>'-'));
Result := True;
end;
function TGtkWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean;
var
MenuItemWidget: PGtkMenuItem;
begin
MenuItemWidget:=PGtkMenuItem(AMenuItem.Handle);
gtk_menu_item_set_right_justified(MenuItemWidget, Justified);
gtk_widget_queue_resize(GTK_WIDGET(MenuItemWidget));
Result:=false;
end;
{ TGtkWSMenu }
function TGtkWSMenu.CreateHandle(const AMenu: TMenu): HMENU;

91
lcl/interfaces/win32/win32lclintf.inc
View File

@ -128,99 +128,14 @@ begin
end;
end;
{------------------------------------------------------------------------------
Function: MenuItemSetCheck
Params: BaseMenuItem
Returns: Nothing
Checks or unchecks the specified menu item.
------------------------------------------------------------------------------}
Function TWin32WidgetSet.MenuItemSetCheck(BaseMenuItem: TComponent): Boolean;
function doCheckMenuItem(aMI: TMenuItem; CF: Integer): boolean;
begin
Result := Windows.CheckMenuItem(aMI.Parent.Handle, aMI.Command, CF) <> DWORD($FFFFFFFF);
end;
procedure InterfaceTurnSiblingsOff(aMI: TMenuItem);
var
aParent, aSibling: TMenuItem;
i: integer;
begin
// Just check all siblings that are in the same group
// TMenuItem.TurnSiblingsOff should have modified internal flags
aParent := aMI.Parent;
if aParent <> nil then
for i := 0 to aParent.Count-1 do
begin
aSibling := aParent.Items[i];
if (aSibling <> aMI) and aSibling.RadioItem and (aSibling.GroupIndex=aMI.GroupIndex) then
doCheckMenuItem(aParent[i], MF_UNCHECKED or MF_BYCOMMAND);
end;
end;
var
CheckFlag: Integer;
AMenuItem: TMenuItem;
Begin
AMenuItem:=BaseMenuItem as TMenuItem;
if AMenuItem.Checked then CheckFlag := MF_CHECKED
else CheckFlag := MF_UNCHECKED;
CheckFlag := CheckFlag or MF_BYCOMMAND;
if (CheckFlag and MF_CHECKED <> 0) and
(AMenuItem.GroupIndex <> 0) and AMenuItem.RadioItem
then
InterfaceTurnSiblingsOff(aMenuItem);
Result := doCheckMenuItem(aMenuItem, CheckFlag);
End;
{------------------------------------------------------------------------------
Function: MenuItemSetEnable
Params: BaseMenuItem:
Returns:
Enables, disables, or grays the specified menu item.
------------------------------------------------------------------------------}
Function TWin32WidgetSet.MenuItemSetEnable(BaseMenuItem: TComponent): Boolean;
Var
EnableFlag: Integer;
AMenuItem: TMenuItem;
Begin
AMenuItem:=BaseMenuItem as TMenuItem;
if AMenuItem.Enabled then EnableFlag := MF_ENABLED
else EnableFlag := MF_GRAYED;
EnableFlag := EnableFlag or MF_BYCOMMAND;
Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag));
End;
{------------------------------------------------------------------------------
Function: RightJustifyMenuItem
Params: BaseMenuItem:
Returns:
Sets left or right justification of a menuitem
------------------------------------------------------------------------------}
function TWin32WidgetSet.RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean;
var
AMenuItem: TMenuItem;
MenuInfo: MENUITEMINFO;
begin
AMenuItem:=BaseMenuItem as TMenuItem;
MenuInfo.cbSize := sizeof(MenuInfo);
MenuInfo.fMask := MIIM_TYPE;
GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
if AMenuItem.RightJustify then MenuInfo.fType := MenuInfo.fType or MFT_RIGHTJUSTIFY
else MenuInfo.fType := MenuInfo.fType and (not MFT_RIGHTJUSTIFY);
MenuInfo.dwTypeData := LPSTR(AMenuItem.Caption);
Result := SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
DrawMenuBar(TWinControl(AMenuItem.Owner).Handle);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
{ =============================================================================
$Log$
Revision 1.25 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.24 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

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

@ -35,15 +35,14 @@ function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState)
function GetControlConstraints(Constraints: TObject): boolean; override;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
function MenuItemSetCheck(BaseMenuItem: TComponent): Boolean; override;
function MenuItemSetEnable(BaseMenuItem: TComponent): Boolean; override;
function RightJustifyMenuItem(BaseMenuItem: TComponent): Boolean; override;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
{ =============================================================================
$Log$
Revision 1.18 2005/07/01 12:07:50 mattias
moved some menu intf methods to the TXXXWSMenuItem class from Martin Smat
Revision 1.17 2005/05/21 15:58:44 mattias
implemented right justification for menuitems for winapi intf from Martin Smat

65
lcl/interfaces/win32/win32wsmenus.pp
View File

@ -51,6 +51,10 @@ type
class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); override;
class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
end;
{ TWin32WSMenu }
@ -305,6 +309,67 @@ begin
end;
end;
function TWin32WSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean;
function doCheckMenuItem(aMI: TMenuItem; CF: Integer): boolean;
begin
Result := Windows.CheckMenuItem(aMI.Parent.Handle, aMI.Command, CF) <> DWORD($FFFFFFFF);
end;
procedure InterfaceTurnSiblingsOff(aMI: TMenuItem);
var
aParent, aSibling: TMenuItem;
i: integer;
begin
// Just check all siblings that are in the same group
// TMenuItem.TurnSiblingsOff should have modified internal flags
aParent := aMI.Parent;
if aParent <> nil then
for i := 0 to aParent.Count-1 do
begin
aSibling := aParent.Items[i];
if (aSibling <> aMI) and aSibling.RadioItem and (aSibling.GroupIndex=aMI.GroupIndex) then
doCheckMenuItem(aParent[i], MF_UNCHECKED or MF_BYCOMMAND);
end;
end;
var
CheckFlag: Integer;
begin
if Checked then CheckFlag := MF_CHECKED
else CheckFlag := MF_UNCHECKED;
CheckFlag := CheckFlag or MF_BYCOMMAND;
if (CheckFlag and MF_CHECKED <> 0) and
(AMenuItem.GroupIndex <> 0) and AMenuItem.RadioItem
then
InterfaceTurnSiblingsOff(aMenuItem);
Result := doCheckMenuItem(aMenuItem, CheckFlag);
end;
function TWin32WSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean;
var
EnableFlag: Integer;
begin
if Enabled then EnableFlag := MF_ENABLED
else EnableFlag := MF_GRAYED;
EnableFlag := EnableFlag or MF_BYCOMMAND;
Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag));
end;
function TWin32WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean;
var
MenuInfo: MENUITEMINFO;
begin
MenuInfo.cbSize := sizeof(MenuInfo);
MenuInfo.fMask := MIIM_TYPE;
GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
if Justified then MenuInfo.fType := MenuInfo.fType or MFT_RIGHTJUSTIFY
else MenuInfo.fType := MenuInfo.fType and (not MFT_RIGHTJUSTIFY);
MenuInfo.dwTypeData := LPSTR(AMenuItem.Caption);
Result := SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, false, @MenuInfo);
DrawMenuBar(TWinControl(AMenuItem.Owner).Handle);
end;
{ TWin32WSMenu }
function TWin32WSMenu.CreateHandle(const AMenu: TMenu): HMENU;

21
lcl/widgetset/wsmenus.pp
View File

@ -58,6 +58,9 @@ type
class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); virtual;
class procedure SetShortCut(const AMenuItem: TMenuItem; const OldShortCut, NewShortCut: TShortCut); virtual;
class procedure SetVisible(const AMenuItem: TMenuItem; const Visible: boolean); virtual;
class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; virtual;
class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; virtual;
class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; virtual;
end;
TWSMenuItemClass = class of TWSMenuItem;
@ -110,8 +113,24 @@ end;
procedure TWSMenuItem.SetVisible(const AMenuItem: TMenuItem;
const Visible: boolean);
begin
end;
function TWSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean;
begin
Result := false;
end;
function TWSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean;
begin
Result := false;
end;
function TWSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean;
begin
Result := false;
end;
{ TWSMenu }