001 { $Id: win32wsmenus.pp 32158 2011-09-02 19:59:14Z maxim $}
002 {
003  *****************************************************************************
004  *                              Win32WSMenus.pp                              *
005  *                              ---------------                              *
006  *                                                                           *
007  *                                                                           *
008  *****************************************************************************
009 
010  *****************************************************************************
011  *                                                                           *
012  *  This file is part of the Lazarus Component Library (LCL)                 *
013  *                                                                           *
014  *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
015  *  for details about the copyright.                                         *
016  *                                                                           *
017  *  This program is distributed in the hope that it will be useful,          *
018  *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
019  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
020  *                                                                           *
021  *****************************************************************************
022 }
023 unit Win32WSMenus;
024 
025 {$mode objfpc}{$H+}
026 {$I win32defines.inc}
027 
028 interface
029 
030 uses
031 ////////////////////////////////////////////////////
032 // I M P O R T A N T
033 ////////////////////////////////////////////////////
034 // To get as little as posible circles,
035 // uncomment only when needed for registration
036 ////////////////////////////////////////////////////
037   Graphics, GraphType, ImgList, Menus, Forms,
038 ////////////////////////////////////////////////////
039   WSMenus, WSLCLClasses, WSProc,
040   Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList,
041   InterfaceBase, LCLProc, Themes, UxTheme, Win32Themes, Win32Extra,
042   FileUtil;
043 
044 type
045 
046   { TWin32WSMenuItem }
047 
048   TWin32WSMenuItem = class(TWSMenuItem)
049   published
050     class procedure AttachMenu(const AMenuItem: TMenuItem); override;
051     class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override;
052     class procedure DestroyHandle(const AMenuItem: TMenuItem); override;
053     class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override;
054     class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override;
055     class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override;
056     class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override;
057     class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override;
058     class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: Graphics.TBitmap); override;
059   end;
060 
061   { TWin32WSMenu }
062 
063   TWin32WSMenu = class(TWSMenu)
064   published
065     class function CreateHandle(const AMenu: TMenu): HMENU; override;
066     class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override;
067   end;
068 
069   { TWin32WSMainMenu }
070 
071   TWin32WSMainMenu = class(TWSMainMenu)
072   published
073   end;
074 
075   { TWin32WSPopupMenu }
076 
077   TWin32WSPopupMenu = class(TWSPopupMenu)
078   published
079     class function CreateHandle(const AMenu: TMenu): HMENU; override;
080     class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override;
081   end;
082 
083   function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize;
084   procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: Windows.RECT; const ItemAction, ItemState: UINT);
085   function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
086   procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
087     const ImageRect: TRect; const ASelected: Boolean);
088 
089 implementation
090 
091 uses strutils;
092 
093 { helper routines }
094 
095 const
096   SpaceBetweenIcons = 5;
097 
098   // define the size of the MENUITEMINFO structure used by older Windows
099   // versions (95, NT4) to keep the compatibility with them
100   // Since W98 the size is 48 (hbmpItem was added)
101   W95_MENUITEMINFO_SIZE = 44;
102 
103   EnabledToStateFlag: array[Boolean] of DWord =
104   (
105     MF_GRAYED,
106     MF_ENABLED
107   );
108 
109   PopupItemStates: array[{ Enabled } Boolean, { Selected } Boolean] of TThemedMenu =
110   (
111     (tmPopupItemDisabled, tmPopupItemDisabledHot),
112     (tmPopupItemNormal, tmPopupItemHot)
113   );
114 
115   PopupCheckBgStates: array[{ Enabled } Boolean] of TThemedMenu =
116   (
117     tmPopupCheckBackgroundDisabled,
118     tmPopupCheckBackgroundNormal
119   );
120 
121   PopupCheckStates: array[{ Enabled } Boolean, { RadioItem } Boolean] of TThemedMenu =
122   (
123     (tmPopupCheckMarkDisabled, tmPopupBulletDisabled),
124     (tmPopupCheckMarkNormal,  tmPopupBulletNormal)
125   );
126 
127   PopupSubmenuStates: array[{ Enabled } Boolean] of TThemedMenu =
128   (
129     tmPopupSubmenuDisabled,
130     tmPopupSubmenuNormal
131   );
132 
133 var
134   menuiteminfosize : DWORD = 0;
135 
136 type
137   TCaptionFlags = (cfBold, cfUnderline);
138   TCaptionFlagsSet = set of TCaptionFlags;
139 
140   // metrics for vista drawing
141   TVistaPopupMenuMetrics = record
142     ItemMargins: TMargins;
143     CheckSize: TSize;
144     CheckMargins: TMargins;
145     CheckBgMargins: TMargins;
146     GutterSize: TSize;
147     SubMenuSize: TSize;
148     SubMenuMargins: TMargins;
149     TextSize: TSize;
150     TextMargins: TMargins;
151     ShortCustSize: TSize;
152     SeparatorSize: TSize;
153   end;
154 
155   TVistaBarMenuMetrics = record
156     ItemMargins: TMargins;
157     TextSize: TSize;
158   end;
159 
160 function GetLastErrorReport: AnsiString;
161 begin
162   Result := IntToStr(GetLastError) + ' : ' + UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError)));
163 end;
164 
165 function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer;
166 var
167   MenuItemIndex: integer;
168   ItemInfo: MENUITEMINFO;
169   FirstMenuItem: TMenuItem;
170   SiblingMenuItem: TMenuItem;
171   i: integer;
172 begin
173   Result := MakeLResult(0, MNC_IGNORE);
174   MenuItemIndex := -1;
175   ItemInfo.cbSize := menuiteminfosize;
176   ItemInfo.fMask := MIIM_DATA;
177   if not GetMenuItemInfo(AMenuHandle, 0, true, @ItemInfo) then Exit;
178   FirstMenuItem := TMenuItem(ItemInfo.dwItemData);
179   if FirstMenuItem = nil then exit;
180   i := 0;
181   while (i < FirstMenuItem.Parent.Count) and (MenuItemIndex < 0) do
182   begin
183     SiblingMenuItem := FirstMenuItem.Parent.Items[i];
184     if IsAccel(ACharCode, SiblingMenuItem.Caption) then
185       MenuItemIndex := SiblingMenuItem.MenuVisibleIndex;
186     inc(i);
187   end;
188   if MenuItemIndex > -1 then
189     Result := MakeLResult(MenuItemIndex, MNC_EXECUTE);
190 end;
191 
192 function GetMenuItemFont(const AFlags: TCaptionFlagsSet): HFONT;
193 var
194   lf: LOGFONT;
195   ncm: NONCLIENTMETRICS;
196 begin
197   ncm.cbSize := sizeof(ncm);
198   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0) then
199     lf := ncm.lfMenuFont
200   else
201     GetObject(GetStockObject(DEFAULT_GUI_FONT), SizeOf(LOGFONT), @lf);
202   if cfUnderline in AFlags then
203     lf.lfUnderline := 1
204   else
205     lf.lfUnderline := 0;
206   if cfBold in AFlags then
207   begin
208     if lf.lfWeight <= 400 then
209       lf.lfWeight := lf.lfWeight + 300
210     else
211       lf.lfWeight := lf.lfWeight + 100;
212   end;
213   Result := CreateFontIndirect(@lf);
214 end;
215 
216 (* Get the menu item shortcut text *)
217 function MenuItemShortCut(const AMenuItem: TMenuItem): string;
218 begin
219   Result := ShortCutToText(AMenuItem.ShortCut);
220   if AMenuItem.ShortCutKey2 <> scNone then
221     Result := Result + ', ' + ShortCutToText(AMenuItem.ShortCutKey2);
222 end;
223 
224 (* Get the menu item caption including shortcut *)
225 function CompleteMenuItemCaption(const AMenuItem: TMenuItem; Spacing: String): string;
226 begin
227   Result := AMenuItem.Caption;
228   if AMenuItem.ShortCut <> scNone then
229     Result := Result + Spacing + MenuItemShortCut(AMenuItem);
230 end;
231 
232 (* Get the maximum length of the given string in pixels *)
233 function StringSize(const aCaption: String; const aHDC: HDC; const aDecoration:TCaptionFlagsSet): TSize;
234 var
235   oldFont: HFONT;
236   newFont: HFONT;
237   tmpRect: Windows.RECT;
238 {$ifdef WindowsUnicodeSupport}
239   AnsiBuffer: ansistring;
240   WideBuffer: widestring;
241 {$endif WindowsUnicodeSupport}
242 begin
243   FillChar(tmpRect, SizeOf(tmpRect), 0);
244   newFont := GetMenuItemFont(aDecoration);
245   oldFont := SelectObject(aHDC, newFont);
246 {$ifdef WindowsUnicodeSupport}
247   if UnicodeEnabledOS then
248   begin
249     WideBuffer := UTF8ToUTF16(aCaption);
250     DrawTextW(aHDC, PWideChar(WideBuffer), length(WideBuffer), @TmpRect, DT_CALCRECT);
251   end
252   else
253   begin
254     AnsiBuffer := Utf8ToAnsi(aCaption);
255     DrawText(aHDC, pChar(AnsiBuffer), length(AnsiBuffer), @TmpRect, DT_CALCRECT);
256   end;
257 {$else}
258   DrawText(aHDC, pChar(aCaption), length(aCaption), @TmpRect, DT_CALCRECT);
259 {$endif}
260   SelectObject(aHDC, oldFont);
261   DeleteObject(newFont);
262   Result.cx := TmpRect.right - TmpRect.left;
263   Result.cy := TmpRect.Bottom - TmpRect.Top;
264 end;
265   
266 function CheckSpace(AMenuItem: TMenuItem): integer;
267 var
268   i: integer;
269 begin
270   Result := 0;
271   if AMenuItem.IsInMenuBar then
272   begin
273     if AMenuItem.Checked then
274       Result := GetSystemMetrics(SM_CXMENUCHECK);
275   end
276   else
277   begin
278     for i := 0 to AMenuItem.Parent.Count - 1 do
279     begin
280       if AMenuItem.Parent.Items[i].Checked then
281       begin
282         Result := GetSystemMetrics(SM_CXMENUCHECK);
283         break;
284       end;
285     end;
286   end;
287 end;
288 
289 function MenuIconWidth(const AMenuItem: TMenuItem): integer;
290 var
291   SiblingMenuItem : TMenuItem;
292   i, RequiredWidth: integer;
293 begin
294   Result := 0;
295 
296   if AMenuItem.IsInMenuBar then
297   begin
298     Result := AMenuItem.GetIconSize.x;
299   end
300   else
301   begin
302     for i := 0 to AMenuItem.Parent.Count - 1 do
303     begin
304       SiblingMenuItem := AMenuItem.Parent.Items[i];
305       if SiblingMenuItem.HasIcon then
306       begin
307         RequiredWidth := SiblingMenuItem.GetIconSize.x;
308         if RequiredWidth > Result then
309           Result := RequiredWidth;
310       end;
311     end;
312   end;
313 end;
314 
315 function LeftCaptionPosition(const AMenuItem: TMenuItem): integer;
316 var
317   ImageWidth: Integer;
318 begin
319   // If we have Check and Icon then we use only width of Icon
320   // we draw our MenuItem so: space Image space Caption
321   ImageWidth := MenuIconWidth(AMenuItem);
322   if ImageWidth = 0 then
323     ImageWidth := CheckSpace(aMenuItem);
324 
325   Result := SpaceBetweenIcons;
326 
327   inc(Result, ImageWidth);
328 
329   if not aMenuItem.IsInMenuBar or (ImageWidth <> 0) then
330     inc(Result, SpaceBetweenIcons);
331 end;
332 
333 function TopPosition(const aMenuItemHeight: integer; const anElementHeight: integer): integer;
334 begin
335   Result := (aMenuItemHeight - anElementHeight) div 2;
336 end;
337 
338 function IsVistaMenu: Boolean; inline;
339 begin
340   Result := ThemeServices.ThemesAvailable and (WindowsVersion >= wvVista) and
341      (TWin32ThemeServices(ThemeServices).Theme[teMenu] <> 0);
342 end;
343 
344 function GetVistaPopupMenuMetrics(const AMenuItem: TMenuItem; DC: HDC): TVistaPopupMenuMetrics;
345 var
346   Theme: HTHEME;
347   TextRect: TRect;
348   W: WideString;
349   AFont, OldFont: HFONT;
350 begin
351   Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu];
352   GetThemeMargins(Theme, DC, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
353   GetThemePartSize(Theme, DC, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize);
354   GetThemeMargins(Theme, DC, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins);
355   GetThemeMargins(Theme, DC, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins);
356   GetThemePartSize(Theme, DC, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize);
357   GetThemePartSize(Theme, DC, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize);
358   GetThemeMargins(Theme, DC, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins);
359 
360   if AMenuItem.IsLine then
361   begin
362     GetThemePartSize(Theme, DC, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize);
363     FillChar(Result.TextMargins, SizeOf(Result.TextMargins), 0);
364     FillChar(Result.TextSize, SizeOf(Result.TextSize), 0);
365   end
366   else
367   begin
368     Result.TextMargins := Result.ItemMargins;
369     GetThemeInt(Theme, MENU_POPUPITEM, 0, TMT_BORDERSIZE, Result.TextMargins.cxRightWidth);
370     GetThemeInt(Theme, MENU_POPUPBACKGROUND, 0, TMT_BORDERSIZE, Result.TextMargins.cxLeftWidth);
371 
372     if AMenuItem.Default then
373       AFont := GetMenuItemFont([cfBold])
374     else
375       AFont := GetMenuItemFont([]);
376     OldFont := SelectObject(DC, AFont);
377 
378     W := UTF8ToUTF16(CompleteMenuItemCaption(AMenuItem, #9));
379     GetThemeTextExtent(Theme, DC, MENU_POPUPITEM, 0, PWideChar(W), Length(W),
380       DT_SINGLELINE or DT_LEFT or DT_EXPANDTABS, nil, TextRect);
381     Result.TextSize.cx := TextRect.Right - TextRect.Left;
382     Result.TextSize.cy := TextRect.Bottom - TextRect.Top;
383 
384     if AMenuItem.ShortCut <> scNone then
385     begin;
386       W := UTF8ToUTF16(MenuItemShortCut(AMenuItem));
387       GetThemeTextExtent(Theme, DC, MENU_POPUPITEM, 0, PWideChar(W), Length(W),
388         DT_SINGLELINE or DT_LEFT, nil, TextRect);
389       Result.ShortCustSize.cx := TextRect.Right - TextRect.Left;
390       Result.ShortCustSize.cy := TextRect.Bottom - TextRect.Top;
391     end;
392     if OldFont <> 0 then
393       DeleteObject(SelectObject(DC, OldFont));
394   end;
395 end;
396 
397 function GetVistaBarMenuMetrics(const AMenuItem: TMenuItem; DC: HDC): TVistaBarMenuMetrics;
398 var
399   Theme: HTHEME;
400   TextRect: TRect;
401   W: WideString;
402   AFont, OldFont: HFONT;
403 begin
404   Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu];
405   GetThemeMargins(Theme, 0, MENU_BARITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins);
406 
407   if AMenuItem.Default then
408     AFont := GetMenuItemFont([cfBold])
409   else
410     AFont := GetMenuItemFont([]);
411 
412   OldFont := SelectObject(DC, AFont);
413 
414   W := UTF8ToUTF16(AMenuItem.Caption);
415   GetThemeTextExtent(Theme, DC, MENU_BARITEM, 0, PWideChar(W), Length(W),
416     DT_SINGLELINE or DT_LEFT or DT_EXPANDTABS, nil, TextRect);
417   Result.TextSize.cx := TextRect.Right - TextRect.Left;
418   Result.TextSize.cy := TextRect.Bottom - TextRect.Top;
419   if OldFont <> 0 then
420     DeleteObject(SelectObject(DC, OldFont));
421 end;
422 
423 function VistaBarMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize;
424 var
425   Metrics: TVistaBarMenuMetrics;
426   IconSize: TPoint;
427 begin
428   Metrics := GetVistaBarMenuMetrics(AMenuItem, ADC);
429   // item margins. Seems windows adds that margins itself to our return values
430   Result.cx := 0; //Metrics.ItemMargins.cxLeftWidth + Metrics.ItemMargins.cxRightWidth;
431   Result.cy := 0; //Metrics.ItemMargins.cyTopHeight + Metrics.ItemMargins.cyBottomHeight;
432   // + text size / icon size
433   IconSize := AMenuItem.GetIconSize;
434   Result.cx := Result.cx + Metrics.TextSize.cx + IconSize.x;
435   if IconSize.x > 0 then
436     inc(Result.cx, Metrics.ItemMargins.cxLeftWidth);
437   Result.cy := Result.cy + Max(Metrics.TextSize.cy, IconSize.y);
438 end;
439 
440 function VistaPopupMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize;
441 var
442   Metrics: TVistaPopupMenuMetrics;
443 begin
444   Metrics := GetVistaPopupMenuMetrics(AMenuItem, ADC);
445   // count check
446   Result.cx := Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth;
447   if AMenuItem.IsLine then
448   begin
449     Result.cx := Result.cx + Metrics.SeparatorSize.cx + Metrics.ItemMargins.cxLeftWidth + Metrics.ItemMargins.cxRightWidth;
450     Result.cy := Metrics.SeparatorSize.cy + Metrics.ItemMargins.cyTopHeight + Metrics.ItemMargins.cyBottomHeight;
451   end
452   else
453   begin
454     Result.cy := Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
455     if AMenuItem.HasIcon then
456     begin
457       Result.cy := Max(Result.cy, AMenuItem.GetIconSize.y);
458       Result.cx := Max(Result.cx, AMenuItem.GetIconSize.x);
459     end;
460   end;
461   // count gutter
462   Result.cx := Result.cx + (Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth) +
463                Metrics.GutterSize.cx;
464   // count text
465   Result.cx := Result.cx + Metrics.TextSize.cx;
466   Result.cx := Result.cx + Metrics.TextMargins.cxLeftWidth + Metrics.TextMargins.cxRightWidth;
467 end;
468 
469 procedure ThemeDrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); inline;
470 begin
471   with Details do
472     DrawThemeBackground(TWin32ThemeServices(ThemeServices).Theme[Element], DC, Part, State, R, ClipRect);
473 end;
474 
475 procedure ThemeDrawText(DC: HDC; Details: TThemedElementDetails;
476   const S: String; R: TRect; Flags, Flags2: Cardinal);
477 var
478   w: widestring;
479 begin
480   with Details do
481   begin
482     w := UTF8ToUTF16(S);
483     DrawThemeText(TWin32ThemeServices(ThemeServices).Theme[Element], DC, Part, State, PWideChar(w), Length(w), Flags, Flags2, R);
484   end;
485 end;
486 
487 procedure DrawVistaMenuBar(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: TRect; const ASelected, ANoAccel: Boolean; const ItemAction, ItemState: UINT);
488 const
489   BarState: array[Boolean] of TThemedMenu =
490   (
491     tmBarBackgroundInactive,
492     tmBarBackgroundActive
493   );
494   OBJID_MENU = LONG($FFFFFFFD);
495 
496   function IsLast: Boolean;
497   var
498     Index, i: Integer;
499   begin
500     Index := AMenuItem.Parent.IndexOf(AMenuItem);
501     for i := Index + 1 to AMenuItem.Parent.Count - 1 do
502       if AMenuItem.Parent.Items[i].Visible then
503         Exit(False);
504     Result := True;
505   end;
506 var
507   MenuState: TThemedMenu;
508   Metrics: TVistaBarMenuMetrics;
509   Details, Tmp: TThemedElementDetails;
510   BGRect, BGClip, WndRect, TextRect, ImageRect: TRect;
511   IconSize: TPoint;
512   TextFlags: DWord;
513   AFont, OldFont: HFONT;
514   IsRightToLeft: Boolean;
515   Info: tagMENUBARINFO;
516   AWnd: HWND;
517 begin
518   if (ItemState and ODS_SELECTED) <> 0 then
519     MenuState := tmBarItemPushed
520   else
521   if (ItemState and ODS_HOTLIGHT) <> 0 then
522     MenuState := tmBarItemHot
523   else
524     MenuState := tmBarItemNormal;
525 
526   if (ItemState and (ODS_DISABLED or ODS_INACTIVE)) <> 0 then
527     inc(MenuState, 3);
528 
529   IsRightToLeft := AMenuItem.GetIsRightToLeft;
530   Metrics := GetVistaBarMenuMetrics(AMenuItem, AHDC);
531 
532   // draw backgound
533   // This is a hackish way to draw. Seems windows itself draws this in WM_PAINT or another paint handler?
534   AWnd := TCustomForm(AMenuItem.GetParentMenu.Parent).Handle;
535   if (AMenuItem.Parent.VisibleIndexOf(AMenuItem) = 0) then
536   begin
537     /// if we are painting the first item then request full repaint to draw the bg correctly
538     if (GetProp(AWnd, 'LCL_MENUREDRAW') = 0) then
539     begin
540       SetProp(AWnd, 'LCL_MENUREDRAW', 1);
541       DrawMenuBar(AWnd);
542       Exit;
543     end
544     else
545       SetProp(AWnd, 'LCL_MENUREDRAW', 0);
546     // repainting menu bar bg
547     FillChar(Info, SizeOf(Info), 0);
548     Info.cbSize := SizeOf(Info);
549     GetMenuBarInfo(AWnd, OBJID_MENU, 0, @Info);
550     GetWindowRect(AWnd, @WndRect);
551     OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top);
552     Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]);
553     ThemeDrawElement(AHDC, Tmp, Info.rcBar, nil);
554   end;
555 
556   BGRect := ARect;
557   BGClip := ARect;
558   if IsRightToLeft <> AMenuItem.RightJustify then
559   begin
560     inc(BGRect.Right, 2);
561     dec(BGRect.Left, 2);
562   end
563   else
564   begin
565     inc(BGRect.Right, 2);
566     dec(BGRect.Left, 2);
567   end;
568   Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]);
569   ThemeDrawElement(AHDC, Tmp, BGRect, @BGClip);
570 
571   Details := ThemeServices.GetElementDetails(MenuState);
572   // draw menu item
573   ThemeDrawElement(AHDC, Details, ARect, nil);
574 
575   TextRect := ARect;
576   inc(TextRect.Left, Metrics.ItemMargins.cxLeftWidth);
577   dec(TextRect.Right, Metrics.ItemMargins.cxRightWidth);
578   inc(TextRect.Top, Metrics.ItemMargins.cyTopHeight);
579   dec(TextRect.Bottom, Metrics.ItemMargins.cyBottomHeight);
580   // draw check/image
581   if AMenuItem.HasIcon then
582   begin
583     IconSize := AMenuItem.GetIconSize;
584     if IsRightToLeft then
585       ImageRect.Left := TextRect.Right - IconSize.x
586     else
587       ImageRect.Left := TextRect.Left;
588     ImageRect.Top := (TextRect.Top + TextRect.Bottom - IconSize.y) div 2;
589     ImageRect.Right := 0;
590     ImageRect.Bottom := 0;
591     DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected);
592     if IsRightToLeft then
593       dec(TextRect.Right, IconSize.x + Metrics.ItemMargins.cxLeftWidth)
594     else
595       inc(TextRect.Left, IconSize.x + Metrics.ItemMargins.cxLeftWidth);
596   end;
597 
598   // draw text
599   TextRect.Top := (TextRect.Top + TextRect.Bottom - Metrics.TextSize.cy) div 2;
600   TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy;
601   TextFlags := DT_SINGLELINE or DT_EXPANDTABS;
602   if IsRightToLeft then
603     TextFlags := TextFlags or DT_RTLREADING;
604   if ANoAccel then
605     TextFlags := TextFlags or DT_HIDEPREFIX;
606   if AMenuItem.Default then
607     AFont := GetMenuItemFont([cfBold])
608   else
609     AFont := GetMenuItemFont([]);
610   OldFont := SelectObject(AHDC, AFont);
611   ThemeDrawText(AHDC, Details, AMenuItem.Caption, TextRect, TextFlags, 0);
612   if OldFont <> 0 then
613     DeleteObject(SelectObject(AHDC, OldFont));
614 end;
615 
616 procedure DrawVistaPopupMenu(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: TRect; const ASelected, ANoAccel: boolean);
617 var
618   Details, Tmp: TThemedElementDetails;
619   Metrics: TVistaPopupMenuMetrics;
620   CheckRect, GutterRect, TextRect, SeparatorRect, ImageRect, SubMenuRect: TRect;
621   IconSize: TPoint;
622   TextFlags: DWord;
623   AFont, OldFont: HFONT;
624   IsRightToLeft: Boolean;
625 begin
626   Metrics := GetVistaPopupMenuMetrics(AMenuItem, AHDC);
627   // draw backgound
628   Details := ThemeServices.GetElementDetails(PopupItemStates[AMenuItem.Enabled, ASelected]);
629   if ThemeServices.HasTransparentParts(Details) then
630   begin
631     Tmp := ThemeServices.GetElementDetails(tmPopupBackground);
632     ThemeDrawElement(AHDC, Tmp, ARect, nil);
633   end;
634   IsRightToLeft := AMenuItem.GetIsRightToLeft;
635   if IsRightToLeft then
636     SetLayout(AHDC, LAYOUT_RTL);
637   // calc check/image rect
638   CheckRect := ARect;
639   CheckRect.Right := CheckRect.Left + Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth;
640   CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + ScaleY(Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight, 96);
641   // draw gutter
642   GutterRect := CheckRect;
643   GutterRect.Left := GutterRect.Right + Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth;
644   GutterRect.Right := GutterRect.Left + Metrics.GutterSize.cx;
645   Tmp := ThemeServices.GetElementDetails(tmPopupGutter);
646   ThemeDrawElement(AHDC, Tmp, GutterRect, nil);
647 
648   if AMenuItem.IsLine then
649   begin
650     // draw separator
651     SeparatorRect.Left := GutterRect.Right + Metrics.ItemMargins.cxLeftWidth;
652     SeparatorRect.Right := ARect.Right - Metrics.ItemMargins.cxRightWidth;
653     SeparatorRect.Top := ARect.Top + Metrics.ItemMargins.cyTopHeight;
654     SeparatorRect.Bottom := ARect.Bottom - Metrics.ItemMargins.cyBottomHeight;
655     Tmp := ThemeServices.GetElementDetails(tmPopupSeparator);
656     ThemeDrawElement(AHDC, Tmp, SeparatorRect, nil);
657   end
658   else
659   begin
660     // draw menu item
661     ThemeDrawElement(AHDC, Details, ARect, nil);
662     // draw submenu
663     if AMenuItem.Count > 0 then
664     begin
665       SubMenuRect := ARect;
666       SubMenuRect.Right := SubMenuRect.Right - Metrics.SubMenuMargins.cxRightWidth + Metrics.SubMenuMargins.cxLeftWidth;
667       SubMenuRect.Left := SubMenuRect.Right - Metrics.SubMenuSize.cx;
668       SubMenuRect.Top := SubMenuRect.Top + Metrics.ItemMargins.cyTopHeight;
669       SubMenuRect.Bottom := SubMenuRect.Bottom - Metrics.ItemMargins.cyBottomHeight;
670       Tmp := ThemeServices.GetElementDetails(PopupSubmenuStates[AMenuItem.Enabled]);
671       Tmp.State := Tmp.State + 2;
672       ThemeDrawElement(AHDC, Tmp, SubMenuRect, nil);
673     end;
674     // draw check/image
675     if AMenuItem.HasIcon then
676     begin
677       ImageRect := CheckRect;
678       IconSize := AMenuItem.GetIconSize;
679       ImageRect.Left := (ImageRect.Left + ImageRect.Right - IconSize.x) div 2;
680       ImageRect.Top := (ImageRect.Top + ImageRect.Bottom - IconSize.y) div 2;
681       if IsRightToLeft then
682       begin
683         // we can't use RTL layout here since our imagelist does not support
684         // coordinates mirroring
685         SetLayout(AHDC, 0);
686         ImageRect.Left := ARect.Right - ImageRect.Left - IconSize.x;
687       end;
688       ImageRect.Right := IconSize.x;
689       ImageRect.Bottom := IconSize.y;
690       DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected);
691       if IsRightToLeft then
692         SetLayout(AHDC, LAYOUT_RTL);
693     end
694     else
695     if AMenuItem.Checked then
696     begin
697       Tmp := ThemeServices.GetElementDetails(PopupCheckBgStates[AMenuItem.Enabled]);
698       ThemeDrawElement(AHDC, Tmp, CheckRect, nil);
699       Tmp := ThemeServices.GetElementDetails(PopupCheckStates[AMenuItem.Enabled, AMenuItem.RadioItem]);
700       ThemeDrawElement(AHDC, Tmp, CheckRect, nil);
701     end;
702     // draw text
703     TextFlags := DT_SINGLELINE or DT_EXPANDTABS;
704     // todo: distinct UseRightToLeftAlignment and UseRightToLeftReading
705     if IsRightToLeft then
706     begin
707       // restore layout before the text drawing since windows has bug with
708       // DT_RTLREADING support
709       SetLayout(AHDC, 0);
710       TextFlags := TextFlags or DT_RIGHT or DT_RTLREADING;
711       TextRect.Right := ARect.Right - GutterRect.Right - Metrics.TextMargins.cxLeftWidth;
712       TextRect.Left := ARect.Left + Metrics.TextMargins.cxRightWidth;
713       TextRect.Top := (GutterRect.Top + GutterRect.Bottom - Metrics.TextSize.cy) div 2;
714       TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy;
715     end
716     else
717     begin
718       TextFlags := TextFlags or DT_LEFT;
719       TextRect := GutterRect;
720       TextRect.Left := TextRect.Right + Metrics.TextMargins.cxLeftWidth;
721       TextRect.Right := ARect.Right - Metrics.TextMargins.cxRightWidth;
722       TextRect.Top := (TextRect.Top + TextRect.Bottom - Metrics.TextSize.cy) div 2;
723       TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy;
724     end;
725 
726     if ANoAccel then
727       TextFlags := TextFlags or DT_HIDEPREFIX;
728     if AMenuItem.Default then
729       AFont := GetMenuItemFont([cfBold])
730     else
731       AFont := GetMenuItemFont([]);
732     OldFont := SelectObject(AHDC, AFont);
733 
734     ThemeDrawText(AHDC, Details, AMenuItem.Caption, TextRect, TextFlags, 0);
735     if AMenuItem.ShortCut <> scNone then
736     begin
737       if IsRightToLeft then
738       begin
739         TextRect.Right := TextRect.Left + Metrics.ShortCustSize.cx;
740         TextFlags := TextFlags xor DT_RIGHT or DT_LEFT;
741       end
742       else
743       begin
744         TextRect.Left := TextRect.Right - Metrics.ShortCustSize.cx;
745         TextFlags := TextFlags xor DT_LEFT or DT_RIGHT;
746       end;
747       ThemeDrawText(AHDC, Details, MenuItemShortCut(AMenuItem), TextRect, TextFlags, 0);
748     end;
749     // exlude menu item rectangle to prevent drawing by windows after us
750     if AMenuItem.Count > 0 then
751       ExcludeClipRect(AHDC, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
752     if OldFont <> 0 then
753       DeleteObject(SelectObject(AHDC, OldFont));
754   end;
755 end;
756 
757 function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize;
758 var
759   decoration: TCaptionFlagsSet;
760   minimumHeight: Integer;
761 begin
762   if IsVistaMenu then
763   begin
764     if AMenuItem.IsInMenuBar then
765       Result := VistaBarMenuItemSize(AMenuItem, AHDC)
766     else
767       Result := VistaPopupMenuItemSize(AMenuItem, AHDC);
768     Exit;
769   end;
770 
771   if AMenuItem.Default then
772     decoration := [cfBold]
773   else
774     decoration := [];
775     
776   Result := StringSize(CompleteMenuItemCaption(AMenuItem, '  '), AHDC, decoration);
777   inc(Result.cx, LeftCaptionPosition(AMenuItem));
778 
779   if not AMenuItem.IsInMenuBar then
780     inc(Result.cx, SpaceBetweenIcons)
781   else
782     dec(Result.cx, SpaceBetweenIcons);
783 
784   if (AMenuItem.ShortCut <> scNone) then
785     Inc(Result.cx, SpaceBetweenIcons);
786 
787   minimumHeight := GetSystemMetrics(SM_CYMENU);
788   if not AMenuItem.IsInMenuBar then
789     Dec(minimumHeight, 2);
790   if AMenuItem.IsLine then
791     Result.cy := 10 // it is a separator
792   else
793   begin
794     if AMenuItem.hasIcon then
795       Result.cy := Max(Result.cy, aMenuItem.GetIconSize.y);
796     Inc(Result.cy, 2);
797     if Result.cy < minimumHeight then
798       Result.cy := minimumHeight;
799   end;
800 end;
801 
802 function IsFlatMenus: Boolean; inline;
803 var
804   IsFlatMenu: Windows.BOOL;
805 begin
806   Result := (WindowsVersion >= wvXP) and ((SystemParametersInfo(SPI_GETFLATMENU, 0, @IsFlatMenu, 0)) and IsFlatMenu);
807 end;
808 
809 function BackgroundColorMenu(const ItemState: UINT; const aIsInMenuBar: boolean): COLORREF;
810 begin
811   if IsFlatMenus then
812   begin
813     if (ItemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0 then
814      Result := GetSysColor(COLOR_MENUHILIGHT)
815     else
816    if aIsInMenuBar then
817      Result := GetSysColor(COLOR_MENUBAR)
818     else
819       Result := GetSysColor(COLOR_MENU);
820   end
821   else
822   begin
823     // 3d menu bar always have standard color
824     if aIsInMenuBar then
825       Result := GetSysColor(COLOR_MENU)
826     else
827     if (ItemState and ODS_SELECTED) <> 0 then
828       Result := GetSysColor(COLOR_HIGHLIGHT)
829     else
830       Result := GetSysColor(COLOR_MENU);
831   end;
832 end;
833 
834 function TextColorMenu(const ItemState: UINT; const aIsInMenuBar: boolean; const anEnabled: boolean): COLORREF;
835 begin
836   if anEnabled then
837   begin
838     if IsFlatMenus then
839     begin
840       if (ItemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0 then
841         Result := GetSysColor(COLOR_HIGHLIGHTTEXT)
842       else
843         Result := GetSysColor(COLOR_MENUTEXT);
844     end
845     else
846     begin
847       if ((ItemState and ODS_SELECTED) <> 0) and not aIsInMenuBar then
848         Result := GetSysColor(COLOR_HIGHLIGHTTEXT)
849       else
850         Result := GetSysColor(COLOR_MENUTEXT);
851     end;
852   end
853   else
854     Result := GetSysColor(COLOR_GRAYTEXT);
855 end;
856 
857 procedure DrawSeparator(const AHDC: HDC; const ARect: Windows.RECT);
858 var
859   separatorRect: Windows.RECT;
860 begin
861   separatorRect.left := ARect.left;
862   separatorRect.right := ARect.right;
863   separatorRect.top := (ARect.top + ARect.bottom ) div 2 - 1;
864   separatorRect.bottom := separatorRect.top + 2;
865   DrawEdge(aHDC, separatorRect, BDR_SUNKENOUTER, BF_RECT);
866 end;
867 
868 procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; const aRect: Windows.RECT; const aSelected: boolean);
869 var
870   checkMarkWidth: integer;
871   checkMarkHeight: integer;
872   hdcMem: HDC;
873   monoBitmap: HBITMAP;
874   oldBitmap: HBITMAP;
875   checkMarkShape: integer;
876   checkMarkRect: Windows.RECT;
877   x:Integer;
878 begin
879   hdcMem := CreateCompatibleDC(aHDC);
880   checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK);
881   checkMarkHeight := GetSystemMetrics(SM_CYMENUCHECK);
882   monoBitmap := CreateBitmap(checkMarkWidth, checkMarkHeight, 1, 1, nil);
883   oldBitmap := SelectObject(hdcMem, monoBitmap);
884   checkMarkRect.left := 0;
885   checkMarkRect.top := 0;
886   checkMarkRect.right := checkMarkWidth;
887   checkMarkRect.bottom := checkMarkHeight;
888   if aMenuItem.RadioItem then
889     checkMarkShape := DFCS_MENUBULLET
890   else
891     checkMarkShape := DFCS_MENUCHECK;
892   DrawFrameControl(hdcMem, @checkMarkRect, DFC_MENU, checkMarkShape);
893   if aMenuItem.GetIsRightToLeft then
894     x := aRect.Right - checkMarkWidth - spaceBetweenIcons
895   else
896     x := aRect.left + spaceBetweenIcons;
897   BitBlt(aHDC, x, aRect.top + topPosition(aRect.bottom - aRect.top, checkMarkRect.bottom - checkMarkRect.top), checkMarkWidth, checkMarkHeight, hdcMem, 0, 0, SRCCOPY);
898   SelectObject(hdcMem, oldBitmap);
899   DeleteObject(monoBitmap);
900   DeleteDC(hdcMem);
901 end;
902 
903 procedure DrawMenuItemText(const AMenuItem: TMenuItem; const AHDC: HDC;
904   ARect: TRect; const ASelected, ANoAccel: boolean; ItemState: UINT);
905 var
906   crText: COLORREF;
907   crBkgnd: COLORREF;
908   TmpHeight: integer;
909   oldFont: HFONT;
910   newFont: HFONT;
911   decoration: TCaptionFlagsSet;
912   shortCutText: string;
913   WorkRect: Windows.RECT;
914   IsRightToLeft: Boolean;
915   etoFlags: Cardinal;
916   dtFlags: DWord;
917 {$ifdef WindowsUnicodeSupport}
918   AnsiBuffer: ansistring;
919   WideBuffer: widestring;
920 {$endif WindowsUnicodeSupport}
921 begin
922   crText := TextColorMenu(ItemState, AMenuItem.IsInMenuBar, AMenuItem.Enabled);
923   crBkgnd := BackgroundColorMenu(ItemState, AMenuItem.IsInMenuBar);
924   SetTextColor(AHDC, crText);
925   SetBkColor(AHDC, crBkgnd);
926 
927   if AMenuItem.Default then
928     decoration := [cfBold]
929   else
930     decoration := [];
931     
932   newFont := GetMenuItemFont(decoration);
933   oldFont := SelectObject(AHDC, newFont);
934   IsRightToLeft := AMenuItem.GetIsRightToLeft;
935 
936   etoFlags := ETO_OPAQUE;
937   dtFlags := DT_EXPANDTABS;
938   if ANoAccel then
939     dtFlags := dtFlags or DT_HIDEPREFIX;
940   if IsRightToLeft then
941   begin
942     etoFlags := etoFlags or ETO_RTLREADING;
943     dtFlags := dtFlags or DT_RIGHT or DT_RTLREADING;
944   end;
945 
946   // fill the menu item background
947   ExtTextOut(AHDC, 0, 0, etoFlags, @ARect, PChar(''), 0, nil);
948 
949   if AMenuItem.IsInMenuBar and not IsFlatMenus then
950   begin
951     if (ItemState and ODS_SELECTED) <> 0 then
952       DrawEdge(AHDC, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST)
953     else
954     if (ItemState and ODS_HOTLIGHT) <> 0 then
955       DrawEdge(AHDC, ARect, BDR_RAISEDINNER, BF_RECT);
956   end;
957 
958   TmpHeight := ARect.Bottom - ARect.Top;
959 
960 {$ifdef WindowsUnicodeSupport}
961   if UnicodeEnabledOS then
962   begin
963     WideBuffer := UTF8ToUTF16(AMenuItem.Caption);
964     DrawTextW(AHDC, PWideChar(WideBuffer), length(WideBuffer), @WorkRect, DT_CALCRECT);
965   end
966   else
967   begin
968     AnsiBuffer := Utf8ToAnsi(AMenuItem.Caption);
969     DrawText(AHDC, PChar(AnsiBuffer), length(AnsiBuffer), @WorkRect, DT_CALCRECT);
970   end;
971 {$else}
972   DrawText(AHDC, PChar(AMenuItem.Caption), length(AMenuItem.Caption), @WorkRect, DT_CALCRECT);
973 {$endif}
974 
975   if IsRightToLeft then
976     Dec(ARect.Right, LeftCaptionPosition(AMenuItem))
977   else
978     Inc(ARect.Left, LeftCaptionPosition(AMenuItem));
979   Inc(ARect.Top, TopPosition(TmpHeight, WorkRect.Bottom - WorkRect.Top));
980 
981 {$ifdef WindowsUnicodeSupport}
982   if UnicodeEnabledOS then
983     DrawTextW(AHDC, PWideChar(WideBuffer), Length(WideBuffer), @ARect, dtFlags)
984   else
985     DrawText(AHDC, PChar(AnsiBuffer), Length(AnsiBuffer), @ARect, dtFlags);
986 {$else}
987   DrawText(AHDC, PChar(AMenuItem.Caption), Length(AMenuItem.Caption), @ARect, dtFlags);
988 {$endif}
989 
990   if AMenuItem.ShortCut <> scNone then
991   begin
992     shortCutText := MenuItemShortCut(AMenuItem);
993     if IsRightToLeft then
994     begin
995       Inc(ARect.Left, GetSystemMetrics(SM_CXMENUCHECK));
996       dtFlags := DT_LEFT;
997     end
998     else
999     begin
      Dec(ARect.Right, GetSystemMetrics(SM_CXMENUCHECK));
      dtFlags := DT_RIGHT;
    end;

    {$ifdef WindowsUnicodeSupport}
      if UnicodeEnabledOS then
      begin
        WideBuffer := UTF8ToUTF16(shortCutText);
        DrawTextW(AHDC, PWideChar(WideBuffer), Length(WideBuffer), @ARect, dtFlags);
      end
      else
      begin
        AnsiBuffer := Utf8ToAnsi(shortCutText);
        DrawText(AHDC, PChar(AnsiBuffer), Length(AnsiBuffer), @ARect, dtFlags);
      end;
    {$else}
      DrawText(AHDC, PChar(shortCutText), Length(shortCutText), @ARect, dtFlags);
    {$endif}
  end;
  SelectObject(AHDC, oldFont);
  DeleteObject(newFont);
end;

procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
  const ImageRect: TRect; const ASelected: Boolean);
