home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / Rxmenus.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  60KB  |  1,858 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1997, 1998 Master-Bank          }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxMenus;
  10.  
  11. {$I RX.INC}
  12. {$S-,W-,R-}
  13.  
  14. interface
  15.  
  16. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} SysUtils,
  17.   Classes, Controls, Messages, Graphics, {$IFDEF RX_D4} ImgList, {$ENDIF}
  18.   Menus, RxHook;
  19.  
  20. type
  21.   TRxMenuStyle = (msStandard, msOwnerDraw {$IFDEF WIN32}, msBtnLowered,
  22.     msBtnRaised {$ENDIF});
  23.   TMenuOwnerDrawState = set of (mdSelected, mdGrayed, mdDisabled, mdChecked,
  24.     mdFocused {$IFDEF WIN32}, mdDefault {$ENDIF});
  25.  
  26.   TDrawMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; Rect: TRect;
  27.     State: TMenuOwnerDrawState) of object;
  28.   TMeasureMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; var Width,
  29.     Height: Integer) of object;
  30.   TDrawMarginEvent = procedure(Sender: TMenu; Rect: TRect) of object;
  31.   TItemParamsEvent = procedure(Sender: TMenu; Item: TMenuItem;
  32.     State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor;
  33.     var Graphic: TGraphic; var NumGlyphs: Integer) of object;
  34. {$IFDEF WIN32}
  35.   TItemImageEvent = procedure(Sender: TMenu; Item: TMenuItem;
  36.     State: TMenuOwnerDrawState; var ImageIndex: Integer) of object;
  37. {$ENDIF}
  38.  
  39. { TRxMainMenu }
  40.  
  41.   TRxMainMenu = class(TMainMenu)
  42.   private
  43.     FStyle: TRxMenuStyle;
  44.     FCanvas: TCanvas;
  45.     FHook: TRxWindowHook;
  46.     FShowCheckMarks: Boolean;
  47.     FMinTextOffset: Cardinal;
  48.     FCursor: TCursor;
  49.     FOnDrawItem: TDrawMenuItemEvent;
  50.     FOnMeasureItem: TMeasureMenuItemEvent;
  51.     FOnGetItemParams: TItemParamsEvent;
  52. {$IFDEF WIN32}
  53.     FImages: TImageList;
  54.     FImageChangeLink: TChangeLink;
  55.     FOnGetImageIndex: TItemImageEvent;
  56.     procedure SetImages(Value: TImageList);
  57.     procedure ImageListChange(Sender: TObject);
  58. {$ENDIF}
  59.     procedure SetStyle(Value: TRxMenuStyle);
  60.     function FindForm: TWinControl;
  61.     procedure WndMessage(Sender: TObject; var AMsg: TMessage;
  62.       var Handled: Boolean);
  63.     procedure CMMenuChanged(var Message: TMessage); message CM_MENUCHANGED;
  64.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  65.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  66.     procedure WMMenuSelect(var Message: TWMMenuSelect); message WM_MENUSELECT;
  67.   protected
  68.     procedure Loaded; override;
  69. {$IFDEF WIN32}
  70.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  71.     procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  72.       var ImageIndex: Integer); dynamic;
  73. {$ENDIF}
  74.     procedure DrawItem(Item: TMenuItem; Rect: TRect;
  75.       State: TMenuOwnerDrawState); virtual;
  76.     procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  77.       AFont: TFont; var Color: TColor; var Graphic: TGraphic;
  78.       var NumGlyphs: Integer); dynamic;
  79.     procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
  80.     procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
  81.     function IsOwnerDrawMenu: Boolean;
  82.   public
  83.     constructor Create(AOwner: TComponent); override;
  84.     destructor Destroy; override;
  85.     procedure Refresh;
  86.     procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  87.       State: TMenuOwnerDrawState);
  88.     property Canvas: TCanvas read FCanvas;
  89.   published
  90.     property Cursor: TCursor read FCursor write FCursor default crDefault;
  91.     property MinTextOffset: Cardinal read FMinTextOffset write FMinTextOffset default 0;
  92.     property Style: TRxMenuStyle read FStyle write SetStyle default msStandard;
  93.     property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default True;
  94. {$IFDEF RX_D4}
  95.     property OwnerDraw stored False;
  96. {$ENDIF}
  97. {$IFDEF WIN32}
  98.     property Images: TImageList read FImages write SetImages;
  99.     property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  100. {$ENDIF}
  101.     property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
  102.     property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;
  103.     property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  104.   end;
  105.  
  106. { TRxPopupMenu }
  107.  
  108.   TRxPopupMenu = class(TPopupMenu)
  109.   private
  110.     FStyle: TRxMenuStyle;
  111.     FCanvas: TCanvas;
  112.     FShowCheckMarks: Boolean;
  113.     FMinTextOffset: Cardinal;
  114.     FLeftMargin: Cardinal;
  115.     FCursor: TCursor;
  116.     FOnDrawItem: TDrawMenuItemEvent;
  117.     FOnMeasureItem: TMeasureMenuItemEvent;
  118.     FOnDrawMargin: TDrawMarginEvent;
  119.     FOnGetItemParams: TItemParamsEvent;
  120. {$IFDEF RX_D4}
  121.     FPopupPoint: TPoint;
  122.     FParentBiDiMode: Boolean;
  123. {$ENDIF}
  124. {$IFDEF WIN32}
  125.     FImages: TImageList;
  126.     FImageChangeLink: TChangeLink;
  127.     FOnGetImageIndex: TItemImageEvent;
  128.     procedure SetImages(Value: TImageList);
  129.     procedure ImageListChange(Sender: TObject);
  130. {$ENDIF}
  131.     procedure SetStyle(Value: TRxMenuStyle);
  132.     procedure WndMessage(Sender: TObject; var AMsg: TMessage;
  133.       var Handled: Boolean);
  134.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  135.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  136. {$IFDEF RX_D4}
  137.     procedure SetBiDiModeFromPopupControl;
  138. {$ENDIF}
  139.   protected
  140.     procedure Loaded; override;
  141. {$IFDEF RX_D4}
  142.     function UseRightToLeftAlignment: Boolean;
  143. {$ENDIF}
  144. {$IFDEF WIN32}
  145.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  146.     procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  147.       var ImageIndex: Integer); dynamic;
  148. {$ENDIF}
  149.     procedure DrawItem(Item: TMenuItem; Rect: TRect;
  150.       State: TMenuOwnerDrawState); virtual;
  151.     procedure DrawMargin(ARect: TRect); virtual;
  152.     procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  153.       AFont: TFont; var Color: TColor; var Graphic: TGraphic;
  154.       var NumGlyphs: Integer); dynamic;
  155.     procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
  156.     procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
  157.     function IsOwnerDrawMenu: Boolean;
  158.   public
  159.     constructor Create(AOwner: TComponent); override;
  160.     destructor Destroy; override;
  161.     procedure Refresh;
  162.     procedure Popup(X, Y: Integer); override;
  163.     procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  164.       State: TMenuOwnerDrawState);
  165.     procedure DefaultDrawMargin(ARect: TRect; StartColor, EndColor: TColor);
  166.     property Canvas: TCanvas read FCanvas;
  167.   published
  168.     property Cursor: TCursor read FCursor write FCursor default crDefault;
  169.     property LeftMargin: Cardinal read FLeftMargin write FLeftMargin default 0;
  170.     property MinTextOffset: Cardinal read FMinTextOffset write FMinTextOffset default 0;
  171.     property Style: TRxMenuStyle read FStyle write SetStyle default msStandard;
  172.     property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default True;
  173. {$IFDEF RX_D4}
  174.     property OwnerDraw stored False;
  175. {$ENDIF}
  176. {$IFDEF WIN32}
  177.     property Images: TImageList read FImages write SetImages;
  178.     property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  179. {$ENDIF}
  180.     property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
  181.     property OnDrawMargin: TDrawMarginEvent read FOnDrawMargin write FOnDrawMargin;
  182.     property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;
  183.     property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  184.   end;
  185.  
  186. { Utility routines }
  187.  
  188. procedure SetDefaultMenuFont(AFont: TFont);
  189. function IsItemPopup(Item: TMenuItem): Boolean;
  190.  
  191. implementation
  192.  
  193. uses {$IFDEF WIN32} CommCtrl, {$ENDIF} Forms, ExtCtrls, Consts, RxConst,
  194.   MaxMin, VclUtils, ClipIcon, rxStrUtils;
  195.  
  196. const
  197.   DefMarginColor: TColor = clBlue;
  198.   AddWidth = 2;
  199.   AddHeight = 4;
  200.   Tab = #9#9;
  201.   Separator = '-';
  202.  
  203. type
  204.   TBtnStyle = (bsNone, bsLowered, bsRaised, bsOffice);
  205.  
  206. function BtnStyle(MenuStyle: TRxMenuStyle): TBtnStyle;
  207. begin
  208. {$IFDEF WIN32}
  209.   case MenuStyle of
  210.     msBtnLowered: Result := bsLowered;
  211.     msBtnRaised: Result := bsRaised;
  212.     else Result := bsNone;
  213.   end;
  214. {$ELSE}
  215.   Result := bsNone;
  216. {$ENDIF}
  217. end;
  218.  
  219. function IsItemPopup(Item: TMenuItem): Boolean;
  220. begin
  221.   Result := (Item.Parent = nil) or (Item.Parent.Parent <> nil) or
  222.     not (Item.Parent.Owner is TMainMenu);
  223. end;
  224.  
  225. {$IFNDEF WIN32}
  226. const
  227.   { return codes for WM_MENUCHAR (not defined in Delphi 1.0) }
  228.   MNC_IGNORE = 0;
  229.   MNC_CLOSE = 1;
  230.   MNC_EXECUTE = 2;
  231.   MNC_SELECT = 3;
  232. {$ENDIF}
  233.  
  234. {$IFNDEF RX_D4}
  235. procedure ProcessMenuChar(AMenu: TMenu; var Message: TWMMenuChar);
  236. var
  237.   C, I, First, Hilite, Next: Integer;
  238.   State: Word;
  239.  
  240.   function IsAccelChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  241.   var
  242.     Item: TMenuItem;
  243.     Id: Cardinal;
  244.   begin
  245.     Item := nil;
  246.     if State and MF_POPUP <> 0 then begin
  247.       Menu := GetSubMenu(Menu, I);
  248.       Item := AMenu.FindItem(Menu, fkHandle);
  249.     end
  250.     else begin
  251.       Id := GetMenuItemID(Menu, I);
  252.       if Id <> {$IFDEF WIN32} $FFFFFFFF {$ELSE} $FFFF {$ENDIF} then
  253.         Item := AMenu.FindItem(Id, fkCommand);
  254.     end;
  255.     if Item <> nil then Result := IsAccel(Ord(C), Item.Caption)
  256.     else Result := False;
  257.   end;
  258.  
  259.   function IsInitialChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  260.   var
  261.     Item: TMenuItem;
  262.   begin
  263.     if State and MF_POPUP <> 0 then begin
  264.       Menu := GetSubMenu(Menu, I);
  265.       Item := AMenu.FindItem(Menu, fkHandle);
  266.     end
  267.     else begin
  268.       Item := AMenu.FindItem(Menu, fkHandle);
  269.       if Item <> nil then Item := Item.Items[I];
  270.     end;
  271.     if (Item <> nil) and (Item.Caption <> '') then
  272.       Result := AnsiCompareText(Item.Caption[1], C) = 0
  273.     else Result := False;
  274.   end;
  275.  
  276. begin
  277.   with Message do begin
  278.     Result := MNC_IGNORE; { No item found: beep }
  279.     First := -1;
  280.     Hilite := -1;
  281.     Next := -1;
  282.     C := GetMenuItemCount(Menu);
  283.     for I := 0 to C - 1 do begin
  284.       State := GetMenuState(Menu, I, MF_BYPOSITION);
  285.       if IsAccelChar(Menu, State, I, User) then begin
  286.         if State and MF_DISABLED <> 0 then begin
  287.           { Close the menu if this is the only disabled item to choose from.
  288.             Otherwise, ignore the item. }
  289.           if First < 0 then First := -2;
  290.           Continue;
  291.         end;
  292.         if First < 0 then begin
  293.           First := I;
  294.           Result := MNC_EXECUTE;
  295.         end
  296.         else Result := MNC_SELECT;
  297.         if State and MF_HILITE <> 0 then Hilite := I
  298.         else if Hilite >= 0 then Next := I;
  299.       end;
  300.     end;
  301.     { We found a single disabled item. End the selection. }
  302.     if First < -1 then begin
  303.       Result := MNC_CLOSE shl 16;
  304.       Exit;
  305.     end;
  306.  
  307.     { If we can't find accelerators, then look for initial letters }
  308.     if First < 0 then
  309.       for I := 0 to C - 1 do begin
  310.         State := GetMenuState(Menu, I, MF_BYPOSITION);
  311.         if IsInitialChar(Menu, State, I, User) then begin
  312.           if State and MF_DISABLED <> 0 then begin
  313.             Result := MNC_CLOSE shl 16;
  314.             Exit;
  315.           end;
  316.           if First < 0 then begin
  317.             First := I;
  318.             Result := MNC_EXECUTE;
  319.           end
  320.           else Result := MNC_SELECT;
  321.           if State and MF_HILITE <> 0 then Hilite := I
  322.           else if Hilite >= 0 then Next := I;
  323.         end;
  324.       end;
  325.  
  326.     if (Result = MNC_EXECUTE) then Result := Result shl 16 or First
  327.     else if Result = MNC_SELECT then begin
  328.       if Next < 0 then Next := First;
  329.       Result := Result shl 16 or Next;
  330.     end;
  331.   end;
  332. end;
  333. {$ENDIF RX_D4}
  334.  
  335. procedure MenuWndMessage(Menu: TMenu; var AMsg: TMessage; var Handled: Boolean);
  336. var
  337.   Message: TMessage;
  338.   Item: Pointer;
  339. begin
  340.   with AMsg do
  341.     case Msg of
  342.       WM_MEASUREITEM:
  343.         if (TWMMeasureItem(AMsg).MeasureItemStruct^.CtlType = ODT_MENU) then
  344.         begin
  345.           Item := Menu.FindItem(TWMMeasureItem(AMsg).MeasureItemStruct^.itemID, fkCommand);
  346.           if Item <> nil then begin
  347.             Message := AMsg;
  348.             TWMMeasureItem(Message).MeasureItemStruct^.ItemData := Longint(Item);
  349.             Menu.Dispatch(Message);
  350.             Result := 1;
  351.             Handled := True;
  352.           end;
  353.         end;
  354.       WM_DRAWITEM:
  355.         if (TWMDrawItem(AMsg).DrawItemStruct^.CtlType = ODT_MENU) then
  356.         begin
  357.           Item := Menu.FindItem(TWMDrawItem(AMsg).DrawItemStruct^.itemID, fkCommand);
  358.           if Item <> nil then begin
  359.             Message := AMsg;
  360.             TWMDrawItem(Message).DrawItemStruct^.ItemData := Longint(Item);
  361.             Menu.Dispatch(Message);
  362.             Result := 1;
  363.             Handled := True;
  364.           end;
  365.         end;
  366.       WM_MENUSELECT: Menu.Dispatch(AMsg);
  367.       CM_MENUCHANGED: Menu.Dispatch(AMsg);
  368.       WM_MENUCHAR:
  369.         begin
  370. {$IFDEF RX_D4}
  371.           Menu.ProcessMenuChar(TWMMenuChar(AMsg));
  372. {$ELSE}
  373.           ProcessMenuChar(Menu, TWMMenuChar(AMsg));
  374. {$ENDIF}
  375.         end;
  376.     end;
  377. end;
  378.  
  379. {$IFNDEF RX_D4}
  380. procedure RefreshMenuItem(MenuItem: TMenuItem; OwnerDraw: Boolean);
  381. const
  382.   Breaks: array[TMenuBreak] of Longint = (0, MF_MENUBREAK, MF_MENUBARBREAK);
  383.   Checks: array[Boolean] of LongInt = (MF_UNCHECKED, MF_CHECKED);
  384.   Enables: array[Boolean] of LongInt = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  385.   Separators: array[Boolean] of LongInt = (MF_STRING, MF_SEPARATOR);
  386. {$IFDEF WIN32}
  387.   IBreaks: array[TMenuBreak] of DWORD = (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  388.   IRadios: array[Boolean] of DWORD = (MFT_STRING, MFT_RADIOCHECK);
  389.   ISeparators: array[Boolean] of DWORD = (MFT_STRING, MFT_SEPARATOR);
  390.   IOwnerDraw: array[Boolean] of DWORD = (MFT_STRING, MFT_OWNERDRAW);
  391. {$ENDIF}
  392. var
  393. {$IFDEF WIN32}
  394.   MenuItemInfo: TMenuItemInfo;
  395. {$ENDIF}
  396.   CCaption: array[0..255] of Char;
  397.   NewFlags: Integer;
  398.   ItemID, I, C: Integer;
  399.   MenuHandle: THandle;
  400.   Item: TMenuItem;
  401.  
  402. {$IFDEF WIN32}
  403.   procedure PrepareItemInfo;
  404.   begin
  405.     FillChar(MenuItemInfo, SizeOf(TMenuItemInfo), 0);
  406.     with MenuItemInfo do begin
  407.       cbSize := SizeOf(TMenuItemInfo);
  408.       fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or MIIM_STATE or
  409.         MIIM_SUBMENU or MIIM_TYPE;
  410.       cch := SizeOf(CCaption) - 1;
  411.     end;
  412.   end;
  413. {$ENDIF}
  414.  
  415. begin
  416.   if (MenuItem <> nil) then begin
  417.     StrPCopy(CCaption, MenuItem.Caption);
  418.     NewFlags := Breaks[MenuItem.Break] or Checks[MenuItem.Checked] or
  419.       Enables[MenuItem.Enabled] or Separators[MenuItem.Caption = Separator] or
  420.       MF_BYCOMMAND;
  421.     ItemID := MenuItem.Command;
  422.     if MenuItem.Count > 0 then begin
  423.       NewFlags := NewFlags or MF_POPUP;
  424.       ItemID := MenuItem.Handle;
  425.     end
  426.     else begin
  427.       if (MenuItem.ShortCut <> scNone) and ((MenuItem.Parent = nil) or
  428.         (MenuItem.Parent.Parent <> nil) or
  429.         not (MenuItem.Parent.Owner is TMainMenu)) then
  430.           StrPCopy(StrECopy(StrEnd(CCaption), Tab),
  431.             ShortCutToText(MenuItem.ShortCut));
  432.     end;
  433.     Item := MenuItem;
  434.     while Item.Parent <> nil do Item := Item.Parent;
  435.     if (Item.Owner <> nil) and (Item.Owner is TMenu) then
  436.       MenuHandle := TMenu(Item.Owner).Handle
  437.     else
  438.       MenuHandle := Item.Handle;
  439. {$IFDEF WIN32}
  440.     if Lo(GetVersion) >= 4 then begin
  441.       FillChar(MenuItemInfo, SizeOf(TMenuItemInfo), 0);
  442.       MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);
  443.       if MenuItem.Count > 0 then begin
  444.         MenuItemInfo.fMask := MIIM_DATA or MIIM_TYPE;
  445.         with MenuItem do
  446.           MenuItemInfo.fType := IRadios[RadioItem] or IBreaks[Break] or
  447.             ISeparators[Caption = Separator] or IOwnerDraw[OwnerDraw];
  448.         MenuItemInfo.dwTypeData := CCaption;
  449.         SetMenuItemInfo(MenuHandle, MenuItem.Command, False, MenuItemInfo);
  450.       end
  451.       else begin
  452.         C := GetMenuItemCount(MenuHandle);
  453.         ItemID := -1;
  454.         for I := 0 to C - 1 do begin
  455.           PrepareItemInfo;
  456.           MenuItemInfo.dwTypeData := CCaption;
  457.           GetMenuItemInfo(MenuHandle, I, True, MenuItemInfo);
  458.           if MenuItemInfo.wID = MenuItem.Command then begin
  459.             ItemID := I;
  460.             Break;
  461.           end;
  462.         end;
  463.         if (ItemID < 0) and (MenuItem.Parent <> nil) then begin
  464.           MenuHandle := MenuItem.Parent.Handle;
  465.           C := GetMenuItemCount(MenuHandle);
  466.           for I := 0 to C - 1 do begin
  467.             PrepareItemInfo;
  468.             MenuItemInfo.dwTypeData := CCaption;
  469.             GetMenuItemInfo(MenuHandle, I, True, MenuItemInfo);
  470.             if MenuItemInfo.wID = MenuItem.Command then begin
  471.               ItemID := I;
  472.               Break;
  473.             end;
  474.           end;
  475.         end;
  476.         if ItemID < 0 then Exit;
  477.         with MenuItem do
  478.           MenuItemInfo.fType := IRadios[RadioItem] or IBreaks[Break] or
  479.             ISeparators[Caption = Separator] or IOwnerDraw[OwnerDraw];
  480.         MenuItemInfo.dwTypeData := CCaption;
  481.         DeleteMenu(MenuHandle, MenuItem.Command, MF_BYCOMMAND);
  482.         InsertMenuItem(MenuHandle, ItemID, True, MenuItemInfo);
  483.       end;
  484.     end
  485.     else
  486. {$ENDIF WIN32}
  487.     begin
  488.       if OwnerDraw then begin
  489.         ModifyMenu(MenuHandle, MenuItem.Command, NewFlags or MF_OWNERDRAW and
  490.           not MF_STRING, ItemID, PChar(MenuItem));
  491.       end
  492.       else begin
  493.         ModifyMenu(MenuHandle, MenuItem.Command, NewFlags, ItemID, CCaption);
  494.       end;
  495.     end;
  496.     for I := 0 to MenuItem.Count - 1 do
  497.       RefreshMenuItem(MenuItem.Items[I], OwnerDraw);
  498.   end;
  499. end;
  500. {$ENDIF RX_D4}
  501.  
  502. procedure SetDefaultMenuFont(AFont: TFont);
  503. {$IFDEF WIN32}
  504. var
  505.   NCMetrics: TNonCLientMetrics;
  506. {$ENDIF}
  507. begin
  508. {$IFDEF WIN32}
  509.   if NewStyleControls then begin
  510.     NCMetrics.cbSize := SizeOf(TNonCLientMetrics);
  511.     if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
  512.     begin
  513.       AFont.Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
  514.       Exit;
  515.     end;
  516.   end;
  517. {$ENDIF}
  518.   with AFont do begin
  519.     if NewStyleControls then Name := 'MS Sans Serif'
  520.     else Name := 'System';
  521.     Size := 8;
  522.     Color := clMenuText;
  523.     Style := [];
  524.   end;
  525.   AFont.Color := clMenuText;
  526. end;
  527.  
  528. function GetDefItemHeight: Integer;
  529. begin
  530.   Result := GetSystemMetrics(SM_CYMENU);
  531.   if NewStyleControls then Dec(Result, 2);
  532. end;
  533.  
  534. function GetMarginOffset: Integer;
  535. begin
  536.   Result := Round(LoWord(GetMenuCheckMarkDimensions) * 0.3);
  537. end;
  538.  
  539. procedure MenuLine(Canvas: TCanvas; C: TColor; X1, Y1, X2, Y2: Integer);
  540. begin
  541.   with Canvas do begin
  542.     Pen.Color := C;
  543.     MoveTo(X1, Y1);
  544.     LineTo(X2, Y2);
  545.   end;
  546. end;
  547.  
  548. procedure DrawDisabledBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap;
  549.   State: TMenuOwnerDrawState);
  550. const
  551.   ROP_DSPDxax = $00E20746;
  552. var
  553.   Bmp: TBitmap;
  554.   GrayColor, SaveColor: TColor;
  555.   IsHighlight: Boolean;
  556. begin
  557.   if (mdSelected in State) then GrayColor := clGrayText
  558.   else GrayColor := clBtnShadow;
  559.   IsHighlight := NewStyleControls and ((not (mdSelected in State)) or
  560.     (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) =
  561.     GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))));
  562.   if Bitmap.Monochrome then begin
  563.     SaveColor := Canvas.Brush.Color;
  564.     try
  565.       if IsHighlight then begin
  566.         Canvas.Brush.Color := clBtnHighlight;
  567.         SetTextColor(Canvas.Handle, clWhite);
  568.         SetBkColor(Canvas.Handle, clBlack);
  569.         BitBlt(Canvas.Handle, X + 1, Y + 1, Bitmap.Width, Bitmap.Height,
  570.           Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
  571.       end;
  572.       Canvas.Brush.Color := GrayColor;
  573.       SetTextColor(Canvas.Handle, clWhite);
  574.       SetBkColor(Canvas.Handle, clBlack);
  575.       BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
  576.         Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
  577.     finally
  578.       Canvas.Brush.Color := SaveColor;
  579.     end;
  580.   end
  581.   else begin
  582.     Bmp := CreateDisabledBitmapEx(Bitmap, clBlack, clMenu,
  583.       clBtnHighlight, GrayColor, IsHighlight);
  584.     try
  585.       DrawBitmapTransparent(Canvas, X, Y, Bmp, clMenu);
  586.     finally
  587.       Bmp.Free;
  588.     end;
  589.   end;
  590. end;
  591.  
  592. procedure DrawMenuBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap;
  593.   IsColor: Boolean; State: TMenuOwnerDrawState);
  594. begin
  595.   if (mdDisabled in State) then
  596.     DrawDisabledBitmap(Canvas, X, Y, Bitmap, State)
  597.   else begin
  598.     if Bitmap.Monochrome and not IsColor then
  599.       BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
  600.         Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
  601.     else
  602.       DrawBitmapTransparent(Canvas, X, Y, Bitmap, Bitmap.TransparentColor
  603.         and not PaletteMask);
  604.   end;
  605. end;
  606.  
  607. procedure DrawMenuItem(AMenu: TMenu; Item: TMenuItem; Glyph: TGraphic;
  608.   NumGlyphs: Integer; Canvas: TCanvas; ShowCheck: Boolean; Buttons: TBtnStyle;
  609.   Rect: TRect; MinOffset: {$IFDEF RX_D4} Integer {$ELSE} Cardinal {$ENDIF};
  610.   State: TMenuOwnerDrawState {$IFDEF WIN32}; Images: TImageList;
  611.   ImageIndex: Integer {$ENDIF});
  612. var
  613.   Left, LineTop, MaxWidth, I, W: Integer;
  614.   CheckSize: Longint;
  615.   BtnRect: TRect;
  616.   IsPopup, DrawHighlight, DrawLowered: Boolean;
  617.   GrayColor: TColor;
  618.   Bmp: TBitmap;
  619. {$IFDEF WIN32}
  620.   Ico: HIcon;
  621.   H: Integer;
  622. {$ENDIF}
  623. {$IFDEF RX_D4}
  624.   ParentMenu: TMenu;
  625. {$ENDIF}
  626.  
  627.   procedure MenuTextOut(X, Y: Integer; const Text: string; Flags: Longint);
  628.   var
  629.     R: TRect;
  630.   begin
  631.     if Length(Text) = 0 then Exit;
  632. {$IFDEF RX_D4}
  633.     if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then begin
  634.       if Flags and DT_LEFT = DT_LEFT then
  635.         Flags := Flags and (not DT_LEFT) or DT_RIGHT
  636.       else if Flags and DT_RIGHT = DT_RIGHT then
  637.         Flags := Flags and (not DT_RIGHT) or DT_LEFT;
  638.       Flags := Flags or DT_RTLREADING;
  639.     end;
  640. {$ENDIF}
  641.     R := Rect; R.Left := X; R.Top := Y;
  642.     if (mdDisabled in State) then begin
  643.       if DrawHighlight then begin
  644.         Canvas.Font.Color := clBtnHighlight;
  645.         OffsetRect(R, 1, 1);
  646.         DrawText(Canvas.Handle, @Text[1], Length(Text), R, Flags);
  647.         OffsetRect(R, -1, -1);
  648.       end;
  649.       Canvas.Font.Color := GrayColor;
  650.     end;
  651.     DrawText(Canvas.Handle, @Text[1], Length(Text), R, Flags)
  652.   end;
  653.  
  654.   procedure DrawCheckImage(X, Y: Integer);
  655.   begin
  656.     Bmp := TBitmap.Create;
  657.     try
  658. {$IFDEF WIN32}
  659.       with Bmp do begin
  660.         Width := LoWord(CheckSize);
  661.         Height := HiWord(CheckSize);
  662.       end;
  663.       if Item.RadioItem then begin
  664.         with Bmp do begin
  665.           DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height),
  666.             DFC_MENU, DFCS_MENUBULLET);
  667.           Monochrome := True;
  668.         end;
  669.       end
  670.       else begin
  671.         with Bmp do begin
  672.           DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height),
  673.             DFC_MENU, DFCS_MENUCHECK);
  674.           Monochrome := True;
  675.         end;
  676.       end;
  677. {$ELSE}
  678.       Bmp.Handle := LoadBitmap(0, PChar(32760));
  679. {$ENDIF}
  680.       DrawMenuBitmap(Canvas, X, Y, Bmp, DrawLowered, State);
  681.     finally
  682.       Bmp.Free;
  683.     end;
  684.   end;
  685.  
  686.   procedure DrawGlyphCheck(ARect: TRect);
  687.   var
  688.     SaveColor: TColor;
  689.     Bmp: TBitmap;
  690.   begin
  691.     InflateRect(ARect, 0, -1);
  692.     SaveColor := Canvas.Brush.Color;
  693.     try
  694.       if not (mdSelected in State) then
  695. {$IFDEF RX_D4}
  696.         Bmp := AllocPatternBitmap(clMenu, clBtnHighlight)
  697. {$ELSE}
  698.         Bmp := CreateTwoColorsBrushPattern(clMenu, clBtnHighlight)
  699. {$ENDIF}
  700.       else Bmp := nil;
  701.       try
  702.         if Bmp <> nil then Canvas.Brush.Bitmap := Bmp
  703.         else Canvas.Brush.Color := clMenu;
  704.         Canvas.FillRect(ARect);
  705.       finally
  706.         Canvas.Brush.Bitmap := nil;
  707. {$IFNDEF RX_D4}
  708.         Bmp.Free;
  709. {$ENDIF}
  710.       end;
  711.     finally
  712.       Canvas.Brush.Color := SaveColor;
  713.     end;
  714.     Frame3D(Canvas, ARect, GrayColor, clBtnHighlight, 1);
  715.   end;
  716.  
  717. {$IFDEF WIN32}
  718.   function UseImages: Boolean;
  719.   begin
  720.     Result := Assigned(Images) and (ImageIndex >= 0) and
  721.       (ImageIndex < Images.Count) and Images.HandleAllocated;
  722.   end;
  723. {$ENDIF}
  724.  
  725. begin
  726.   IsPopup := IsItemPopup(Item);
  727.   
  728.   DrawLowered := Item.Checked and IsPopup and not (ShowCheck or
  729.     (Buttons in [bsLowered, bsRaised]));
  730.   DrawHighlight := NewStyleControls and (not (mdSelected in State) or
  731.     (Buttons in [bsLowered, bsRaised]) or (not IsPopup and
  732.     (Buttons = bsOffice)) or
  733.     (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) =
  734.     GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))));
  735.   if (mdSelected in State) and not (Buttons in [bsLowered, bsRaised]) then
  736.     GrayColor := clGrayText
  737.   else GrayColor := clBtnShadow;
  738.   if IsPopup then begin
  739.     if ShowCheck then
  740.       CheckSize := GetMenuCheckMarkDimensions
  741.     else
  742.       CheckSize := 2;
  743.     Left := 2 * GetMarginOffset + LoWord(CheckSize);
  744.   end
  745.   else begin
  746.     MinOffset := 0;
  747.     CheckSize := 0;
  748.     Left := GetMarginOffset + 2;
  749.   end;
  750.   if (Buttons <> bsNone) and (mdSelected in State) then begin
  751.     case Buttons of
  752.       bsLowered: Frame3D(Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
  753.       bsRaised: Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, 1);
  754.       bsOffice:
  755.         if not IsPopup then
  756.           Frame3D(Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
  757.     end;
  758.   end;
  759.   if Assigned(Item) then begin
  760. {$IFDEF RX_D4}
  761.     ParentMenu := Item.GetParentMenu;
  762. {$ENDIF}
  763.     if Item.Checked and ShowCheck and IsPopup then begin
  764.       DrawCheckImage(Rect.Left + (Left - LoWord(CheckSize)) div 2,
  765.         (Rect.Bottom + Rect.Top - HiWord(CheckSize)) div 2);
  766.     end;
  767. {$IFDEF WIN32}
  768.     if Assigned(Images) and IsPopup then
  769.       MinOffset := Max(MinOffset, Images.Width + AddWidth);
  770. {$ENDIF}
  771.     if not ShowCheck and (Assigned(Glyph) or (MinOffset > 0)) then
  772.       if Buttons = bsOffice then Left := 1
  773.       else Left := GetMarginOffset;
  774. {$IFDEF WIN32}
  775.     if UseImages then begin
  776.       W := Images.Width + AddWidth;
  777.       if W < Integer(MinOffset) then W := MinOffset;
  778.       BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, W + 2,
  779.         Rect.Bottom - Rect.Top);
  780.       if DrawLowered then DrawGlyphCheck(BtnRect)
  781.       else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  782.         not ShowCheck then
  783.       begin
  784.         Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  785.       end;
  786.       if (mdDisabled in State) then
  787.         ImageListDrawDisabled(Images, Canvas, Rect.Left + Left +
  788.           (W - Images.Width) div 2, (Rect.Bottom + Rect.Top -
  789.           Images.Height) div 2, ImageIndex, clBtnHighlight, GrayColor,
  790.           DrawHighlight)
  791.       else ImageList_Draw(Images.Handle, ImageIndex, Canvas.Handle,
  792.         Rect.Left + Left + (W - Images.Width) div 2, (Rect.Bottom +
  793.         Rect.Top - Images.Height) div 2, ILD_NORMAL);
  794.       Inc(Left, W + GetMarginOffset);
  795.     end else
  796. {$ENDIF}
  797.     if Assigned(Glyph) and not Glyph.Empty and (Item.Caption <> Separator) then
  798.     begin
  799.       W := Glyph.Width;
  800.       if (Glyph is TBitmap) and (NumGlyphs in [2..5]) then
  801.         W := W div NumGlyphs;
  802.       W := Max(W + AddWidth, MinOffset);
  803. {$IFDEF WIN32}
  804.       if not (Glyph is TIcon) then
  805. {$ENDIF}
  806.       begin
  807.         BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, W + 2,
  808.           Rect.Bottom - Rect.Top);
  809.         if DrawLowered then DrawGlyphCheck(BtnRect)
  810.         else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  811.           not ShowCheck then
  812.         begin
  813.           Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  814.         end;
  815.       end;
  816.       if Glyph is TBitmap then begin
  817.         if (NumGlyphs in [2..5]) then begin
  818.           I := 0;
  819.           if (mdDisabled in State) then I := 1
  820.           else if (mdChecked in State) then I := 3
  821.           else if (mdSelected in State) then I := 2;
  822.           if I > NumGlyphs - 1 then I := 0;
  823.           Bmp := TBitmap.Create;
  824.           try
  825.             AssignBitmapCell(Glyph, Bmp, NumGlyphs, 1, I);
  826.             DrawMenuBitmap(Canvas, Rect.Left + Left + (W - Bmp.Width) div 2,
  827.               (Rect.Bottom + Rect.Top - Bmp.Height) div 2, Bmp, DrawLowered,
  828.               State - [mdDisabled]);
  829.           finally
  830.             Bmp.Free;
  831.           end;
  832.         end
  833.         else DrawMenuBitmap(Canvas, Rect.Left + Left + (W - Glyph.Width) div 2,
  834.           (Rect.Bottom + Rect.Top - Glyph.Height) div 2, TBitmap(Glyph),
  835.           DrawLowered, State);
  836.         Inc(Left, W + GetMarginOffset);
  837.       end
  838. {$IFDEF WIN32}
  839.       else if Glyph is TIcon then begin
  840.         Ico := CreateRealSizeIcon(TIcon(Glyph));
  841.         try
  842.           GetIconSize(Ico, W, H);
  843.           I := Max(W + AddWidth, MinOffset);
  844.           BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, I + 2,
  845.             Rect.Bottom - Rect.Top);
  846.           if DrawLowered then DrawGlyphCheck(BtnRect)
  847.           else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  848.             not ShowCheck then
  849.           begin
  850.             Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  851.           end;
  852.           DrawIconEx(Canvas.Handle, Rect.Left + Left + (I - W) div 2,
  853.             (Rect.Top + Rect.Bottom - H) div 2, Ico, W, H, 0, 0, DI_NORMAL);
  854.           Inc(Left, I + GetMarginOffset);
  855.         finally
  856.           DestroyIcon(Ico);
  857.         end;
  858.       end
  859. {$ENDIF}
  860.       else begin
  861.         Canvas.Draw(Rect.Left + Left + (W - Glyph.Width) div 2,
  862.           (Rect.Bottom + Rect.Top - Glyph.Height) div 2, Glyph);
  863.         Inc(Left, W + GetMarginOffset);
  864.       end;
  865.     end
  866.     else if (MinOffset > 0) then begin
  867.       BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, MinOffset + 2,
  868.         Rect.Bottom - Rect.Top);
  869.       if DrawLowered then begin
  870.         DrawGlyphCheck(BtnRect);
  871.         CheckSize := GetMenuCheckMarkDimensions;
  872.         DrawCheckImage(BtnRect.Left + 2 + (MinOffset - LoWord(CheckSize)) div 2,
  873.           (Rect.Bottom + Rect.Top - HiWord(CheckSize)) div 2 + 1);
  874.       end
  875.       else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  876.         not ShowCheck then
  877.       begin
  878.         Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  879.       end;
  880.       Inc(Left, MinOffset + GetMarginOffset);
  881.     end;
  882.     if Item.Caption = Separator then begin
  883.       LineTop := (Rect.Top + Rect.Bottom) div 2 - 1;
  884.       if NewStyleControls then begin
  885.         Canvas.Pen.Width := 1;
  886.         MenuLine(Canvas, clBtnShadow, Rect.Left, LineTop, Rect.Right, LineTop);
  887.         MenuLine(Canvas, clBtnHighlight, Rect.Left, LineTop + 1, Rect.Right, LineTop + 1);
  888.       end
  889.       else begin
  890.         Canvas.Pen.Width := 2;
  891.         MenuLine(Canvas, clMenuText, Rect.Left, LineTop + 1, Rect.Right, LineTop + 1);
  892.       end;
  893.     end
  894.     else begin
  895.       MaxWidth := Canvas.TextWidth(DelChars(Item.Caption, '&') + Tab);
  896.       if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin
  897.         for I := 0 to Item.Parent.Count - 1 do
  898.           MaxWidth := Max(Canvas.TextWidth(DelChars(Item.Parent.Items[I].Caption,
  899.             '&') + Tab), MaxWidth);
  900.       end;
  901.       Canvas.Brush.Style := bsClear;
  902.       LineTop := (Rect.Bottom + Rect.Top - Canvas.TextHeight('Ay')) div 2;
  903.       MenuTextOut(Rect.Left + Left, LineTop, Item.Caption, DT_EXPANDTABS or
  904.         DT_LEFT or DT_SINGLELINE);
  905.       if (Item.ShortCut <> scNone) and (Item.Count = 0) and IsPopup then begin
  906.         MenuTextOut(Rect.Left + Left + MaxWidth, LineTop,
  907.           ShortCutToText(Item.ShortCut), DT_EXPANDTABS or DT_LEFT or
  908.           DT_SINGLELINE);
  909.       end;
  910.     end;
  911.   end;
  912. end;
  913.  
  914. procedure MenuMeasureItem(AMenu: TMenu; Item: TMenuItem; Canvas: TCanvas;
  915.   ShowCheck: Boolean; Glyph: TGraphic; NumGlyphs: Integer; var ItemWidth,
  916.   ItemHeight: Integer; MinOffset: Cardinal {$IFDEF WIN32}; Images: TImageList;
  917.   ImageIndex: Integer {$ENDIF});
  918. var
  919.   IsPopup: Boolean;
  920.   W, H: Integer;
  921. {$IFDEF WIN32}
  922.   Ico: HIcon;
  923. {$ENDIF}
  924.  
  925.   function GetTextWidth(Item: TMenuItem): Integer;
  926.   var
  927.     I, MaxW: Integer;
  928.   begin
  929.     if IsPopup then begin
  930.       Result := Canvas.TextWidth(DelChars(Item.Caption, '&') + Tab);
  931.       MaxW := Canvas.TextWidth(ShortCutToText(Item.ShortCut) + ' ');
  932.       if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin
  933.         for I := 0 to Item.Parent.Count - 1 do
  934.           with Item.Parent.Items[I] do begin
  935.             Result := Max(Result, Canvas.TextWidth(DelChars(Caption, '&') + Tab));
  936.             MaxW := Max(MaxW, Canvas.TextWidth(ShortCutToText(ShortCut) + ' '));
  937.           end;
  938.       end;
  939.       Result := Result + MaxW;
  940.       if Item.Count > 0 then Inc(Result, Canvas.TextWidth(Tab));
  941.     end
  942.     else Result := Canvas.TextWidth(DelChars(Item.Caption, '&'));
  943.   end;
  944.  
  945. begin
  946.   IsPopup := IsItemPopup(Item);
  947.   ItemHeight := GetDefItemHeight;
  948.   if IsPopup then begin
  949.     ItemWidth := GetMarginOffset * 2;
  950. {$IFDEF WIN32}
  951.     if Assigned(Images) then
  952.       MinOffset := Max(MinOffset, Images.Width + AddWidth);
  953. {$ENDIF}
  954.   end
  955.   else begin
  956.     ItemWidth := 0;
  957.     MinOffset := 0;
  958.   end;
  959.   Inc(ItemWidth, GetTextWidth(Item));
  960.   if IsPopup and ShowCheck then
  961.     Inc(ItemWidth, LoWord(GetMenuCheckMarkDimensions));
  962.   if Item.Caption = Separator then begin
  963.     ItemHeight := Max(Canvas.TextHeight(Separator) div 2, 9);
  964.   end
  965.   else begin
  966.     ItemHeight := Max(ItemHeight, Canvas.TextHeight(Item.Caption));
  967. {$IFDEF WIN32}
  968.     if Assigned(Images) and (IsPopup or ((ImageIndex >= 0) and
  969.       (ImageIndex < Images.Count))) then
  970.     begin
  971.       Inc(ItemWidth, Max(Images.Width + AddWidth, MinOffset));
  972.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  973.       if (ImageIndex >= 0) and (ImageIndex < Images.Count) then
  974.         ItemHeight := Max(ItemHeight, Images.Height + AddHeight);
  975.     end else
  976. {$ENDIF}
  977.     if Assigned(Glyph) and not Glyph.Empty then begin
  978.       W := Glyph.Width;
  979.       if (Glyph is TBitmap) and (NumGlyphs in [2..5]) then
  980.         W := W div NumGlyphs;
  981.       H := Glyph.Height;
  982. {$IFDEF WIN32}
  983.       if Glyph is TIcon then begin
  984.         Ico := CreateRealSizeIcon(TIcon(Glyph));
  985.         try
  986.           GetIconSize(Ico, W, H);
  987.         finally
  988.           DestroyIcon(Ico);
  989.         end;
  990.       end;
  991. {$ENDIF}
  992.       W := Max(W + AddWidth, MinOffset);
  993.       Inc(ItemWidth, W);
  994.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  995.       ItemHeight := Max(ItemHeight, H + AddHeight);
  996.     end
  997.     else if MinOffset > 0 then begin
  998.       Inc(ItemWidth, MinOffset);
  999.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  1000.     end;
  1001.   end;
  1002. end;
  1003.  
  1004. { TRxMainMenu }
  1005.  
  1006. constructor TRxMainMenu.Create(AOwner: TComponent);
  1007. begin
  1008.   inherited Create(AOwner);
  1009.   FCanvas := TControlCanvas.Create;
  1010.   FShowCheckMarks := True;
  1011.   FHook := TRxWindowHook.Create(Self);
  1012.   FHook.AfterMessage := WndMessage;
  1013. {$IFDEF WIN32}
  1014.   FImageChangeLink := TChangeLink.Create;
  1015.   FImageChangeLink.OnChange := ImageListChange;
  1016. {$ENDIF}
  1017. end;
  1018.  
  1019. destructor TRxMainMenu.Destroy;
  1020. begin
  1021. {$IFDEF WIN32}
  1022.   FImageChangeLink.Free;
  1023. {$ENDIF}
  1024.   SetStyle(msStandard);
  1025.   FHook.Free;
  1026.   FCanvas.Free;
  1027.   inherited Destroy;
  1028. end;
  1029.  
  1030. procedure TRxMainMenu.Loaded;
  1031. begin
  1032.   inherited Loaded;
  1033.   if IsOwnerDrawMenu then RefreshMenu(True);
  1034. end;
  1035.  
  1036. function TRxMainMenu.IsOwnerDrawMenu: Boolean;
  1037. begin
  1038.   Result := (FStyle <> msStandard)
  1039.     {$IFDEF WIN32} or (Assigned(FImages) and (FImages.Count > 0)) {$ENDIF};
  1040. end;
  1041.  
  1042. {$IFDEF WIN32}
  1043. procedure TRxMainMenu.Notification(AComponent: TComponent; Operation: TOperation);
  1044. begin
  1045.   inherited Notification(AComponent, Operation);
  1046.   if Operation = opRemove then begin
  1047.     if AComponent = FImages then SetImages(nil);
  1048.   end;
  1049. end;
  1050.  
  1051. procedure TRxMainMenu.ImageListChange(Sender: TObject);
  1052. begin
  1053.   if Sender = FImages then RefreshMenu(IsOwnerDrawMenu);
  1054. end;
  1055.  
  1056. procedure TRxMainMenu.SetImages(Value: TImageList);
  1057. var
  1058.   OldOwnerDraw: Boolean;
  1059. begin
  1060.   OldOwnerDraw := IsOwnerDrawMenu;
  1061.   if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink);
  1062.   FImages := Value;
  1063.   if Value <> nil then begin
  1064.     FImages.RegisterChanges(FImageChangeLink);
  1065.     FImages.FreeNotification(Self);
  1066.   end;
  1067.   if IsOwnerDrawMenu then FHook.WinControl := FindForm
  1068.   else FHook.WinControl := nil;
  1069.   if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw);
  1070. end;
  1071. {$ENDIF}
  1072.  
  1073. procedure TRxMainMenu.SetStyle(Value: TRxMenuStyle);
  1074. begin
  1075.   if FStyle <> Value then begin
  1076.     FStyle := Value;
  1077.     if IsOwnerDrawMenu then FHook.WinControl := FindForm
  1078.     else FHook.WinControl := nil;
  1079.     RefreshMenu(IsOwnerDrawMenu);
  1080.   end;
  1081. end;
  1082.  
  1083. function TRxMainMenu.FindForm: TWinControl;
  1084. begin
  1085.   Result := FindControl(WindowHandle);
  1086.   if (Result = nil) and (Owner is TWinControl) then
  1087.     Result := TWinControl(Owner);
  1088. end;
  1089.  
  1090. procedure TRxMainMenu.Refresh;
  1091. begin
  1092.   RefreshMenu(IsOwnerDrawMenu);
  1093. end;
  1094.  
  1095. procedure TRxMainMenu.RefreshMenu(AOwnerDraw: Boolean);
  1096. {$IFDEF RX_D4}
  1097. begin
  1098.   Self.OwnerDraw := AOwnerDraw and (FHook.WinControl <> nil) and
  1099.     not (csDesigning in ComponentState);
  1100. {$ELSE}
  1101. var
  1102.   I: Integer;
  1103. begin
  1104.   if AOwnerDraw and (FHook.WinControl = nil) then Exit;
  1105.   if not (csDesigning in ComponentState) then
  1106.     for I := 0 to Items.Count - 1 do
  1107.       RefreshMenuItem(Items[I], AOwnerDraw);
  1108. {$ENDIF}
  1109. end;
  1110.  
  1111. procedure TRxMainMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  1112.   State: TMenuOwnerDrawState);
  1113. var
  1114.   Graphic: TGraphic;
  1115.   BackColor: TColor;
  1116.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1117. begin
  1118.   if Canvas.Handle <> 0 then begin
  1119.     Graphic := nil;
  1120.     BackColor := Canvas.Brush.Color;
  1121.     NumGlyphs := 1;
  1122.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1123. {$IFDEF WIN32}
  1124. {$IFDEF RX_D4}
  1125.     ImageIndex := Item.ImageIndex;
  1126. {$ELSE}
  1127.     ImageIndex := -1;
  1128. {$ENDIF}
  1129.     GetImageIndex(Item, State, ImageIndex);
  1130. {$ENDIF}
  1131.     DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1132.       BtnStyle(Style), Rect, FMinTextOffset, State
  1133.       {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1134.   end;
  1135. end;
  1136.  
  1137. procedure TRxMainMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  1138.   State: TMenuOwnerDrawState);
  1139. var
  1140.   Graphic: TGraphic;
  1141.   BackColor: TColor;
  1142.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1143. begin
  1144.   if Canvas.Handle <> 0 then begin
  1145.     Graphic := nil;
  1146.     BackColor := Canvas.Brush.Color;
  1147.     NumGlyphs := 1;
  1148.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1149.     if BackColor <> clNone then begin
  1150.       Canvas.Brush.Color := BackColor;
  1151.       Canvas.FillRect(Rect);
  1152.     end;
  1153.     if Assigned(FOnDrawItem) then FOnDrawItem(Self, Item, Rect, State)
  1154.     else begin
  1155. {$IFDEF WIN32}
  1156. {$IFDEF RX_D4}
  1157.       ImageIndex := Item.ImageIndex;
  1158. {$ELSE}
  1159.       ImageIndex := -1;
  1160. {$ENDIF}
  1161.       GetImageIndex(Item, State, ImageIndex);
  1162. {$ENDIF}
  1163.       DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1164.         BtnStyle(Style), Rect, FMinTextOffset, State
  1165.         {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1166.     end;
  1167.   end;
  1168. end;
  1169.  
  1170. procedure TRxMainMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
  1171. begin
  1172.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height)
  1173. end;
  1174.  
  1175. procedure TRxMainMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  1176.   var Handled: Boolean);
  1177. begin
  1178.   if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled);
  1179. end;
  1180.  
  1181. procedure TRxMainMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  1182.   AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
  1183. begin
  1184.   if Assigned(FOnGetItemParams) then
  1185.     FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  1186.   if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil;
  1187. end;
  1188.  
  1189. {$IFDEF WIN32}
  1190. procedure TRxMainMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  1191.   var ImageIndex: Integer);
  1192. begin
  1193.   if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
  1194.     Assigned(FOnGetImageIndex) then
  1195.     FOnGetImageIndex(Self, Item, State, ImageIndex);
  1196. end;
  1197. {$ENDIF}
  1198.  
  1199. procedure TRxMainMenu.CMMenuChanged(var Message: TMessage);
  1200. begin
  1201. {$IFNDEF RX_D4}
  1202.   if IsOwnerDrawMenu then RefreshMenu(True);
  1203. {$ENDIF}
  1204. end;
  1205.  
  1206. procedure TRxMainMenu.WMDrawItem(var Message: TWMDrawItem);
  1207. var
  1208.   State: TMenuOwnerDrawState;
  1209.   SaveIndex: Integer;
  1210.   Item: TMenuItem;
  1211. begin
  1212.   with Message.DrawItemStruct^ do begin
  1213. {$IFDEF WIN32}
  1214.     State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1215. {$ELSE}
  1216.     State := TMenuOwnerDrawState(WordRec(itemState).Lo);
  1217. {$ENDIF}
  1218.     {if (mdDisabled in State) then State := State - [mdSelected];}
  1219.     Item := TMenuItem(Pointer(itemData));
  1220.     if Assigned(Item) and
  1221.       (FindItem(Item.Command, fkCommand) = Item) then
  1222.     begin
  1223.       SaveIndex := SaveDC(hDC);
  1224.       try
  1225.         FCanvas.Handle := hDC;
  1226.         SetDefaultMenuFont(FCanvas.Font);
  1227.         FCanvas.Font.Color := clMenuText;
  1228.         FCanvas.Brush.Color := clMenu;
  1229. {$IFDEF WIN32}
  1230.         if mdDefault in State then
  1231.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1232. {$ENDIF}
  1233.         if (mdSelected in State) {$IFDEF WIN32} and not
  1234.           (Style in [msBtnLowered, msBtnRaised]) {$ENDIF} then
  1235.         begin
  1236.           FCanvas.Brush.Color := clHighlight;
  1237.           FCanvas.Font.Color := clHighlightText;
  1238.         end;
  1239.         with rcItem do
  1240.           IntersectClipRect(FCanvas.Handle, Left, Top, Right, Bottom);
  1241.         DrawItem(Item, rcItem, State);
  1242.         FCanvas.Handle := 0;
  1243.       finally
  1244.         RestoreDC(hDC, SaveIndex);
  1245.       end;
  1246.     end;
  1247.   end;
  1248. end;
  1249.  
  1250. procedure TRxMainMenu.WMMeasureItem(var Message: TWMMeasureItem);
  1251. var
  1252.   Item: TMenuItem;
  1253.   Graphic: TGraphic;
  1254.   BackColor: TColor;
  1255.   DC: HDC;
  1256.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1257. begin
  1258.   with Message.MeasureItemStruct^ do begin
  1259.     Item := TMenuItem(Pointer(itemData));
  1260.     if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then
  1261.     begin
  1262.       DC := GetDC(0);
  1263.       try
  1264.         FCanvas.Handle := DC;
  1265.         SetDefaultMenuFont(FCanvas.Font);
  1266. {$IFDEF WIN32}
  1267.         if Item.Default then
  1268.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1269. {$ENDIF}
  1270.         Graphic := nil;
  1271.         BackColor := FCanvas.Brush.Color;
  1272.         NumGlyphs := 1;
  1273.         GetItemParams(Item, [], FCanvas.Font, BackColor, Graphic, NumGlyphs);
  1274. {$IFDEF WIN32}
  1275. {$IFDEF RX_D4}
  1276.         ImageIndex := Item.ImageIndex;
  1277. {$ELSE}
  1278.         ImageIndex := -1;
  1279. {$ENDIF}
  1280.         GetImageIndex(Item, [], ImageIndex);
  1281. {$ENDIF}
  1282.         MenuMeasureItem(Self, Item, FCanvas, FShowCheckMarks, Graphic,
  1283.           NumGlyphs, Integer(itemWidth), Integer(itemHeight), FMinTextOffset
  1284.           {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1285.         MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
  1286.       finally
  1287.         FCanvas.Handle := 0;
  1288.         ReleaseDC(0, DC);
  1289.       end;
  1290.     end;
  1291.   end;
  1292. end;
  1293.  
  1294. procedure TRxMainMenu.WMMenuSelect(var Message: TWMMenuSelect);
  1295. var
  1296.   MenuItem: TMenuItem;
  1297.   FindKind: TFindItemKind;
  1298.   MenuID: Integer;
  1299. begin
  1300.   if FCursor <> crDefault then
  1301.     with Message do begin
  1302.       FindKind := fkCommand;
  1303.       if MenuFlag and MF_POPUP <> 0 then begin
  1304.         FindKind := fkHandle;
  1305.         MenuId := GetSubMenu(Menu, IDItem);
  1306.       end
  1307.       else MenuId := IDItem;
  1308.       MenuItem := FindItem(MenuId, FindKind);
  1309.       if (MenuItem <> nil) and (IsItemPopup(MenuItem) or (MenuItem.Count = 0))
  1310.         and (MenuFlag and MF_HILITE <> 0) then
  1311.         SetCursor(Screen.Cursors[FCursor])
  1312.       else SetCursor(Screen.Cursors[crDefault]);
  1313.     end;
  1314. end;
  1315.  
  1316. { TPopupList }
  1317.  
  1318. type
  1319.   TPopupList = class(TList)
  1320.   private
  1321. {$IFNDEF WIN32}
  1322.     FMenuHelp: THelpContext;
  1323. {$ENDIF}
  1324.     procedure WndProc(var Message: TMessage);
  1325.   public
  1326.     Window: HWND;
  1327.     procedure Add(Popup: TPopupMenu);
  1328.     procedure Remove(Popup: TPopupMenu);
  1329.   end;
  1330.  
  1331. const
  1332.   PopupList: TPopupList = nil;
  1333.  
  1334. procedure TPopupList.WndProc(var Message: TMessage);
  1335. var
  1336.   I: Integer;
  1337.   MenuItem: TMenuItem;
  1338.   FindKind: TFindItemKind;
  1339.   ContextID: Integer;
  1340.   Handled: Boolean;
  1341. begin
  1342.   try
  1343.     case Message.Msg of
  1344.       WM_MEASUREITEM, WM_DRAWITEM:
  1345.         for I := 0 to Count - 1 do begin
  1346.           Handled := False;
  1347.           TRxPopupMenu(Items[I]).WndMessage(nil, Message, Handled);
  1348.           if Handled then Exit;
  1349.         end;
  1350.       WM_COMMAND:
  1351.         for I := 0 to Count - 1 do
  1352.           if TRxPopupMenu(Items[I]).DispatchCommand(Message.wParam) then Exit;
  1353.       WM_INITMENUPOPUP:
  1354.         for I := 0 to Count - 1 do
  1355.           with TWMInitMenuPopup(Message) do
  1356.             if TRxPopupMenu(Items[I]).DispatchPopup(MenuPopup) then Exit;
  1357.       WM_MENUSELECT:
  1358.         with TWMMenuSelect(Message) do begin
  1359.           FindKind := fkCommand;
  1360.           if MenuFlag and MF_POPUP <> 0 then begin
  1361.             FindKind := fkHandle;
  1362.             ContextId := GetSubMenu(Menu, IDItem);
  1363.           end
  1364.           else ContextId := IDItem;
  1365.           for I := 0 to Count - 1 do begin
  1366.             MenuItem := TRxPopupMenu(Items[I]).FindItem(ContextId, FindKind);
  1367.             if MenuItem <> nil then begin
  1368. {$IFNDEF WIN32}
  1369.               FMenuHelp := MenuItem.HelpContext;
  1370. {$ENDIF}
  1371.               Application.Hint := MenuItem.Hint;
  1372.               with TRxPopupMenu(Items[I]) do
  1373.                 if FCursor <> crDefault then begin
  1374.                   if (MenuFlag and MF_HILITE <> 0) then
  1375.                     SetCursor(Screen.Cursors[FCursor])
  1376.                   else SetCursor(Screen.Cursors[crDefault]);
  1377.                 end;
  1378.               Exit;
  1379.             end;
  1380.           end;
  1381. {$IFNDEF WIN32}
  1382.           FMenuHelp := 0;
  1383. {$ENDIF}
  1384.           Application.Hint := '';
  1385.         end;
  1386.       WM_MENUCHAR:
  1387.         for I := 0 to Count - 1 do
  1388.           with TRxPopupMenu(Items[I]) do
  1389.             if (Handle = HMenu(Message.LParam)) or
  1390.               (FindItem(Message.LParam, fkHandle) <> nil) then
  1391.             begin
  1392. {$IFDEF RX_D4}
  1393.               ProcessMenuChar(TWMMenuChar(Message));
  1394. {$ELSE}
  1395.               ProcessMenuChar(TRxPopupMenu(Items[I]), TWMMenuChar(Message));
  1396. {$ENDIF}
  1397.               Exit;
  1398.             end;
  1399. {$IFDEF WIN32}
  1400.       WM_HELP:
  1401.         with PHelpInfo(Message.LParam)^ do begin
  1402.           for I := 0 to Count - 1 do
  1403.             if TRxPopupMenu(Items[I]).Handle = hItemHandle then begin
  1404.               ContextID := TMenu(Items[I]).GetHelpContext(iCtrlID, True);
  1405.               if ContextID = 0 then
  1406.                 ContextID := TMenu(Items[I]).GetHelpContext(hItemHandle, False);
  1407.               if Screen.ActiveForm = nil then Exit;
  1408.               if (biHelp in Screen.ActiveForm.BorderIcons) then
  1409.                 Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID)
  1410.               else
  1411.                 Application.HelpContext(ContextID);
  1412.               Exit;
  1413.             end;
  1414.         end;
  1415. {$ELSE}
  1416.       WM_ENTERIDLE:
  1417.         if (TWMEnterIdle(Message).Source = MSGF_MENU) and
  1418.           (GetKeyState(VK_F1) < 0) and (FMenuHelp <> 0) then
  1419.         begin
  1420.           Application.HelpContext(FMenuHelp);
  1421.           FMenuHelp := 0;
  1422.           Exit;
  1423.         end;
  1424. {$ENDIF WIN32}
  1425.     end;
  1426.     with Message do Result := DefWindowProc(Window, Msg, wParam, lParam);
  1427.   except
  1428.     Application.HandleException(Self);
  1429.   end;
  1430. end;
  1431.  
  1432. procedure TPopupList.Add(Popup: TPopupMenu);
  1433. begin
  1434.   if Count = 0 then Window := AllocateHWnd(WndProc);
  1435.   inherited Add(Popup);
  1436. end;
  1437.  
  1438. procedure TPopupList.Remove(Popup: TPopupMenu);
  1439. begin
  1440.   inherited Remove(Popup);
  1441.   if Count = 0 then DeallocateHWnd(Window);
  1442. end;
  1443.  
  1444. { TRxPopupMenu }
  1445.  
  1446. constructor TRxPopupMenu.Create(AOwner: TComponent);
  1447. begin
  1448.   inherited Create(AOwner);
  1449.   if PopupList = nil then
  1450.     PopupList := TPopupList.Create;
  1451.   FShowCheckMarks := True;
  1452.   FCanvas := TControlCanvas.Create;
  1453.   FCursor := crDefault;
  1454.   PopupList.Add(Self);
  1455. {$IFDEF WIN32}
  1456.   FImageChangeLink := TChangeLink.Create;
  1457.   FImageChangeLink.OnChange := ImageListChange;
  1458. {$ENDIF}
  1459. {$IFDEF RX_D4}
  1460.   FPopupPoint := Point(-1, -1);
  1461. {$ENDIF}
  1462. end;
  1463.  
  1464. destructor TRxPopupMenu.Destroy;
  1465. begin
  1466. {$IFDEF WIN32}
  1467.   FImageChangeLink.Free;
  1468. {$ENDIF}
  1469.   SetStyle(msStandard);
  1470.   PopupList.Remove(Self);
  1471.   FCanvas.Free;
  1472.   inherited Destroy;
  1473. end;
  1474.  
  1475. procedure TRxPopupMenu.Loaded;
  1476. begin
  1477.   inherited Loaded;
  1478.   if IsOwnerDrawMenu then RefreshMenu(True);
  1479. end;
  1480.  
  1481. {$IFDEF WIN32}
  1482. procedure TRxPopupMenu.Notification(AComponent: TComponent; Operation: TOperation);
  1483. begin
  1484.   inherited Notification(AComponent, Operation);
  1485.   if Operation = opRemove then begin
  1486.     if AComponent = FImages then SetImages(nil);
  1487.   end;
  1488. end;
  1489.  
  1490. procedure TRxPopupMenu.ImageListChange(Sender: TObject);
  1491. begin
  1492.   if Sender = FImages then RefreshMenu(IsOwnerDrawMenu);
  1493. end;
  1494.  
  1495. procedure TRxPopupMenu.SetImages(Value: TImageList);
  1496. var
  1497.   OldOwnerDraw: Boolean;
  1498. begin
  1499.   OldOwnerDraw := IsOwnerDrawMenu;
  1500.   if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink);
  1501.   FImages := Value;
  1502.   if Value <> nil then begin
  1503.     FImages.RegisterChanges(FImageChangeLink);
  1504.     FImages.FreeNotification(Self);
  1505.   end;
  1506.   if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw);
  1507. end;
  1508. {$ENDIF}
  1509.  
  1510. {$IFDEF RX_D4}
  1511. function FindPopupControl(const Pos: TPoint): TControl;
  1512. var
  1513.   Window: TWinControl;
  1514. begin
  1515.   Result := nil;
  1516.   Window := FindVCLWindow(Pos);
  1517.   if Window <> nil then begin
  1518.     Result := Window.ControlAtPos(Pos, False);
  1519.     if Result = nil then Result := Window;
  1520.   end;
  1521. end;
  1522.  
  1523. procedure TRxPopupMenu.SetBiDiModeFromPopupControl;
  1524. var
  1525.   AControl: TControl;
  1526. begin
  1527.   if not SysLocale.MiddleEast then Exit;
  1528.   if FParentBiDiMode then begin
  1529.     AControl := FindPopupControl(FPopupPoint);
  1530.     if AControl <> nil then
  1531.       BiDiMode := AControl.BiDiMode
  1532.     else
  1533.       BiDiMode := Application.BiDiMode;
  1534.   end;
  1535. end;
  1536.  
  1537. function TRxPopupMenu.UseRightToLeftAlignment: Boolean;
  1538. var
  1539.   AControl: TControl;
  1540. begin
  1541.   Result := False;
  1542.   if not SysLocale.MiddleEast then Exit;
  1543.   if FParentBiDiMode then begin
  1544.     AControl := FindPopupControl(FPopupPoint);
  1545.     if AControl <> nil then
  1546.       Result := AControl.UseRightToLeftAlignment
  1547.     else
  1548.       Result := Application.UseRightToLeftAlignment;
  1549.   end
  1550.   else Result := (BiDiMode = bdRightToLeft);
  1551. end;
  1552. {$ENDIF RX_D4}
  1553.  
  1554. procedure TRxPopupMenu.Popup(X, Y: Integer);
  1555. const
  1556. {$IFDEF RX_D4}
  1557.   Flags: array[Boolean, TPopupAlignment] of Word =
  1558.     ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
  1559.      (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  1560.   Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
  1561. {$ELSE}
  1562.   Flags: array[TPopupAlignment] of Word = (TPM_LEFTALIGN, TPM_RIGHTALIGN,
  1563.     TPM_CENTERALIGN);
  1564. {$ENDIF}
  1565. var
  1566.   FOnPopup: TNotifyEvent;
  1567. begin
  1568. {$IFDEF RX_D4}
  1569.   FPopupPoint := Point(X, Y);
  1570.   FParentBiDiMode := ParentBiDiMode;
  1571.   try
  1572.     SetBiDiModeFromPopupControl;
  1573. {$ENDIF}
  1574.     FOnPopup := OnPopup;
  1575.     if Assigned(FOnPopup) then FOnPopup(Self);
  1576.     if IsOwnerDrawMenu then RefreshMenu(True);
  1577. {$IFNDEF WIN32}
  1578.     PopupList.FMenuHelp := HelpContext;
  1579. {$ENDIF}
  1580. {$IFDEF RX_D4}
  1581.     AdjustBiDiBehavior;
  1582.     TrackPopupMenu(Items.Handle,
  1583.       Flags[UseRightToLeftAlignment, Alignment] or Buttons[TrackButton], X, Y,
  1584.       0 { reserved }, PopupList.Window, nil);
  1585.   finally
  1586.     ParentBiDiMode := FParentBiDiMode;
  1587.   end;
  1588. {$ELSE}
  1589.   TrackPopupMenu(Items.Handle, Flags[Alignment] or TPM_RIGHTBUTTON, X, Y,
  1590.     0 { reserved }, PopupList.Window, nil);
  1591. {$ENDIF}
  1592. end;
  1593.  
  1594. procedure TRxPopupMenu.Refresh;
  1595. begin
  1596.   RefreshMenu(IsOwnerDrawMenu);
  1597. end;
  1598.  
  1599. function TRxPopupMenu.IsOwnerDrawMenu: Boolean;
  1600. begin
  1601.   Result := (FStyle <> msStandard)
  1602.     {$IFDEF WIN32} or (Assigned(FImages) and (FImages.Count > 0)) {$ENDIF};
  1603. end;
  1604.  
  1605. procedure TRxPopupMenu.RefreshMenu(AOwnerDraw: Boolean);
  1606. {$IFDEF RX_D4}
  1607. begin
  1608.   Self.OwnerDraw := AOwnerDraw and not (csDesigning in ComponentState);
  1609. {$ELSE}
  1610. var
  1611.   I: Integer;
  1612. begin
  1613.   if not (csDesigning in ComponentState) then
  1614.     for I := 0 to Items.Count - 1 do
  1615.       RefreshMenuItem(Items[I], AOwnerDraw);
  1616. {$ENDIF}
  1617. end;
  1618.  
  1619. procedure TRxPopupMenu.SetStyle(Value: TRxMenuStyle);
  1620. begin
  1621.   if FStyle <> Value then begin
  1622.     FStyle := Value;
  1623.     RefreshMenu(IsOwnerDrawMenu);
  1624.   end;
  1625. end;
  1626.  
  1627. procedure TRxPopupMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  1628.   State: TMenuOwnerDrawState);
  1629. var
  1630.   Graphic: TGraphic;
  1631.   BackColor: TColor;
  1632.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1633. begin
  1634.   if Canvas.Handle <> 0 then begin
  1635.     Graphic := nil;
  1636.     BackColor := Canvas.Brush.Color;
  1637.     NumGlyphs := 1;
  1638.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1639. {$IFDEF WIN32}
  1640. {$IFDEF RX_D4}
  1641.     ImageIndex := Item.ImageIndex;
  1642. {$ELSE}
  1643.     ImageIndex := -1;
  1644. {$ENDIF}
  1645.     GetImageIndex(Item, State, ImageIndex);
  1646. {$ENDIF}
  1647.     DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1648.       BtnStyle(Style), Rect, FMinTextOffset, State
  1649.       {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1650.   end;
  1651. end;
  1652.  
  1653. procedure TRxPopupMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  1654.   State: TMenuOwnerDrawState);
  1655. var
  1656.   Graphic: TGraphic;
  1657.   BackColor: TColor;
  1658.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1659. begin
  1660.   if Canvas.Handle <> 0 then begin
  1661.     Graphic := nil;
  1662.     BackColor := Canvas.Brush.Color;
  1663.     NumGlyphs := 1;
  1664.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1665.     if BackColor <> clNone then begin
  1666.       Canvas.Brush.Color := BackColor;
  1667.       Canvas.FillRect(Rect);
  1668.     end;
  1669.     if Assigned(FOnDrawItem) then FOnDrawItem(Self, Item, Rect, State)
  1670.     else begin
  1671. {$IFDEF WIN32}
  1672. {$IFDEF RX_D4}
  1673.       ImageIndex := Item.ImageIndex;
  1674. {$ELSE}
  1675.       ImageIndex := -1;
  1676. {$ENDIF}
  1677.       GetImageIndex(Item, State, ImageIndex);
  1678. {$ENDIF}
  1679.       DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1680.         BtnStyle(Style), Rect, FMinTextOffset, State
  1681.         {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1682.     end;
  1683.   end;
  1684. end;
  1685.  
  1686. procedure TRxPopupMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
  1687. begin
  1688.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height)
  1689. end;
  1690.  
  1691. procedure TRxPopupMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  1692.   var Handled: Boolean);
  1693. begin
  1694.   if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled);
  1695. end;
  1696.  
  1697. procedure TRxPopupMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  1698.   AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
  1699. begin
  1700.   if Assigned(FOnGetItemParams) then
  1701.     FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  1702.   if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil;
  1703. end;
  1704.  
  1705. {$IFDEF WIN32}
  1706. procedure TRxPopupMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  1707.   var ImageIndex: Integer);
  1708. begin
  1709.   if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
  1710.     Assigned(FOnGetImageIndex) then
  1711.     FOnGetImageIndex(Self, Item, State, ImageIndex);
  1712. end;
  1713. {$ENDIF}
  1714.  
  1715. procedure TRxPopupMenu.DefaultDrawMargin(ARect: TRect; StartColor,
  1716.   EndColor: TColor);
  1717. var
  1718.   R: Integer;
  1719. begin
  1720.   with ARect do begin
  1721.     if NewStyleControls then R := Right - 3
  1722.     else R := Right;
  1723.     GradientFillRect(Canvas, Rect(Left, Top, R, Bottom), StartColor,
  1724.       EndColor, fdTopToBottom, 32);
  1725.     if NewStyleControls then begin
  1726.       MenuLine(Canvas, clBtnShadow, Right - 2, Top, Right - 2, Bottom);
  1727.       MenuLine(Canvas, clBtnHighlight, Right - 1, Top, Right - 1, Bottom);
  1728.     end;
  1729.   end;
  1730. end;
  1731.  
  1732. procedure TRxPopupMenu.DrawMargin(ARect: TRect);
  1733. begin
  1734.   if Assigned(FOnDrawMargin) then FOnDrawMargin(Self, ARect)
  1735.   else begin
  1736.     DefaultDrawMargin(ARect, DefMarginColor, RGB(
  1737.       GetRValue(DefMarginColor) div 4,
  1738.       GetGValue(DefMarginColor) div 4,
  1739.       GetBValue(DefMarginColor) div 4));
  1740.   end;
  1741. end;
  1742.  
  1743. procedure TRxPopupMenu.WMDrawItem(var Message: TWMDrawItem);
  1744. var
  1745.   State: TMenuOwnerDrawState;
  1746.   SaveIndex: Integer;
  1747.   Item: TMenuItem;
  1748.   MarginRect: TRect;
  1749. begin
  1750.   with Message.DrawItemStruct^ do begin
  1751. {$IFDEF WIN32}
  1752.     State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1753. {$ELSE}
  1754.     State := TMenuOwnerDrawState(WordRec(itemState).Lo);
  1755. {$ENDIF}
  1756.     Item := TMenuItem(Pointer(itemData));
  1757.     if Assigned(Item) and
  1758.       (FindItem(Item.Command, fkCommand) = Item) then
  1759.     begin
  1760.       SaveIndex := SaveDC(hDC);
  1761.       try
  1762.         FCanvas.Handle := hDC;
  1763.         if (Item.Parent = Self.Items) and (FLeftMargin > 0) then
  1764.           if (itemAction = ODA_DRAWENTIRE) then begin
  1765.             MarginRect := FCanvas.ClipRect;
  1766.             MarginRect.Left := 0;
  1767.             MarginRect.Right := FLeftMargin;
  1768.             DrawMargin(MarginRect);
  1769.           end;
  1770.         SetDefaultMenuFont(FCanvas.Font);
  1771.         FCanvas.Font.Color := clMenuText;
  1772.         FCanvas.Brush.Color := clMenu;
  1773. {$IFDEF WIN32}
  1774.         if mdDefault in State then
  1775.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1776. {$ENDIF}
  1777.         if (mdSelected in State) {$IFDEF WIN32} and
  1778.           not (Style in [msBtnLowered, msBtnRaised]) {$ENDIF} then
  1779.         begin
  1780.           FCanvas.Brush.Color := clHighlight;
  1781.           FCanvas.Font.Color := clHighlightText;
  1782.         end;
  1783.         if (Item.Parent = Self.Items) then
  1784.           Inc(rcItem.Left, LeftMargin + 1);
  1785.         with rcItem do
  1786.           IntersectClipRect(FCanvas.Handle, Left, Top, Right, Bottom);
  1787.         DrawItem(Item, rcItem, State);
  1788.         FCanvas.Handle := 0;
  1789.       finally
  1790.         RestoreDC(hDC, SaveIndex);
  1791.       end;
  1792.     end;
  1793.   end;
  1794. end;
  1795.  
  1796. procedure TRxPopupMenu.WMMeasureItem(var Message: TWMMeasureItem);
  1797. var
  1798.   Item: TMenuItem;
  1799.   Graphic: TGraphic;
  1800.   BackColor: TColor;
  1801.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1802. begin
  1803.   with Message.MeasureItemStruct^ do begin
  1804.     Item := TMenuItem(Pointer(itemData));
  1805.     if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then
  1806.     begin
  1807.       FCanvas.Handle := GetDC(0);
  1808.       try
  1809.         SetDefaultMenuFont(FCanvas.Font);
  1810. {$IFDEF WIN32}
  1811.         if Item.Default then
  1812.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1813. {$ENDIF}
  1814.         Graphic := nil;
  1815.         BackColor := Canvas.Brush.Color;
  1816.         NumGlyphs := 1;
  1817.         GetItemParams(Item, [], FCanvas.Font, BackColor, Graphic, NumGlyphs);
  1818. {$IFDEF WIN32}
  1819. {$IFDEF RX_D4}
  1820.         ImageIndex := Item.ImageIndex;
  1821. {$ELSE}
  1822.         ImageIndex := -1;
  1823. {$ENDIF}
  1824.         GetImageIndex(Item, [], ImageIndex);
  1825. {$ENDIF}
  1826.         MenuMeasureItem(Self, Item, FCanvas, FShowCheckMarks, Graphic,
  1827.           NumGlyphs, Integer(itemWidth), Integer(itemHeight), FMinTextOffset
  1828.           {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1829.         MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
  1830.         if (Item.Parent = Self.Items) then
  1831.           Inc(itemWidth, LeftMargin + 1);
  1832.       finally
  1833.         ReleaseDC(0, FCanvas.Handle);
  1834.         FCanvas.Handle := 0;
  1835.       end;
  1836.     end;
  1837.   end;
  1838. end;
  1839.  
  1840. {$IFNDEF WIN32}
  1841. procedure FreePopupList; far;
  1842. begin
  1843.   if PopupList <> nil then begin
  1844.     PopupList.Free;
  1845.     PopupList := nil;
  1846.   end;
  1847. end;
  1848. {$ENDIF}
  1849.  
  1850. initialization
  1851.   PopupList := nil;
  1852. {$IFDEF WIN32}
  1853. finalization
  1854.   if PopupList <> nil then PopupList.Free;
  1855. {$ELSE}
  1856.   AddExitProc(FreePopupList);
  1857. {$ENDIF}
  1858. end.