var
  AEffect: TGraphicsDrawEffect;
  AImageList: TCustomImageList;
  FreeImageList: Boolean;
  AImageIndex: Integer;
begin
  AImageList := AMenuItem.GetImageList;
  if AImageList = nil then
  begin
    AImageList := TImageList.Create(nil);
    AImageList.Width := AMenuItem.Bitmap.Width; // maybe height to prevent too wide bitmaps?
    AImageList.Height := AMenuItem.Bitmap.Height;
    AImageIndex := AImageList.Add(AMenuItem.Bitmap, nil);
    FreeImageList := True;
  end
  else
  begin
    FreeImageList := False;
    AImageIndex := AMenuItem.ImageIndex;
  end;

  if not AMenuItem.Enabled then
    AEffect := gdeDisabled
  else
  if ASelected then
    AEffect := gdeHighlighted
  else
    AEffect := gdeNormal;

  if AImageIndex < AImageList.Count then
    TWin32WSCustomImageList.DrawToDC(AImageList, AImageIndex, AHDC,
      ImageRect, AImageList.BkColor, AImageList.BlendColor,
      AEffect, AImageList.DrawingStyle, AImageList.ImageType);
  if FreeImageList then
    AImageList.Free;
end;

procedure DrawClassicMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC;
  const ARect: TRect; const ASelected, AChecked: boolean);
var
  x: Integer;
  ImageRect: TRect;
  IconSize: TPoint;
begin
  IconSize := AMenuItem.GetIconSize;
  if AMenuItem.GetIsRightToLeft then
    x := ARect.Right - IconSize.x - spaceBetweenIcons
  else
    x := ARect.Left + spaceBetweenIcons;

  ImageRect := Rect(x, ARect.top + TopPosition(ARect.Bottom - ARect.Top, IconSize.y),
                    IconSize.x, IconSize.y);
      
  if AChecked then // draw rectangle around
  begin
    FrameRect(aHDC,
      Rect(ImageRect.Left - 1, ImageRect.Top - 1, ImageRect.Left + ImageRect.Right + 1, ImageRect.Top + ImageRect.Bottom + 1),
      GetSysColorBrush(COLOR_HIGHLIGHT));
  end;

  DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected);
end;

procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: Windows.RECT; const ItemAction, ItemState: UINT);
var
  ASelected, ANoAccel: Boolean;
  B: Bool;
begin
  ASelected := (ItemState and ODS_SELECTED) <> 0;
  ANoAccel := (ItemState and ODS_NOACCEL) <> 0;
  if ANoAccel and (WindowsVersion >= wv2000) then
    if SystemParametersInfo(SPI_GETKEYBOARDCUES, 0, @B, 0) then
      ANoAccel := not B
    else
  else
    ANoAccel := False;
  if IsVistaMenu then
  begin
    if AMenuItem.IsInMenuBar then
      DrawVistaMenuBar(AMenuItem, AHDC, ARect, ASelected, ANoAccel, ItemAction, ItemState)
    else
      DrawVistaPopupMenu(AMenuItem, AHDC, ARect, ASelected, ANoAccel);
    Exit;
  end;

  if aMenuItem.IsLine then
    DrawSeparator(AHDC, ARect)
  else
  begin
    DrawMenuItemText(AMenuItem, AHDC, ARect, ASelected, ANoAccel, ItemState);
    if aMenuItem.HasIcon then
      DrawClassicMenuItemIcon(AMenuItem, AHDC, ARect, ASelected, AMenuItem.Checked)
    else
    if AMenuItem.Checked then
      DrawMenuItemCheckMark(AMenuItem, AHDC, ARect, ASelected);
  end;
end;

procedure TriggerFormUpdate(const AMenuItem: TMenuItem);
var
  lMenu: TMenu;
begin
  lMenu := AMenuItem.GetParentMenu;
  if (lMenu<>nil) and (lMenu.Parent<>nil)
  and (lMenu.Parent is TCustomForm)
  and TCustomForm(lMenu.Parent).HandleAllocated
  and not (csDestroying in lMenu.Parent.ComponentState) then
    AddToChangedMenus(TCustomForm(lMenu.Parent).Handle);
end;

function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Cardinal; Value: boolean): boolean;
var
  MenuInfo: MENUITEMINFO;
begin
  FillChar(MenuInfo, SizeOf(MenuInfo), 0);
  MenuInfo.cbSize := menuiteminfosize;
  MenuInfo.fMask := MIIM_TYPE;
  GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
  if Value then
    MenuInfo.fType := MenuInfo.fType or Flag
  else
    MenuInfo.fType := MenuInfo.fType and (not Flag);
  MenuInfo.dwTypeData := LPSTR(AMenuItem.Caption);
  Result := SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
  TriggerFormUpdate(AMenuItem);
end;

{------------------------------------------------------------------------------
  Method: SetMenuFlag
  Returns: Nothing

  Change the menu flags for handle of TMenuItem or TMenu,
  added for BidiMode Menus
 ------------------------------------------------------------------------------}
procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean);
var
  MenuInfo: MENUITEMINFO;
begin
  FillChar(MenuInfo, SizeOf(MenuInfo), 0);
  MenuInfo.cbSize := menuiteminfosize;
  MenuInfo.fMask := MIIM_TYPE;
  GetMenuItemInfo(Menu, 0, True, @MenuInfo);
  if Value then
    MenuInfo.fType := MenuInfo.fType or Flag
  else
    MenuInfo.fType := MenuInfo.fType and not Flag;
  SetMenuItemInfo(Menu, 0, True, @MenuInfo);
end;

{ TWin32WSMenuItem }

procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String);
var
  MenuInfo: MENUITEMINFO;
begin
  if (AMenuItem.Parent = nil) or not AMenuItem.Parent.HandleAllocated then
    Exit;

  FillChar(MenuInfo, SizeOf(MenuInfo), 0);
  with MenuInfo do
  begin
    cbSize := menuiteminfosize;
    fMask := MIIM_TYPE or MIIM_STATE;
    dwTypeData := nil;  // don't retrieve caption
  end;
  GetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);
  with MenuInfo do
  begin
    // change enabled too since we can change from '-' to normal caption and vice versa
    if ACaption <> cLineCaption then
    begin
      fType := (fType or MFT_STRING) and not (MFT_SEPARATOR or MFT_OWNERDRAW);
      fState := EnabledToStateFlag[AMenuItem.Enabled];
      dwTypeData := LPSTR(ACaption);
      cch := StrLen(dwTypeData);
    end
    else
    begin
      fType := (fType or MFT_SEPARATOR) and not (MFT_STRING or MFT_OWNERDRAW);
      fState := MFS_DISABLED;
    end;
  end;
  SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);

  // MIIM_BITMAP is needed to request new measure item call
  with MenuInfo do
  begin
    fMask := MIIM_BITMAP;
    dwTypeData := nil;
  end;
  SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);

  // set owner drawn
  with MenuInfo do
  begin
    fMask := MIIM_TYPE;
    fType := (fType or MFT_OWNERDRAW) and not (MFT_STRING or MFT_SEPARATOR);
    dwTypeData := LPSTR(ACaption);
    cch := StrLen(dwTypeData);
  end;
  SetMenuItemInfo(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo);

  TriggerFormUpdate(AMenuItem);
end;

class procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem);
var
  MenuInfo: MENUITEMINFO;
  ParentMenuHandle: HMenu;
  ParentOfParent: HMenu;
begin
  ParentMenuHandle := AMenuItem.Parent.Handle;
  FillChar(MenuInfo, SizeOf(MenuInfo), 0);
  MenuInfo.cbSize := menuiteminfosize;

  // Following part fixes the case when an item is added in runtime
  // but the parent item has not defined the submenu flag (hSubmenu=0)
  if AMenuItem.Parent.Parent <> nil then
  begin
    ParentOfParent := AMenuItem.Parent.Parent.Handle;
    MenuInfo.fMask := MIIM_SUBMENU;

    if GetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo) then
    begin
      // the parent menu item is not defined with submenu flag
      // convert it to submenu
      if MenuInfo.hSubmenu = 0 then
      begin
        MenuInfo.hSubmenu := ParentMenuHandle;
        if not SetMenuItemInfo(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo) then
          DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
      end;
    end;
  end;

  with MenuInfo do
  begin
    if AMenuItem.Enabled then
      fState := MFS_ENABLED
    else
      fstate := MFS_GRAYED;
    if AMenuItem.Checked then
      fState := fState or MFS_CHECKED;
    fMask := MIIM_ID or MIIM_DATA or MIIM_STATE or MIIM_TYPE;
    wID := AMenuItem.Command; {value may only be 16 bit wide!}
    dwItemData := PtrInt(AMenuItem);
    if (AMenuItem.Count > 0) then
    begin
      fMask := fMask or MIIM_SUBMENU;
      hSubMenu := AMenuItem.Handle;
    end else
      hSubMenu := 0;
    fType := MFT_OWNERDRAW;
    if AMenuItem.IsLine then
    begin
      fType := fType or MFT_SEPARATOR;
      fState := fState or MFS_DISABLED;
    end;
    dwTypeData := PChar(AMenuItem);
    if AMenuItem.RadioItem then
      fType := fType or MFT_RADIOCHECK;
    if (AMenuItem.GetIsRightToLeft) then
    begin
      fType := fType or MFT_RIGHTORDER;
      //Reverse the RIGHTJUSTIFY to be left
      if not AMenuItem.RightJustify then
        fType := fType or MFT_RIGHTJUSTIFY;
    end
    else
    if AMenuItem.RightJustify then
      fType := fType or MFT_RIGHTJUSTIFY;
  end;
  if not InsertMenuItem(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo) then
    DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]);
  TriggerFormUpdate(AMenuItem);
end;

class function TWin32WSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU;
begin
  Result := CreatePopupMenu;
end;

class procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem);
var
  ParentOfParentHandle, ParentHandle: HMENU;
  MenuInfo: MENUITEMINFO;
begin
  if Assigned(AMenuItem.Parent) then
  begin
    ParentHandle := AMenuItem.Parent.Handle;
    RemoveMenu(ParentHandle, AMenuItem.Command, MF_BYCOMMAND);
    // convert submenu to a simple menu item if needed
    if (GetMenuItemCount(ParentHandle) = 0) and Assigned(AMenuItem.Parent.Parent) and
       AMenuItem.Parent.Parent.HandleAllocated then
    begin
      ParentOfParentHandle := AMenuItem.Parent.Parent.Handle;
      FillChar(MenuInfo, SizeOf(MenuInfo), 0);
      with MenuInfo do
      begin
        cbSize := menuiteminfosize;
        fMask := MIIM_SUBMENU;
      end;
      GetMenuItemInfo(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo);
      // the parent menu item is defined with submenu flag then reset it
      if MenuInfo.hSubmenu <> 0 then
      begin
        MenuInfo.hSubmenu := 0;
        if not SetMenuItemInfo(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo) then
          DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]);
        // Set menu item info destroys/corrupts our internal popup menu for the
        // unknown reason. We need to recreate it.
        if not IsMenu(ParentHandle) then
        begin
          ParentHandle := CreatePopupMenu;
          AMenuItem.Parent.Handle := ParentHandle;
        end;
      end;
    end;
  end;
  DestroyMenu(AMenuItem.Handle);
  TriggerFormUpdate(AMenuItem);
end;

class procedure TWin32WSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string);
begin
  UpdateCaption(AMenuItem, aCaption);
end;

class function TWin32WSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean;
begin
  UpdateCaption(AMenuItem, aMenuItem.Caption);
  Result := Checked;
end;

class procedure TWin32WSMenuItem.SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut);
begin
  UpdateCaption(AMenuItem, aMenuItem.Caption);
end;

class function TWin32WSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean;
var
  EnableFlag: DWord;
begin
  EnableFlag := MF_BYCOMMAND or EnabledToStateFlag[Enabled];
  Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag));
  TriggerFormUpdate(AMenuItem);
end;

class function TWin32WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean;
begin
  Result := ChangeMenuFlag(AMenuItem, MFT_RIGHTJUSTIFY, Justified);
end;

class procedure TWin32WSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem;
  const HasIcon: Boolean; const AIcon: Graphics.TBitmap);
begin
  UpdateCaption(AMenuItem, aMenuItem.Caption);
end;

{ TWin32WSMenu }

class function TWin32WSMenu.CreateHandle(const AMenu: TMenu): HMENU;
begin
  Result := CreateMenu;
end;

class procedure TWin32WSMenu.SetBiDiMode(const AMenu : TMenu;
  UseRightToLeftAlign, UseRightToLeftReading: Boolean);
begin
  if not WSCheckHandleAllocated(AMenu, 'SetBiDiMode')
  then Exit;

  SetMenuFlag(AMenu.Handle, MFT_RIGHTORDER or MFT_RIGHTJUSTIFY, AMenu.IsRightToLeft);

  //TriggerFormUpdate not take TMenu, we repeate the code
  if not (AMenu.Parent is TCustomForm) then Exit;
  if not TCustomForm(AMenu.Parent).HandleAllocated then Exit;
  if csDestroying in AMenu.Parent.ComponentState then Exit;

  AddToChangedMenus(TCustomForm(AMenu.Parent).Handle);
end;


{ TWin32WSPopupMenu }

class function TWin32WSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU;
begin
  Result := CreatePopupMenu;
end;

class procedure TWin32WSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer);
var
  MenuHandle: HMENU;
  AppHandle: HWND;
const
  lAlignment: array[TPopupAlignment, Boolean] of DWORD = (
              { left-to-rght } { right-to-left }
 { paLeft   } (TPM_LEFTALIGN,   TPM_RIGHTALIGN),
 { paRight  } (TPM_RIGHTALIGN,  TPM_LEFTALIGN),
 { paCenter } (TPM_CENTERALIGN, TPM_CENTERALIGN)
  );
  lTrackButtons: array[TTrackButton] of DWORD = (
 { tbRightButton } TPM_RIGHTBUTTON,
 { tbLeftButton  } TPM_LEFTBUTTON
  );
begin
  MenuHandle := APopupMenu.Handle;
  AppHandle := Win32WidgetSet.AppHandle;
  GetWin32WindowInfo(AppHandle)^.PopupMenu := APopupMenu;
  TrackPopupMenuEx(MenuHandle,
    lAlignment[APopupMenu.Alignment, APopupMenu.IsRightToLeft] or lTrackButtons[APopupMenu.TrackButton],
    X, Y, AppHandle, nil);
end;

initialization
  if (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then
    menuiteminfosize := W95_MENUITEMINFO_SIZE
  else
    menuiteminfosize := sizeof(TMenuItemInfo);
end.