1{ $Id: win32wsmenus.pp 57968 2018-05-18 23:26:49Z maxim $} 2{ 3 ***************************************************************************** 4 * Win32WSMenus.pp * 5 * --------------- * 6 * * 7 * * 8 ***************************************************************************** 9 10 ***************************************************************************** 11 This file is part of the Lazarus Component Library (LCL) 12 13 See the file COPYING.modifiedLGPL.txt, included in this distribution, 14 for details about the license. 15 ***************************************************************************** 16} 17unit Win32WSMenus; 18 19{$mode objfpc}{$H+} 20{$I win32defines.inc} 21 22interface 23 24uses 25//////////////////////////////////////////////////// 26// I M P O R T A N T 27//////////////////////////////////////////////////// 28// To get as little as posible circles, 29// uncomment only when needed for registration 30//////////////////////////////////////////////////// 31 LCLType, Graphics, GraphType, ImgList, Menus, Forms, 32//////////////////////////////////////////////////// 33 WSMenus, WSLCLClasses, WSProc, 34 Windows, Controls, Classes, SysUtils, Win32Int, Win32Proc, Win32WSImgList, 35 LCLProc, Themes, UxTheme, Win32Themes, Win32Extra, 36 FileUtil, LazUTF8; 37 38type 39 40 { TWin32WSMenuItem } 41 42 TWin32WSMenuItem = class(TWSMenuItem) 43 published 44 class procedure AttachMenu(const AMenuItem: TMenuItem); override; 45 class function CreateHandle(const AMenuItem: TMenuItem): HMENU; override; 46 class procedure DestroyHandle(const AMenuItem: TMenuItem); override; 47 class procedure SetCaption(const AMenuItem: TMenuItem; const ACaption: string); override; 48 class function SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; override; 49 class procedure SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); override; 50 class function SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; override; 51 class function SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; override; 52 class procedure UpdateMenuIcon(const AMenuItem: TMenuItem; const HasIcon: Boolean; const AIcon: Graphics.TBitmap); override; 53 end; 54 55 { TWin32WSMenu } 56 57 TWin32WSMenu = class(TWSMenu) 58 published 59 class function CreateHandle(const AMenu: TMenu): HMENU; override; 60 class procedure SetBiDiMode(const AMenu: TMenu; UseRightToLeftAlign, UseRightToLeftReading : Boolean); override; 61 end; 62 63 { TWin32WSMainMenu } 64 65 TWin32WSMainMenu = class(TWSMainMenu) 66 published 67 end; 68 69 { TWin32WSPopupMenu } 70 71 TWin32WSPopupMenu = class(TWSPopupMenu) 72 published 73 class function CreateHandle(const AMenu: TMenu): HMENU; override; 74 class procedure Popup(const APopupMenu: TPopupMenu; const X, Y: integer); override; 75 end; 76 77 function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize; 78 procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: Windows.RECT; const ItemAction, ItemState: UINT); 79 function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer; 80 procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC; 81 const ImageRect: TRect; const ASelected: Boolean); 82 function ItemStateToDrawState(const ItemState: UINT): LCLType.TOwnerDrawState; 83 84implementation 85 86uses strutils; 87 88type 89 TMenuItemHelper = class helper for TMenuItem 90 public 91 function MeasureItem(ACanvas: TCanvas; var AWidth, AHeight: Integer): Boolean; 92 function DrawItem(ACanvas: TCanvas; ARect: TRect; AState: LCLType.TOwnerDrawState): Boolean; 93 end; 94 95{ TMenuItemHelper } 96 97function TMenuItemHelper.DrawItem(ACanvas: TCanvas; ARect: TRect; 98 AState: LCLType.TOwnerDrawState): Boolean; 99begin 100 Result := DoDrawItem(ACanvas, ARect, AState); 101end; 102 103function TMenuItemHelper.MeasureItem(ACanvas: TCanvas; var AWidth, 104 AHeight: Integer): Boolean; 105begin 106 Result := DoMeasureItem(ACanvas, AWidth, AHeight); 107end; 108 109{ helper routines } 110 111const 112 SpaceNextToCheckMark = 2; // Used by Windows for check bitmap 113 SpaceNextToIcon = 5; // Our custom spacing for bitmaps bigger than check mark 114 115 // define the size of the MENUITEMINFO structure used by older Windows 116 // versions (95, NT4) to keep the compatibility with them 117 // Since W98 the size is 48 (hbmpItem was added) 118 W95_MENUITEMINFO_SIZE = 44; 119 120 EnabledToStateFlag: array[Boolean] of DWord = 121 ( 122 MF_GRAYED, 123 MF_ENABLED 124 ); 125 126 PopupItemStates: array[{ Enabled } Boolean, { Selected } Boolean] of TThemedMenu = 127 ( 128 (tmPopupItemDisabled, tmPopupItemDisabledHot), 129 (tmPopupItemNormal, tmPopupItemHot) 130 ); 131 132 PopupCheckBgStates: array[{ Enabled } Boolean] of TThemedMenu = 133 ( 134 tmPopupCheckBackgroundDisabled, 135 tmPopupCheckBackgroundNormal 136 ); 137 138 PopupCheckStates: array[{ Enabled } Boolean, { RadioItem } Boolean] of TThemedMenu = 139 ( 140 (tmPopupCheckMarkDisabled, tmPopupBulletDisabled), 141 (tmPopupCheckMarkNormal, tmPopupBulletNormal) 142 ); 143 144 PopupSubmenuStates: array[{ Enabled } Boolean] of TThemedMenu = 145 ( 146 tmPopupSubmenuDisabled, 147 tmPopupSubmenuNormal 148 ); 149 150 151type 152 TCaptionFlags = (cfBold, cfUnderline); 153 TCaptionFlagsSet = set of TCaptionFlags; 154 155 // metrics for vista drawing 156 TVistaPopupMenuMetrics = record 157 ItemMargins: TMargins; 158 CheckSize: TSize; 159 CheckMargins: TMargins; 160 CheckBgMargins: TMargins; 161 GutterSize: TSize; 162 SubMenuSize: TSize; 163 SubMenuMargins: TMargins; 164 TextSize: TSize; 165 TextMargins: TMargins; 166 ShortCustSize: TSize; 167 SeparatorSize: TSize; 168 end; 169 170 TVistaBarMenuMetrics = record 171 ItemMargins: TMargins; 172 TextSize: TSize; 173 end; 174 175function GetLastErrorReport: AnsiString; 176begin 177 Result := IntToStr(GetLastError) + ' : ' + UTF8ToConsole(AnsiToUtf8(GetLastErrorText(GetLastError))); 178end; 179 180function FindMenuItemAccelerator(const ACharCode: word; const AMenuHandle: HMENU): integer; 181var 182 MenuItemIndex: integer; 183 ItemInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 184 FirstMenuItem: TMenuItem; 185 SiblingMenuItem: TMenuItem; 186 i: integer; 187begin 188 Result := MakeLResult(0, MNC_IGNORE); 189 MenuItemIndex := -1; 190 ItemInfo.cbSize := sizeof(TMenuItemInfo); 191 ItemInfo.fMask := MIIM_DATA; 192 if not GetMenuItemInfoW(AMenuHandle, 0, true, @ItemInfo) then Exit; 193 194 FirstMenuItem := TMenuItem(ItemInfo.dwItemData); 195 if FirstMenuItem = nil then exit; 196 i := 0; 197 while (i < FirstMenuItem.Parent.Count) and (MenuItemIndex < 0) do 198 begin 199 SiblingMenuItem := FirstMenuItem.Parent.Items[i]; 200 if IsAccel(ACharCode, SiblingMenuItem.Caption) then 201 MenuItemIndex := SiblingMenuItem.MenuVisibleIndex; 202 inc(i); 203 end; 204 if MenuItemIndex > -1 then 205 Result := MakeLResult(MenuItemIndex, MNC_EXECUTE); 206end; 207 208function GetMenuItemFont(const AFlags: TCaptionFlagsSet): HFONT; 209var 210 lf: LOGFONT; 211 ncm: NONCLIENTMETRICS; 212begin 213 ncm.cbSize := sizeof(ncm); 214 if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, SizeOf(ncm), @ncm, 0) then 215 lf := ncm.lfMenuFont 216 else 217 GetObject(GetStockObject(DEFAULT_GUI_FONT), SizeOf(LOGFONT), @lf); 218 if cfUnderline in AFlags then 219 lf.lfUnderline := 1 220 else 221 lf.lfUnderline := 0; 222 if cfBold in AFlags then 223 begin 224 if lf.lfWeight <= 400 then 225 lf.lfWeight := lf.lfWeight + 300 226 else 227 lf.lfWeight := lf.lfWeight + 100; 228 end; 229 Result := CreateFontIndirect(@lf); 230end; 231 232(* Get the menu item shortcut text *) 233function MenuItemShortCut(const AMenuItem: TMenuItem): string; 234begin 235 Result := ShortCutToText(AMenuItem.ShortCut); 236 if AMenuItem.ShortCutKey2 <> scNone then 237 Result := Result + ', ' + ShortCutToText(AMenuItem.ShortCutKey2); 238end; 239 240(* Get the menu item caption including shortcut *) 241function CompleteMenuItemCaption(const AMenuItem: TMenuItem; Spacing: String): string; 242begin 243 Result := AMenuItem.Caption; 244 if AMenuItem.ShortCut <> scNone then 245 Result := Result + Spacing + MenuItemShortCut(AMenuItem); 246end; 247 248(* Idem with external string caption *) 249function CompleteMenuItemStringCaption(const AMenuItem: TMenuItem; ACaption: String; Spacing: String): string; 250begin 251 Result := ACaption; 252 if AMenuItem.ShortCut <> scNone then 253 Result := Result + Spacing + MenuItemShortCut(AMenuItem); 254end; 255 256(* Get the maximum length of the given string in pixels *) 257function StringSize(const aCaption: String; const aHDC: HDC): TSize; 258var 259 tmpRect: Windows.RECT; 260 WideBuffer: widestring; 261begin 262 FillChar(tmpRect, SizeOf(tmpRect), 0); 263 WideBuffer := UTF8ToUTF16(aCaption); 264 DrawTextW(aHDC, PWideChar(WideBuffer), length(WideBuffer), @TmpRect, DT_CALCRECT); 265 266 Result.cx := TmpRect.right - TmpRect.left; 267 Result.cy := TmpRect.Bottom - TmpRect.Top; 268end; 269 270function GetAverageCharSize(AHDC: HDC): TSize; 271const 272 alph: AnsiString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; 273var 274 sz: SIZE; 275 tm: TEXTMETRIC; 276begin 277 if GetTextMetrics(AHDC, @tm) = False then 278 Result.cy := 0 279 else 280 Result.cy := WORD(tm.tmHeight); 281 282 if GetTextExtentPoint(AHDC, @alph[1], 52, @sz) = False then 283 Result.cx := 0 284 else 285 Result.cx := (sz.cx div 26 + 1) div 2; 286end; 287 288function MenuIconWidth(const AMenuItem: TMenuItem; DC: HDC): integer; 289var 290 SiblingMenuItem : TMenuItem; 291 i, RequiredWidth: integer; 292begin 293 Result := 0; 294 295 if AMenuItem.IsInMenuBar then 296 begin 297 Result := AMenuItem.GetIconSize(DC).x; 298 end 299 else 300 begin 301 for i := 0 to AMenuItem.Parent.Count - 1 do 302 begin 303 SiblingMenuItem := AMenuItem.Parent.Items[i]; 304 if SiblingMenuItem.HasIcon then 305 begin 306 RequiredWidth := SiblingMenuItem.GetIconSize(DC).x; 307 if RequiredWidth > Result then 308 Result := RequiredWidth; 309 end; 310 end; 311 end; 312end; 313 314procedure GetNonTextSpace(const AMenuItem: TMenuItem; DC: HDC; 315 AvgCharWidth: Integer; 316 out LeftSpace, RightSpace: Integer); 317var 318 Space: Integer = SpaceNextToCheckMark; 319 CheckMarkWidth: Integer; 320begin 321 // If we have Check and Icon then we use only width of Icon. 322 // We draw our MenuItem so: space Image space Caption. 323 // Items not in menu bar always have enough space for a check mark. 324 325 CheckMarkWidth := GetSystemMetrics(SM_CXMENUCHECK); 326 LeftSpace := MenuIconWidth(AMenuItem, DC); 327 328 if LeftSpace > 0 then 329 begin 330 if not AMenuItem.IsInMenuBar then 331 begin 332 if LeftSpace < CheckMarkWidth then 333 LeftSpace := CheckMarkWidth 334 else 335 if LeftSpace > CheckMarkWidth then 336 Space := SpaceNextToIcon; 337 end; 338 end 339 else 340 begin 341 if not AMenuItem.IsInMenuBar or AMenuItem.Checked then 342 LeftSpace := CheckMarkWidth; 343 end; 344 345 if LeftSpace > 0 then 346 begin 347 // Space to the left of the icon or check. 348 if not AMenuItem.IsInMenuBar then 349 Inc(LeftSpace, Space); 350 // Space between icon or check and caption. 351 if AMenuItem.Caption <> '' then 352 Inc(LeftSpace, Space); 353 end; 354 355 if AMenuItem.IsInMenuBar then 356 RightSpace := 0 357 else 358 RightSpace := CheckMarkWidth + AvgCharWidth; 359 360 if AMenuItem.Caption <> '' then 361 begin 362 if AMenuItem.IsInMenuBar then 363 begin 364 Inc(LeftSpace, AvgCharWidth); 365 Inc(RightSpace, AvgCharWidth); 366 end 367 else 368 begin 369 // Space on the right side of the text. 370 Inc(RightSpace, SpaceNextToCheckMark); 371 end; 372 end; 373end; 374 375function TopPosition(const aMenuItemHeight: integer; const anElementHeight: integer): integer; 376begin 377 Result := (aMenuItemHeight - anElementHeight) div 2; 378end; 379 380function IsVistaMenu: Boolean; inline; 381begin 382 Result := ThemeServices.ThemesAvailable and (WindowsVersion >= wvVista) and 383 (TWin32ThemeServices(ThemeServices).Theme[teMenu] <> 0); 384end; 385 386function GetVistaPopupMenuMetrics(const AMenuItem: TMenuItem; DC: HDC): TVistaPopupMenuMetrics; 387var 388 Theme: HTHEME; 389 TextRect: TRect; 390 W: WideString; 391 AFont, OldFont: HFONT; 392begin 393 Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu]; 394 GetThemeMargins(Theme, DC, MENU_POPUPITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins); 395 GetThemePartSize(Theme, DC, MENU_POPUPCHECK, 0, nil, TS_TRUE, Result.CheckSize); 396 GetThemeMargins(Theme, DC, MENU_POPUPCHECK, 0, TMT_CONTENTMARGINS, nil, Result.CheckMargins); 397 GetThemeMargins(Theme, DC, MENU_POPUPCHECKBACKGROUND, 0, TMT_CONTENTMARGINS, nil, Result.CheckBgMargins); 398 GetThemePartSize(Theme, DC, MENU_POPUPGUTTER, 0, nil, TS_TRUE, Result.GutterSize); 399 GetThemePartSize(Theme, DC, MENU_POPUPSUBMENU, 0, nil, TS_TRUE, Result.SubMenuSize); 400 GetThemeMargins(Theme, DC, MENU_POPUPSUBMENU, 0, TMT_CONTENTMARGINS, nil, Result.SubMenuMargins); 401 402 if AMenuItem.IsLine then 403 begin 404 GetThemePartSize(Theme, DC, MENU_POPUPSEPARATOR, 0, nil, TS_TRUE, Result.SeparatorSize); 405 FillChar(Result.TextMargins, SizeOf(Result.TextMargins), 0); 406 FillChar(Result.TextSize, SizeOf(Result.TextSize), 0); 407 end 408 else 409 begin 410 Result.TextMargins := Result.ItemMargins; 411 GetThemeInt(Theme, MENU_POPUPITEM, 0, TMT_BORDERSIZE, Result.TextMargins.cxRightWidth); 412 GetThemeInt(Theme, MENU_POPUPBACKGROUND, 0, TMT_BORDERSIZE, Result.TextMargins.cxLeftWidth); 413 414 if AMenuItem.Default then 415 AFont := GetMenuItemFont([cfBold]) 416 else 417 AFont := GetMenuItemFont([]); 418 OldFont := SelectObject(DC, AFont); 419 420 W := UTF8ToUTF16(CompleteMenuItemCaption(AMenuItem, #9)); 421 GetThemeTextExtent(Theme, DC, MENU_POPUPITEM, 0, PWideChar(W), Length(W), 422 DT_SINGLELINE or DT_LEFT or DT_EXPANDTABS, nil, TextRect); 423 Result.TextSize.cx := TextRect.Right - TextRect.Left; 424 Result.TextSize.cy := TextRect.Bottom - TextRect.Top; 425 426 if AMenuItem.ShortCut <> scNone then 427 begin; 428 W := UTF8ToUTF16(MenuItemShortCut(AMenuItem)); 429 GetThemeTextExtent(Theme, DC, MENU_POPUPITEM, 0, PWideChar(W), Length(W), 430 DT_SINGLELINE or DT_LEFT, nil, TextRect); 431 Result.ShortCustSize.cx := TextRect.Right - TextRect.Left; 432 Result.ShortCustSize.cy := TextRect.Bottom - TextRect.Top; 433 end; 434 if OldFont <> 0 then 435 DeleteObject(SelectObject(DC, OldFont)); 436 end; 437end; 438 439function GetVistaBarMenuMetrics(const AMenuItem: TMenuItem; DC: HDC): TVistaBarMenuMetrics; 440var 441 Theme: HTHEME; 442 TextRect: TRect; 443 W: WideString; 444 AFont, OldFont: HFONT; 445begin 446 Theme := TWin32ThemeServices(ThemeServices).Theme[teMenu]; 447 GetThemeMargins(Theme, 0, MENU_BARITEM, 0, TMT_CONTENTMARGINS, nil, Result.ItemMargins); 448 449 if AMenuItem.Default then 450 AFont := GetMenuItemFont([cfBold]) 451 else 452 AFont := GetMenuItemFont([]); 453 454 OldFont := SelectObject(DC, AFont); 455 456 W := UTF8ToUTF16(AMenuItem.Caption); 457 GetThemeTextExtent(Theme, DC, MENU_BARITEM, 0, PWideChar(W), Length(W), 458 DT_SINGLELINE or DT_LEFT or DT_EXPANDTABS, nil, TextRect); 459 Result.TextSize.cx := TextRect.Right - TextRect.Left; 460 Result.TextSize.cy := TextRect.Bottom - TextRect.Top; 461 if OldFont <> 0 then 462 DeleteObject(SelectObject(DC, OldFont)); 463end; 464 465function VistaBarMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize; 466var 467 Metrics: TVistaBarMenuMetrics; 468 IconSize: TPoint; 469begin 470 Metrics := GetVistaBarMenuMetrics(AMenuItem, ADC); 471 // item margins. Seems windows adds that margins itself to our return values 472 Result.cx := 0; //Metrics.ItemMargins.cxLeftWidth + Metrics.ItemMargins.cxRightWidth; 473 Result.cy := 0; //Metrics.ItemMargins.cyTopHeight + Metrics.ItemMargins.cyBottomHeight; 474 // + text size / icon size 475 IconSize := AMenuItem.GetIconSize(ADC); 476 Result.cx := Result.cx + Metrics.TextSize.cx + IconSize.x; 477 if IconSize.x > 0 then 478 inc(Result.cx, Metrics.ItemMargins.cxLeftWidth); 479 Result.cy := Result.cy + Max(Metrics.TextSize.cy, IconSize.y); 480end; 481 482function VistaPopupMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize; 483var 484 Metrics: TVistaPopupMenuMetrics; 485 IconSize: TPoint; 486 IconWidth: Integer; 487begin 488 Metrics := GetVistaPopupMenuMetrics(AMenuItem, ADC); 489 // count check 490 Result.cx := Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth; 491 if AMenuItem.IsLine then 492 begin 493 Result.cx := Result.cx + Metrics.SeparatorSize.cx + Metrics.ItemMargins.cxLeftWidth + Metrics.ItemMargins.cxRightWidth; 494 Result.cy := Metrics.SeparatorSize.cy + Metrics.ItemMargins.cyTopHeight + Metrics.ItemMargins.cyBottomHeight; 495 end 496 else 497 begin 498 Result.cy := Max(Metrics.TextSize.cy + 1, Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight); 499 if AMenuItem.HasIcon then 500 begin 501 IconSize := AMenuItem.GetIconSize(ADC); 502 Result.cy := Max(Result.cy, IconSize.y); 503 Result.cx := Max(Result.cx, IconSize.x); 504 end; 505 IconWidth := MenuIconWidth(AMenuItem, ADC); 506 Result.cx := Max(Result.cx, IconWidth); 507 Result.cy := Max(Result.cy, IconWidth); 508 end; 509 // count gutter 510 Result.cx := Result.cx + (Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth) + 511 Metrics.GutterSize.cx; 512 // count text 513 Result.cx := Result.cx + Metrics.TextSize.cx; 514 Result.cx := Result.cx + Metrics.TextMargins.cxLeftWidth + Metrics.TextMargins.cxRightWidth; 515end; 516 517function ClassicMenuItemSize(AMenuItem: TMenuItem; ADC: HDC): TSize; 518var 519 LeftSpace, RightSpace: Integer; 520 oldFont: HFONT; 521 newFont: HFONT; 522 AvgCharSize: TSize; 523begin 524 if AMenuItem.Default then 525 newFont := GetMenuItemFont([cfBold]) 526 else 527 newFont := GetMenuItemFont([]); 528 oldFont := SelectObject(ADC, newFont); 529 AvgCharSize := GetAverageCharSize(ADC); 530 531 Result := StringSize(CompleteMenuItemCaption(AMenuItem, EmptyStr), ADC); 532 533 // Space between text and shortcut. 534 if AMenuItem.ShortCut <> scNone then 535 inc(Result.cx, AvgCharSize.cx); 536 537 GetNonTextSpace(AMenuItem, ADC, AvgCharSize.cx, LeftSpace, RightSpace); 538 inc(Result.cx, LeftSpace + RightSpace); 539 540 // Windows adds additional space to value returned from WM_MEASUREITEM 541 // for owner drawn menus. This is to negate that. 542 Dec(Result.cx, AvgCharSize.cx * 2); 543 544 // As for height of items in menu bar, regardless of what is set here, 545 // Windows seems to always use SM_CYMENUSIZE (space for a border is included). 546 547 if AMenuItem.IsLine then 548 Result.cy := GetSystemMetrics(SM_CYMENUSIZE) div 2 // it is a separator 549 else 550 begin 551 if AMenuItem.IsInMenuBar then 552 begin 553 Result.cy := Max(Result.cy, GetSystemMetrics(SM_CYMENUSIZE)); 554 if AMenuItem.hasIcon then 555 Result.cy := Max(Result.cy, aMenuItem.GetIconSize(ADC).y); 556 end 557 else 558 begin 559 Result.cy := Max(Result.cy + 2, AvgCharSize.cy + 4); 560 if AMenuItem.hasIcon then 561 Result.cy := Max(Result.cy, aMenuItem.GetIconSize(ADC).y + 2); 562 end; 563 end; 564 565 SelectObject(ADC, oldFont); 566 DeleteObject(newFont); 567end; 568 569procedure ThemeDrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect); inline; 570begin 571 with Details do 572 DrawThemeBackground(TWin32ThemeServices(ThemeServices).Theme[Element], DC, Part, State, R, ClipRect); 573end; 574 575procedure ThemeDrawText(DC: HDC; Details: TThemedElementDetails; 576 const S: String; R: TRect; Flags, Flags2: Cardinal); 577var 578 w: widestring; 579begin 580 with Details do 581 begin 582 w := UTF8ToUTF16(S); 583 DrawThemeText(TWin32ThemeServices(ThemeServices).Theme[Element], DC, Part, State, PWideChar(w), Length(w), Flags, Flags2, R); 584 end; 585end; 586 587procedure DrawVistaMenuBar(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: TRect; const ASelected, ANoAccel: Boolean; const ItemAction, ItemState: UINT); 588const 589 BarState: array[Boolean] of TThemedMenu = 590 ( 591 tmBarBackgroundInactive, 592 tmBarBackgroundActive 593 ); 594 OBJID_MENU = LONG($FFFFFFFD); 595 596 function IsLast: Boolean; 597 var 598 Index, i: Integer; 599 begin 600 Index := AMenuItem.Parent.IndexOf(AMenuItem); 601 for i := Index + 1 to AMenuItem.Parent.Count - 1 do 602 if AMenuItem.Parent.Items[i].Visible then 603 Exit(False); 604 Result := True; 605 end; 606var 607 MenuState: TThemedMenu; 608 Metrics: TVistaBarMenuMetrics; 609 Details, Tmp: TThemedElementDetails; 610 BGRect, BGClip, WndRect, TextRect, ImageRect: TRect; 611 IconSize: TPoint; 612 TextFlags: DWord; 613 AFont, OldFont: HFONT; 614 IsRightToLeft: Boolean; 615 Info: tagMENUBARINFO; 616 AWnd: HWND; 617 CalculatedSize: TSIZE; 618begin 619 if (ItemState and ODS_SELECTED) <> 0 then 620 MenuState := tmBarItemPushed 621 else 622 if (ItemState and ODS_HOTLIGHT) <> 0 then 623 MenuState := tmBarItemHot 624 else 625 MenuState := tmBarItemNormal; 626 627 if (ItemState and (ODS_DISABLED or ODS_INACTIVE)) <> 0 then 628 inc(MenuState, 3); 629 630 IsRightToLeft := AMenuItem.GetIsRightToLeft; 631 Metrics := GetVistaBarMenuMetrics(AMenuItem, AHDC); 632 633 // draw backgound 634 // This is a hackish way to draw. Seems windows itself draws this in WM_PAINT or another paint handler? 635 AWnd := TCustomForm(AMenuItem.GetParentMenu.Parent).Handle; 636 if (AMenuItem.Parent.VisibleIndexOf(AMenuItem) = 0) then 637 begin 638 /// if we are painting the first item then request full repaint to draw the bg correctly 639 if (GetProp(AWnd, 'LCL_MENUREDRAW') = 0) then 640 begin 641 SetProp(AWnd, 'LCL_MENUREDRAW', 1); 642 DrawMenuBar(AWnd); 643 Exit; 644 end 645 else 646 SetProp(AWnd, 'LCL_MENUREDRAW', 0); 647 // repainting menu bar bg 648 FillChar(Info, SizeOf(Info), 0); 649 Info.cbSize := SizeOf(Info); 650 GetMenuBarInfo(AWnd, OBJID_MENU, 0, @Info); 651 GetWindowRect(AWnd, @WndRect); 652 OffsetRect(Info.rcBar, -WndRect.Left, -WndRect.Top); 653 Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]); 654 ThemeDrawElement(AHDC, Tmp, Info.rcBar, nil); 655 end; 656 657 BGRect := ARect; 658 BGClip := ARect; 659 if IsRightToLeft <> AMenuItem.RightJustify then 660 begin 661 inc(BGRect.Right, 2); 662 dec(BGRect.Left, 2); 663 end 664 else 665 begin 666 inc(BGRect.Right, 2); 667 dec(BGRect.Left, 2); 668 end; 669 Tmp := ThemeServices.GetElementDetails(BarState[(ItemState and ODS_INACTIVE) = 0]); 670 ThemeDrawElement(AHDC, Tmp, BGRect, @BGClip); 671 672 Details := ThemeServices.GetElementDetails(MenuState); 673 // draw menu item 674 ThemeDrawElement(AHDC, Details, ARect, nil); 675 676 TextRect := ARect; 677 //center the menu item 678 CalculatedSize := VistaBarMenuItemSize(AMenuItem, AHDC); 679 TextRect.Left := (TextRect.Right+TextRect.Left-CalculatedSize.cx) div 2; 680 TextRect.Right := TextRect.Left + CalculatedSize.cx; 681 TextRect.Top := (TextRect.Bottom+TextRect.Top-CalculatedSize.cy) div 2; 682 TextRect.Bottom := TextRect.Top + CalculatedSize.cy; 683 684 // draw check/image 685 if AMenuItem.HasIcon then 686 begin 687 IconSize := AMenuItem.GetIconSize(AHDC); 688 if IsRightToLeft then 689 ImageRect.Left := TextRect.Right - IconSize.x 690 else 691 ImageRect.Left := TextRect.Left; 692 ImageRect.Top := (TextRect.Top + TextRect.Bottom - IconSize.y) div 2; 693 ImageRect.Right := 0; 694 ImageRect.Bottom := 0; 695 DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected); 696 if IsRightToLeft then 697 dec(TextRect.Right, IconSize.x + Metrics.ItemMargins.cxLeftWidth) 698 else 699 inc(TextRect.Left, IconSize.x + Metrics.ItemMargins.cxLeftWidth); 700 end; 701 702 // draw text 703 TextRect.Top := (TextRect.Top + TextRect.Bottom - Metrics.TextSize.cy) div 2; 704 TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy; 705 TextFlags := DT_SINGLELINE or DT_EXPANDTABS; 706 if IsRightToLeft then 707 TextFlags := TextFlags or DT_RTLREADING; 708 if ANoAccel then 709 TextFlags := TextFlags or DT_HIDEPREFIX; 710 if AMenuItem.Default then 711 AFont := GetMenuItemFont([cfBold]) 712 else 713 AFont := GetMenuItemFont([]); 714 OldFont := SelectObject(AHDC, AFont); 715 ThemeDrawText(AHDC, Details, AMenuItem.Caption, TextRect, TextFlags, 0); 716 if OldFont <> 0 then 717 DeleteObject(SelectObject(AHDC, OldFont)); 718end; 719 720procedure DrawVistaPopupMenu(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: TRect; const ASelected, ANoAccel: boolean); 721var 722 Details, Tmp: TThemedElementDetails; 723 Metrics: TVistaPopupMenuMetrics; 724 CheckRect, CheckRect2, GutterRect, TextRect, SeparatorRect, ImageRect, SubMenuRect: TRect; 725 IconSize: TPoint; 726 TextFlags: DWord; 727 AFont, OldFont: HFONT; 728 IsRightToLeft: Boolean; 729 IconWidth: Integer; 730begin 731 Metrics := GetVistaPopupMenuMetrics(AMenuItem, AHDC); 732 // draw backgound 733 Details := ThemeServices.GetElementDetails(PopupItemStates[AMenuItem.Enabled, ASelected]); 734 if ThemeServices.HasTransparentParts(Details) then 735 begin 736 Tmp := ThemeServices.GetElementDetails(tmPopupBackground); 737 ThemeDrawElement(AHDC, Tmp, ARect, nil); 738 end; 739 IsRightToLeft := AMenuItem.GetIsRightToLeft; 740 if IsRightToLeft then 741 SetLayout(AHDC, LAYOUT_RTL); 742 // calc check/image rect 743 CheckRect := ARect; 744 CheckRect.Right := CheckRect.Left + Metrics.CheckSize.cx + Metrics.CheckMargins.cxRightWidth + Metrics.CheckMargins.cxLeftWidth; 745 CheckRect.Bottom := CheckRect.Top + Metrics.CheckSize.cy + Metrics.CheckMargins.cyTopHeight + Metrics.CheckMargins.cyBottomHeight; 746 if AMenuItem.HasIcon then 747 begin 748 IconSize := AMenuItem.GetIconSize(AHDC); 749 CheckRect.Bottom := Max(CheckRect.Bottom, CheckRect.Top+IconSize.y); 750 end; 751 IconWidth := MenuIconWidth(AMenuItem, AHDC); 752 CheckRect.Right := Max(CheckRect.Right, CheckRect.Left+IconWidth); 753 CheckRect.Bottom := Max(CheckRect.Bottom, CheckRect.Top+IconWidth); 754 OffsetRect(CheckRect, 0, (ARect.Bottom-ARect.Top-CheckRect.Bottom+CheckRect.Top) div 2); 755 // draw gutter 756 GutterRect := Rect(0, ARect.Top, CheckRect.Right, ARect.Bottom); 757 GutterRect.Left := GutterRect.Right + Metrics.CheckBgMargins.cxRightWidth - Metrics.CheckMargins.cxRightWidth; 758 GutterRect.Right := GutterRect.Left + Metrics.GutterSize.cx; 759 Tmp := ThemeServices.GetElementDetails(tmPopupGutter); 760 ThemeDrawElement(AHDC, Tmp, GutterRect, nil); 761 762 if AMenuItem.IsLine then 763 begin 764 // draw separator 765 SeparatorRect.Left := GutterRect.Right + Metrics.ItemMargins.cxLeftWidth; 766 SeparatorRect.Right := ARect.Right - Metrics.ItemMargins.cxRightWidth; 767 SeparatorRect.Top := ARect.Top + Metrics.ItemMargins.cyTopHeight; 768 SeparatorRect.Bottom := ARect.Bottom - Metrics.ItemMargins.cyBottomHeight; 769 Tmp := ThemeServices.GetElementDetails(tmPopupSeparator); 770 ThemeDrawElement(AHDC, Tmp, SeparatorRect, nil); 771 end 772 else 773 begin 774 // draw menu item 775 ThemeDrawElement(AHDC, Details, ARect, nil); 776 // draw submenu 777 if AMenuItem.Count > 0 then 778 begin 779 SubMenuRect := ARect; 780 SubMenuRect.Top := (SubMenuRect.Top + SubMenuRect.Bottom - Metrics.SubMenuSize.cy) div 2; 781 SubMenuRect.Bottom := SubMenuRect.Top + Metrics.SubMenuSize.cy; 782 SubMenuRect.Right := SubMenuRect.Right - Metrics.SubMenuMargins.cxRightWidth + Metrics.SubMenuMargins.cxLeftWidth; 783 SubMenuRect.Left := SubMenuRect.Right - Metrics.SubMenuSize.cx; 784 Tmp := ThemeServices.GetElementDetails(PopupSubmenuStates[AMenuItem.Enabled]); 785 Tmp.State := Tmp.State + 2; 786 ThemeDrawElement(AHDC, Tmp, SubMenuRect, nil); 787 end; 788 // draw check/image 789 if AMenuItem.HasIcon then 790 begin 791 ImageRect := CheckRect; 792 if AMenuItem.Checked then // draw checked rectangle around 793 begin 794 Tmp := ThemeServices.GetElementDetails(PopupCheckBgStates[AMenuItem.Enabled]); 795 ThemeDrawElement(AHDC, Tmp, CheckRect, nil); 796 end; 797 ImageRect.Left := (ImageRect.Left + ImageRect.Right - IconSize.x) div 2; 798 ImageRect.Top := (ImageRect.Top + ImageRect.Bottom - IconSize.y) div 2; 799 if IsRightToLeft then 800 begin 801 // we can't use RTL layout here since our imagelist does not support 802 // coordinates mirroring 803 SetLayout(AHDC, 0); 804 ImageRect.Left := ARect.Right - ImageRect.Left - IconSize.x; 805 end; 806 ImageRect.Right := IconSize.x; 807 ImageRect.Bottom := IconSize.y; 808 DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected); 809 if IsRightToLeft then 810 SetLayout(AHDC, LAYOUT_RTL); 811 end 812 else 813 if AMenuItem.Checked then 814 begin 815 Tmp := ThemeServices.GetElementDetails(PopupCheckBgStates[AMenuItem.Enabled]); 816 ThemeDrawElement(AHDC, Tmp, CheckRect, nil); 817 CheckRect2.Left := CheckRect.Left + (CheckRect.Right-CheckRect.Left-Metrics.CheckSize.cx) div 2; 818 CheckRect2.Top := CheckRect.Top + (CheckRect.Bottom-CheckRect.Top-Metrics.CheckSize.cy) div 2; 819 CheckRect2.Right := CheckRect2.Left + Metrics.CheckSize.cx; 820 CheckRect2.Bottom := CheckRect2.Top + Metrics.CheckSize.cy; 821 Tmp := ThemeServices.GetElementDetails(PopupCheckStates[AMenuItem.Enabled, AMenuItem.RadioItem]); 822 ThemeDrawElement(AHDC, Tmp, CheckRect2, nil); 823 end; 824 // draw text 825 TextFlags := DT_SINGLELINE or DT_EXPANDTABS; 826 // todo: distinct UseRightToLeftAlignment and UseRightToLeftReading 827 if IsRightToLeft then 828 begin 829 // restore layout before the text drawing since windows has bug with 830 // DT_RTLREADING support 831 SetLayout(AHDC, 0); 832 TextFlags := TextFlags or DT_RIGHT or DT_RTLREADING; 833 TextRect.Right := ARect.Right - GutterRect.Right - Metrics.TextMargins.cxLeftWidth; 834 TextRect.Left := ARect.Left + Metrics.TextMargins.cxRightWidth; 835 TextRect.Top := (GutterRect.Top + GutterRect.Bottom - Metrics.TextSize.cy) div 2; 836 TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy; 837 end 838 else 839 begin 840 TextFlags := TextFlags or DT_LEFT; 841 TextRect := GutterRect; 842 TextRect.Left := TextRect.Right + Metrics.TextMargins.cxLeftWidth; 843 TextRect.Right := ARect.Right - Metrics.TextMargins.cxRightWidth; 844 TextRect.Top := (TextRect.Top + TextRect.Bottom - Metrics.TextSize.cy) div 2; 845 TextRect.Bottom := TextRect.Top + Metrics.TextSize.cy; 846 end; 847 848 if ANoAccel then 849 TextFlags := TextFlags or DT_HIDEPREFIX; 850 if AMenuItem.Default then 851 AFont := GetMenuItemFont([cfBold]) 852 else 853 AFont := GetMenuItemFont([]); 854 OldFont := SelectObject(AHDC, AFont); 855 856 ThemeDrawText(AHDC, Details, AMenuItem.Caption, TextRect, TextFlags, 0); 857 if AMenuItem.ShortCut <> scNone then 858 begin 859 if IsRightToLeft then 860 begin 861 TextRect.Right := TextRect.Left + Metrics.ShortCustSize.cx; 862 TextFlags := TextFlags xor DT_RIGHT or DT_LEFT; 863 end 864 else 865 begin 866 TextRect.Left := TextRect.Right - Metrics.ShortCustSize.cx; 867 TextFlags := TextFlags xor DT_LEFT or DT_RIGHT; 868 end; 869 ThemeDrawText(AHDC, Details, MenuItemShortCut(AMenuItem), TextRect, TextFlags, 0); 870 end; 871 // exlude menu item rectangle to prevent drawing by windows after us 872 if AMenuItem.Count > 0 then 873 ExcludeClipRect(AHDC, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); 874 if OldFont <> 0 then 875 DeleteObject(SelectObject(AHDC, OldFont)); 876 end; 877end; 878 879function MenuItemSize(AMenuItem: TMenuItem; AHDC: HDC): TSize; 880var 881 CC: TControlCanvas; 882 ParentMenu: TMenu; 883begin 884 CC := TControlCanvas.Create; 885 try 886 CC.Handle := AHDC; 887 Result.cx := 0; 888 Result.cy := 0; 889 890 if not AMenuItem.MeasureItem(CC, Result.cx, Result.cy) then 891 begin 892 if IsVistaMenu then 893 begin 894 if AMenuItem.IsInMenuBar then 895 Result := VistaBarMenuItemSize(AMenuItem, AHDC) 896 else 897 Result := VistaPopupMenuItemSize(AMenuItem, AHDC); 898 end 899 else 900 Result := ClassicMenuItemSize(AMenuItem, AHDC); 901 end; 902 finally 903 CC.Free; 904 end; 905end; 906 907function IsFlatMenus: Boolean; inline; 908var 909 IsFlatMenu: Windows.BOOL; 910begin 911 Result := (WindowsVersion >= wvXP) and 912 (SystemParametersInfo(SPI_GETFLATMENU, 0, @IsFlatMenu, 0) and IsFlatMenu); 913end; 914 915function BackgroundColorMenu(const ItemState: UINT; const aIsInMenuBar: boolean): COLORREF; 916begin 917 if IsFlatMenus then 918 begin 919 if (ItemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0 then 920 Result := GetSysColor(COLOR_MENUHILIGHT) 921 else 922 if aIsInMenuBar then 923 Result := GetSysColor(COLOR_MENUBAR) 924 else 925 Result := GetSysColor(COLOR_MENU); 926 end 927 else 928 begin 929 // 3d menu bar always have standard color 930 if aIsInMenuBar then 931 Result := GetSysColor(COLOR_MENU) 932 else 933 if (ItemState and ODS_SELECTED) <> 0 then 934 Result := GetSysColor(COLOR_HIGHLIGHT) 935 else 936 Result := GetSysColor(COLOR_MENU); 937 end; 938end; 939 940function TextColorMenu(const ItemState: UINT; const aIsInMenuBar: boolean; const anEnabled: boolean): COLORREF; 941begin 942 if anEnabled then 943 begin 944 if IsFlatMenus then 945 begin 946 if (ItemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0 then 947 Result := GetSysColor(COLOR_HIGHLIGHTTEXT) 948 else 949 Result := GetSysColor(COLOR_MENUTEXT); 950 end 951 else 952 begin 953 if ((ItemState and ODS_SELECTED) <> 0) and not aIsInMenuBar then 954 Result := GetSysColor(COLOR_HIGHLIGHTTEXT) 955 else 956 Result := GetSysColor(COLOR_MENUTEXT); 957 end; 958 end 959 else 960 Result := GetSysColor(COLOR_GRAYTEXT); 961end; 962 963procedure DrawSeparator(const AHDC: HDC; const ARect: Windows.RECT); 964var 965 separatorRect: Windows.RECT; 966 space: Integer; 967begin 968 if IsFlatMenus then 969 space := 3 970 else 971 space := 1; 972 973 separatorRect.Left := ARect.Left + space; 974 separatorRect.Right := ARect.Right - space; 975 separatorRect.Top := ARect.Top + GetSystemMetrics(SM_CYMENUSIZE) div 4 - 1; 976 DrawEdge(AHDC, separatorRect, EDGE_ETCHED, BF_TOP); 977end; 978 979procedure DrawMenuItemCheckMark(const aMenuItem: TMenuItem; const aHDC: HDC; 980 const aRect: Windows.RECT; const aSelected: boolean; AvgCharWidth: Integer); 981var 982 checkMarkWidth: integer; 983 checkMarkHeight: integer; 984 hdcMem: HDC; 985 monoBitmap: HBITMAP; 986 oldBitmap: HBITMAP; 987 checkMarkShape: integer; 988 checkMarkRect: Windows.RECT; 989 x:Integer; 990 space: Integer; 991begin 992 hdcMem := CreateCompatibleDC(aHDC); 993 checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK); 994 checkMarkHeight := GetSystemMetrics(SM_CYMENUCHECK); 995 monoBitmap := CreateBitmap(checkMarkWidth, checkMarkHeight, 1, 1, nil); 996 oldBitmap := SelectObject(hdcMem, monoBitmap); 997 checkMarkRect.left := 0; 998 checkMarkRect.top := 0; 999 checkMarkRect.right := checkMarkWidth; 1000 checkMarkRect.bottom := checkMarkHeight; 1001 if aMenuItem.RadioItem then 1002 checkMarkShape := DFCS_MENUBULLET 1003 else 1004 checkMarkShape := DFCS_MENUCHECK; 1005 DrawFrameControl(hdcMem, @checkMarkRect, DFC_MENU, checkMarkShape); 1006 if aMenuItem.IsInMenuBar then 1007 space := AvgCharWidth 1008 else 1009 space := SpaceNextToCheckMark; 1010 if aMenuItem.GetIsRightToLeft then 1011 x := aRect.Right - checkMarkWidth - space 1012 else 1013 x := aRect.left + space; 1014 BitBlt(aHDC, x, aRect.top + topPosition(aRect.bottom - aRect.top, checkMarkRect.bottom - checkMarkRect.top), checkMarkWidth, checkMarkHeight, hdcMem, 0, 0, SRCCOPY); 1015 SelectObject(hdcMem, oldBitmap); 1016 DeleteObject(monoBitmap); 1017 DeleteDC(hdcMem); 1018end; 1019 1020procedure DrawMenuItemText(const AMenuItem: TMenuItem; const AHDC: HDC; 1021 ARect: TRect; const ASelected, ANoAccel: boolean; ItemState: UINT; 1022 AvgCharWidth: Integer); 1023var 1024 crText: COLORREF; 1025 crBkgnd: COLORREF; 1026 oldBkMode: Longint; 1027 shortCutText: string; 1028 IsRightToLeft: Boolean; 1029 etoFlags: Cardinal; 1030 dtFlags: DWord; 1031 WideBuffer: widestring; 1032 LeftSpace, RightSpace: Integer; 1033begin 1034 crText := TextColorMenu(ItemState, AMenuItem.IsInMenuBar, AMenuItem.Enabled); 1035 crBkgnd := BackgroundColorMenu(ItemState, AMenuItem.IsInMenuBar); 1036 SetTextColor(AHDC, crText); 1037 SetBkColor(AHDC, crBkgnd); 1038 1039 IsRightToLeft := AMenuItem.GetIsRightToLeft; 1040 etoFlags := ETO_OPAQUE; 1041 // DT_LEFT is default because its value is 0 1042 dtFlags := DT_EXPANDTABS or DT_VCENTER or DT_SINGLELINE; 1043 if ANoAccel then 1044 dtFlags := dtFlags or DT_HIDEPREFIX; 1045 if IsRightToLeft then 1046 begin 1047 etoFlags := etoFlags or ETO_RTLREADING; 1048 dtFlags := dtFlags or DT_RIGHT or DT_RTLREADING; 1049 end; 1050 1051 // fill the menu item background 1052 ExtTextOut(AHDC, 0, 0, etoFlags, @ARect, PChar(''), 0, nil); 1053 1054 if AMenuItem.IsInMenuBar and not IsFlatMenus then 1055 begin 1056 if (ItemState and ODS_SELECTED) <> 0 then 1057 begin 1058 DrawEdge(AHDC, ARect, BDR_SUNKENOUTER, BF_RECT); 1059 1060 // Adjust caption position when menu is open. 1061 OffsetRect(ARect, 1, 1); 1062 end 1063 else 1064 if (ItemState and ODS_HOTLIGHT) <> 0 then 1065 DrawEdge(AHDC, ARect, BDR_RAISEDINNER, BF_RECT); 1066 end; 1067 1068 GetNonTextSpace(AMenuItem, AHDC, AvgCharWidth, LeftSpace, RightSpace); 1069 1070 if IsRightToLeft then 1071 begin 1072 Dec(ARect.Right, LeftSpace); 1073 Inc(ARect.Left, RightSpace); 1074 end 1075 else 1076 begin 1077 Inc(ARect.Left, LeftSpace); 1078 Dec(ARect.Right, RightSpace); 1079 end; 1080 1081 // Move text up by 1 pixel otherwise it is too low. 1082 Dec(ARect.Top, 1); 1083 Dec(ARect.Bottom, 1); 1084 1085 oldBkMode := SetBkMode(AHDC, TRANSPARENT); 1086 1087 WideBuffer := UTF8ToUTF16(AMenuItem.Caption); 1088 DrawTextW(AHDC, PWideChar(WideBuffer), Length(WideBuffer), @ARect, dtFlags); 1089 1090 1091 if AMenuItem.ShortCut <> scNone then 1092 begin 1093 dtFlags := DT_VCENTER or DT_SINGLELINE; 1094 shortCutText := MenuItemShortCut(AMenuItem); 1095 if IsRightToLeft then 1096 dtFlags := dtFlags or DT_LEFT 1097 else 1098 dtFlags := dtFlags or DT_RIGHT; 1099 1100 WideBuffer := UTF8ToUTF16(shortCutText); 1101 DrawTextW(AHDC, PWideChar(WideBuffer), Length(WideBuffer), @ARect, dtFlags); 1102 1103 end; 1104 1105 SetBkMode(AHDC, oldBkMode); 1106end; 1107 1108procedure DrawMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC; 1109 const ImageRect: TRect; const ASelected: Boolean); 1110var 1111 AEffect: TGraphicsDrawEffect; 1112 AImageList: TCustomImageList; 1113 FreeImageList: Boolean; 1114 AImageIndex, AImagesWidth: Integer; 1115 APPI: longint; 1116begin 1117 AMenuItem.GetImageList(AImageList, AImagesWidth); 1118 if (AImageList = nil) or (AMenuItem.ImageIndex < 0) then // using icon from Bitmap 1119 begin 1120 AImageList := TImageList.Create(nil); 1121 AImageList.Width := AMenuItem.Bitmap.Width; // maybe height to prevent too wide bitmaps? 1122 AImageList.Height := AMenuItem.Bitmap.Height; 1123 if not AMenuItem.Bitmap.Transparent then 1124 AImageIndex := AImageList.AddMasked(AMenuItem.Bitmap, AMenuItem.Bitmap.Canvas.Pixels[0, AImageList.Height-1]) 1125 else 1126 AImageIndex := AImageList.Add(AMenuItem.Bitmap, nil); 1127 FreeImageList := True; 1128 end 1129 else // using icon from ImageList 1130 begin 1131 FreeImageList := False; 1132 AImageIndex := AMenuItem.ImageIndex; 1133 end; 1134 1135 if not AMenuItem.Enabled then 1136 AEffect := gdeDisabled 1137 else 1138 if ASelected then 1139 AEffect := gdeHighlighted 1140 else 1141 AEffect := gdeNormal; 1142 1143 if AImageIndex < AImageList.Count then 1144 begin 1145 APPI := GetDeviceCaps(AHDC, LOGPIXELSX); 1146 TWin32WSCustomImageListResolution.DrawToDC(AImageList.ResolutionForPPI[AImagesWidth, APPI, 1].Resolution, 1147 AImageIndex, AHDC, ImageRect, 1148 AImageList.BkColor, AImageList.BlendColor, 1149 AEffect, AImageList.DrawingStyle, AImageList.ImageType); 1150 end; 1151 if FreeImageList then 1152 AImageList.Free; 1153end; 1154 1155function ItemStateToDrawState(const ItemState: UINT): LCLType.TOwnerDrawState; 1156begin 1157 Result := []; 1158 if ItemState and ODS_SELECTED <> 0 then 1159 Include(Result, LCLType.odSelected); 1160 if ItemState and ODS_GRAYED <> 0 then 1161 Include(Result, LCLType.odGrayed); 1162 if ItemState and ODS_DISABLED <> 0 then 1163 Include(Result, LCLType.odDisabled); 1164 if ItemState and ODS_CHECKED <> 0 then 1165 Include(Result, LCLType.odChecked); 1166 if ItemState and ODS_FOCUS <> 0 then 1167 Include(Result, LCLType.odFocused); 1168 if ItemState and ODS_DEFAULT <> 0 then 1169 Include(Result, LCLType.odDefault); 1170 if ItemState and ODS_HOTLIGHT <> 0 then 1171 Include(Result, LCLType.odHotLight); 1172 if ItemState and ODS_INACTIVE <> 0 then 1173 Include(Result, LCLType.odInactive); 1174 if ItemState and ODS_NOACCEL <> 0 then 1175 Include(Result, LCLType.odNoAccel); 1176 if ItemState and ODS_NOFOCUSRECT <> 0 then 1177 Include(Result, LCLType.odNoFocusRect); 1178 if ItemState and ODS_COMBOBOXEDIT <> 0 then 1179 Include(Result, LCLType.odComboBoxEdit); 1180end; 1181 1182procedure DrawClassicMenuItemIcon(const AMenuItem: TMenuItem; const AHDC: HDC; 1183 const ARect: TRect; const ASelected, AChecked: boolean); 1184var 1185 x: Integer; 1186 Space: Integer = SpaceNextToCheckMark; 1187 ImageRect: TRect; 1188 IconSize: TPoint; 1189 checkMarkWidth: integer; 1190begin 1191 IconSize := AMenuItem.GetIconSize(AHDC); 1192 checkMarkWidth := GetSystemMetrics(SM_CXMENUCHECK); 1193 if not AMenuItem.IsInMenuBar then 1194 begin 1195 if IconSize.x < checkMarkWidth then 1196 begin 1197 // Center the icon horizontally inside check mark space. 1198 Inc(Space, TopPosition(checkMarkWidth, IconSize.x)); 1199 end 1200 else 1201 if IconSize.x > checkMarkWidth then 1202 begin 1203 Space := SpaceNextToIcon; 1204 end; 1205 end; 1206 1207 if AMenuItem.GetIsRightToLeft then 1208 x := ARect.Right - IconSize.x - Space 1209 else 1210 x := ARect.Left + Space; 1211 1212 ImageRect := Rect(x, ARect.top + TopPosition(ARect.Bottom - ARect.Top, IconSize.y), 1213 IconSize.x, IconSize.y); 1214 1215 if AChecked then // draw rectangle around 1216 begin 1217 FrameRect(aHDC, 1218 Rect(ImageRect.Left - 1, ImageRect.Top - 1, ImageRect.Left + ImageRect.Right + 1, ImageRect.Top + ImageRect.Bottom + 1), 1219 GetSysColorBrush(COLOR_HIGHLIGHT)); 1220 end; 1221 1222 DrawMenuItemIcon(AMenuItem, AHDC, ImageRect, ASelected); 1223end; 1224 1225procedure DrawClassicMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; 1226 const ARect: Windows.RECT; const ASelected, ANoAccel: boolean; ItemState: UINT); 1227var 1228 oldFont: HFONT; 1229 newFont: HFONT; 1230 AvgCharWidth: Integer; 1231begin 1232 if AMenuItem.IsLine then 1233 DrawSeparator(AHDC, ARect) 1234 else 1235 begin 1236 if AMenuItem.Default then 1237 newFont := GetMenuItemFont([cfBold]) 1238 else 1239 newFont := GetMenuItemFont([]); 1240 oldFont := SelectObject(AHDC, newFont); 1241 AvgCharWidth := GetAverageCharSize(AHDC).cx; 1242 1243 DrawMenuItemText(AMenuItem, AHDC, ARect, ASelected, ANoAccel, ItemState, AvgCharWidth); 1244 if aMenuItem.HasIcon then 1245 DrawClassicMenuItemIcon(AMenuItem, AHDC, ARect, ASelected, AMenuItem.Checked) 1246 else 1247 if AMenuItem.Checked then 1248 DrawMenuItemCheckMark(AMenuItem, AHDC, ARect, ASelected, AvgCharWidth); 1249 1250 SelectObject(AHDC, oldFont); 1251 DeleteObject(newFont); 1252 end; 1253end; 1254 1255procedure DrawMenuItem(const AMenuItem: TMenuItem; const AHDC: HDC; const ARect: Windows.RECT; const ItemAction, ItemState: UINT); 1256var 1257 ASelected, ANoAccel: Boolean; 1258 B: Bool; 1259 CC: TControlCanvas; 1260 ItemDrawState: LCLType.TOwnerDrawState; 1261begin 1262 ASelected := (ItemState and ODS_SELECTED) <> 0; 1263 ANoAccel := (ItemState and ODS_NOACCEL) <> 0; 1264 if ANoAccel and (WindowsVersion >= wv2000) then 1265 if SystemParametersInfo(SPI_GETKEYBOARDCUES, 0, @B, 0) then 1266 ANoAccel := not B 1267 else 1268 else 1269 ANoAccel := False; 1270 1271 CC := TControlCanvas.Create; 1272 try 1273 CC.Handle := AHDC; 1274 ItemDrawState := ItemStateToDrawState(ItemState); 1275 if not AMenuItem.DrawItem(CC, ARect, ItemDrawState) then 1276 begin 1277 if IsVistaMenu then 1278 begin 1279 if AMenuItem.IsInMenuBar then 1280 DrawVistaMenuBar(AMenuItem, AHDC, ARect, ASelected, ANoAccel, ItemAction, ItemState) 1281 else 1282 DrawVistaPopupMenu(AMenuItem, AHDC, ARect, ASelected, ANoAccel); 1283 end 1284 else 1285 DrawClassicMenuItem(AMenuItem, AHDC, ARect, ASelected, ANoAccel, ItemState); 1286 end; 1287 finally 1288 CC.Free; 1289 end; 1290end; 1291 1292procedure TriggerFormUpdate(const AMenuItem: TMenuItem); 1293var 1294 lMenu: TMenu; 1295begin 1296 lMenu := AMenuItem.GetParentMenu; 1297 if (lMenu<>nil) and (lMenu.Parent<>nil) 1298 and (lMenu.Parent is TCustomForm) 1299 and TCustomForm(lMenu.Parent).HandleAllocated 1300 and not (csDestroying in lMenu.Parent.ComponentState) then 1301 AddToChangedMenus(TCustomForm(lMenu.Parent).Handle); 1302end; 1303 1304function ChangeMenuFlag(const AMenuItem: TMenuItem; Flag: Cardinal; Value: boolean): boolean; 1305var 1306 MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 1307begin 1308 FillChar(MenuInfo, SizeOf(MenuInfo), 0); 1309 MenuInfo.cbSize := sizeof(TMenuItemInfo); 1310 MenuInfo.fMask := MIIM_FTYPE; // don't retrieve caption (MIIM_STRING not included) 1311 GetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1312 if Value then 1313 MenuInfo.fType := MenuInfo.fType or Flag 1314 else 1315 MenuInfo.fType := MenuInfo.fType and (not Flag); 1316 Result := SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1317 TriggerFormUpdate(AMenuItem); 1318end; 1319 1320{------------------------------------------------------------------------------ 1321 Method: SetMenuFlag 1322 Returns: Nothing 1323 1324 Change the menu flags for handle of TMenuItem or TMenu, 1325 added for BidiMode Menus 1326 ------------------------------------------------------------------------------} 1327procedure SetMenuFlag(const Menu: HMenu; Flag: Cardinal; Value: boolean); 1328var 1329 MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 1330begin 1331 FillChar(MenuInfo, SizeOf(MenuInfo), 0); 1332 MenuInfo.cbSize := sizeof(TMenuItemInfo); 1333 MenuInfo.fMask := MIIM_TYPE; //MIIM_FTYPE not work here please use only MIIM_TYPE, caption not retrieved (dwTypeData = nil) 1334 GetMenuItemInfoW(Menu, 0, True, @MenuInfo); 1335 if Value then 1336 MenuInfo.fType := MenuInfo.fType or Flag 1337 else 1338 MenuInfo.fType := MenuInfo.fType and not Flag; 1339 SetMenuItemInfoW(Menu, 0, True, @MenuInfo); 1340end; 1341 1342{ TWin32WSMenuItem } 1343 1344procedure UpdateCaption(const AMenuItem: TMenuItem; ACaption: String); 1345var 1346 MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 1347 WideBuffer: widestring; 1348begin 1349 if (AMenuItem.Parent = nil) or not AMenuItem.Parent.HandleAllocated then 1350 Exit; 1351 1352 FillChar(MenuInfo, SizeOf(MenuInfo), 0); 1353 with MenuInfo do 1354 begin 1355 cbSize := sizeof(TMenuItemInfo); 1356 fMask := MIIM_FTYPE or MIIM_STATE; // don't retrieve current caption 1357 end; 1358 GetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1359 with MenuInfo do 1360 begin 1361 // change enabled too since we can change from '-' to normal caption and vice versa 1362 if ACaption <> cLineCaption then 1363 begin 1364 fType := fType or MIIM_STRING; 1365 fType := fType and not (MFT_SEPARATOR or MFT_OWNERDRAW); 1366 fState := EnabledToStateFlag[AMenuItem.Enabled]; 1367 if AMenuItem.Checked then 1368 fState := fState or MFS_CHECKED; 1369// AMenuItem.Caption := ACaption; // Already set 1370 WideBuffer := UTF8ToUTF16(CompleteMenuItemStringCaption(AMenuItem, ACaption, #9)); 1371 dwTypeData := PChar(WideBuffer); // PWideChar forced to PChar 1372 cch := length(WideBuffer); 1373 1374 fMask := fMask or MIIM_STRING; // caption updated too 1375 end 1376 else 1377 begin 1378 fType := fType and not (MIIM_STRING); 1379 fType := (fType or MFT_SEPARATOR) and not (MFT_OWNERDRAW); 1380 fState := MFS_DISABLED; 1381 end; 1382 end; 1383 SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1384 1385 // MIIM_BITMAP is needed to request new measure item call 1386 with MenuInfo do 1387 begin 1388 fMask := MIIM_BITMAP; 1389 dwTypeData := nil; 1390 end; 1391 SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1392 1393 // set owner drawn 1394 with MenuInfo do 1395 begin 1396 fMask := MIIM_FTYPE; // don't set caption 1397 fType := (fType or MFT_OWNERDRAW) and not (MIIM_STRING or MFT_SEPARATOR); 1398 end; 1399 SetMenuItemInfoW(AMenuItem.Parent.Handle, AMenuItem.Command, False, @MenuInfo); 1400 TriggerFormUpdate(AMenuItem); 1401end; 1402 1403class procedure TWin32WSMenuItem.AttachMenu(const AMenuItem: TMenuItem); 1404var 1405 MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 1406 ParentMenuHandle: HMenu; 1407 ParentOfParent: HMenu; 1408 CallMenuRes: Boolean; 1409 WideBuffer: widestring; 1410begin 1411 ParentMenuHandle := AMenuItem.Parent.Handle; 1412 FillChar(MenuInfo, SizeOf(MenuInfo), 0); 1413 MenuInfo.cbSize := sizeof(TMenuItemInfo); 1414 1415 // Following part fixes the case when an item is added in runtime 1416 // but the parent item has not defined the submenu flag (hSubmenu=0) 1417 if AMenuItem.Parent.Parent <> nil then 1418 begin 1419 ParentOfParent := AMenuItem.Parent.Parent.Handle; 1420 MenuInfo.fMask := MIIM_SUBMENU; 1421 CallMenuRes := GetMenuItemInfoW(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo); 1422 if CallMenuRes then 1423 begin 1424 // the parent menu item is not defined with submenu flag 1425 // convert it to submenu 1426 if MenuInfo.hSubmenu = 0 then 1427 begin 1428 MenuInfo.hSubmenu := ParentMenuHandle; 1429 CallMenuRes := SetMenuItemInfoW(ParentOfParent, AMenuItem.Parent.Command, False, @MenuInfo); 1430 if not CallMenuRes then 1431 DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]); 1432 end; 1433 end; 1434 end; 1435 1436 with MenuInfo do 1437 begin 1438 if AMenuItem.Enabled then 1439 fState := MFS_ENABLED 1440 else 1441 fstate := MFS_GRAYED; 1442 if AMenuItem.Checked then 1443 fState := fState or MFS_CHECKED; 1444 fMask := MIIM_ID or MIIM_DATA or MIIM_STATE or MIIM_FTYPE or MIIM_STRING; 1445 wID := AMenuItem.Command; {value may only be 16 bit wide!} 1446 dwItemData := PtrInt(AMenuItem); 1447 if (AMenuItem.Count > 0) then 1448 begin 1449 fMask := fMask or MIIM_SUBMENU; 1450 hSubMenu := AMenuItem.Handle; 1451 end else 1452 hSubMenu := 0; 1453 fType := MFT_OWNERDRAW; 1454 if AMenuItem.IsLine then 1455 begin 1456 fType := fType or MFT_SEPARATOR; 1457 fState := fState or MFS_DISABLED; 1458 end; 1459 WideBuffer := UTF8ToUTF16(CompleteMenuItemCaption(AMenuItem, #9)); 1460 dwTypeData := PChar(WideBuffer); // PWideChar forced to PChar 1461 cch := length(WideBuffer); 1462 1463 if AMenuItem.RadioItem then 1464 fType := fType or MFT_RADIOCHECK; 1465 if (AMenuItem.GetIsRightToLeft) then 1466 begin 1467 fType := fType or MFT_RIGHTORDER; 1468 //Reverse the RIGHTJUSTIFY to be left 1469 if not AMenuItem.RightJustify then 1470 fType := fType or MFT_RIGHTJUSTIFY; 1471 end 1472 else 1473 if AMenuItem.RightJustify then 1474 fType := fType or MFT_RIGHTJUSTIFY; 1475 if AMenuItem.Default then 1476 fState := fState or MFS_DEFAULT; 1477 end; 1478 CallMenuRes := InsertMenuItemW(ParentMenuHandle, AMenuItem.Parent.VisibleIndexOf(AMenuItem), True, @MenuInfo); 1479 if not CallMenuRes then 1480 DebugLn(['InsertMenuItem failed with error: ', GetLastErrorReport]); 1481 TriggerFormUpdate(AMenuItem); 1482end; 1483 1484class function TWin32WSMenuItem.CreateHandle(const AMenuItem: TMenuItem): HMENU; 1485begin 1486 Result := CreatePopupMenu; 1487end; 1488 1489class procedure TWin32WSMenuItem.DestroyHandle(const AMenuItem: TMenuItem); 1490var 1491 ParentOfParentHandle, ParentHandle: HMENU; 1492 MenuInfo: MENUITEMINFO; // TMenuItemInfoA and TMenuItemInfoW have same size and same structure type 1493 CallMenuRes: Boolean; 1494begin 1495 if Assigned(AMenuItem.Parent) then 1496 begin 1497 ParentHandle := AMenuItem.Parent.Handle; 1498 RemoveMenu(ParentHandle, AMenuItem.Command, MF_BYCOMMAND); 1499 // convert submenu to a simple menu item if needed 1500 if (GetMenuItemCount(ParentHandle) = 0) and Assigned(AMenuItem.Parent.Parent) and 1501 AMenuItem.Parent.Parent.HandleAllocated then 1502 begin 1503 ParentOfParentHandle := AMenuItem.Parent.Parent.Handle; 1504 FillChar(MenuInfo, SizeOf(MenuInfo), 0); 1505 with MenuInfo do 1506 begin 1507 cbSize := sizeof(TMenuItemInfo); 1508 fMask := MIIM_SUBMENU; 1509 end; 1510 GetMenuItemInfoW(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo); 1511 // the parent menu item is defined with submenu flag then reset it 1512 if MenuInfo.hSubmenu <> 0 then 1513 begin 1514 MenuInfo.hSubmenu := 0; 1515 CallMenuRes := SetMenuItemInfoW(ParentOfParentHandle, AMenuItem.Parent.Command, False, @MenuInfo); 1516 if not CallMenuRes then 1517 DebugLn(['SetMenuItemInfo failed: ', GetLastErrorReport]); 1518 // Set menu item info destroys/corrupts our internal popup menu for the 1519 // unknown reason. We need to recreate it. 1520 if not IsMenu(ParentHandle) then 1521 begin 1522 ParentHandle := CreatePopupMenu; 1523 AMenuItem.Parent.Handle := ParentHandle; 1524 end; 1525 end; 1526 end; 1527 end; 1528 DestroyMenu(AMenuItem.Handle); 1529 TriggerFormUpdate(AMenuItem); 1530end; 1531 1532class procedure TWin32WSMenuItem.SetCaption(const AMenuItem: TMenuItem; const ACaption: string); 1533begin 1534 UpdateCaption(AMenuItem, aCaption); 1535end; 1536 1537class function TWin32WSMenuItem.SetCheck(const AMenuItem: TMenuItem; const Checked: boolean): boolean; 1538begin 1539 UpdateCaption(AMenuItem, aMenuItem.Caption); 1540 Result := Checked; 1541end; 1542 1543class procedure TWin32WSMenuItem.SetShortCut(const AMenuItem: TMenuItem; const ShortCutK1, ShortCutK2: TShortCut); 1544begin 1545 UpdateCaption(AMenuItem, aMenuItem.Caption); 1546end; 1547 1548class function TWin32WSMenuItem.SetEnable(const AMenuItem: TMenuItem; const Enabled: boolean): boolean; 1549var 1550 EnableFlag: DWord; 1551begin 1552 EnableFlag := MF_BYCOMMAND or EnabledToStateFlag[Enabled]; 1553 Result := Boolean(Windows.EnableMenuItem(AMenuItem.Parent.Handle, AMenuItem.Command, EnableFlag)); 1554 TriggerFormUpdate(AMenuItem); 1555end; 1556 1557class function TWin32WSMenuItem.SetRightJustify(const AMenuItem: TMenuItem; const Justified: boolean): boolean; 1558begin 1559 Result := ChangeMenuFlag(AMenuItem, MFT_RIGHTJUSTIFY, Justified); 1560end; 1561 1562class procedure TWin32WSMenuItem.UpdateMenuIcon(const AMenuItem: TMenuItem; 1563 const HasIcon: Boolean; const AIcon: Graphics.TBitmap); 1564begin 1565 UpdateCaption(AMenuItem, aMenuItem.Caption); 1566end; 1567 1568{ TWin32WSMenu } 1569 1570class function TWin32WSMenu.CreateHandle(const AMenu: TMenu): HMENU; 1571begin 1572 Result := CreateMenu; 1573end; 1574 1575class procedure TWin32WSMenu.SetBiDiMode(const AMenu : TMenu; 1576 UseRightToLeftAlign, UseRightToLeftReading: Boolean); 1577begin 1578 if not WSCheckHandleAllocated(AMenu, 'SetBiDiMode') 1579 then Exit; 1580 1581 SetMenuFlag(AMenu.Handle, MFT_RIGHTORDER or MFT_RIGHTJUSTIFY, AMenu.IsRightToLeft); 1582 1583 //TriggerFormUpdate not take TMenu, we repeate the code 1584 if not (AMenu.Parent is TCustomForm) then Exit; 1585 if not TCustomForm(AMenu.Parent).HandleAllocated then Exit; 1586 if csDestroying in AMenu.Parent.ComponentState then Exit; 1587 1588 AddToChangedMenus((AMenu.Parent as TCustomForm).Handle); 1589end; 1590 1591 1592{ TWin32WSPopupMenu } 1593 1594class function TWin32WSPopupMenu.CreateHandle(const AMenu: TMenu): HMENU; 1595begin 1596 Result := CreatePopupMenu; 1597end; 1598 1599class procedure TWin32WSPopupMenu.Popup(const APopupMenu: TPopupMenu; const X, Y: integer); 1600var 1601 MenuHandle: HMENU; 1602 WinHandle: HWND; 1603const 1604 lAlignment: array[TPopupAlignment, Boolean] of DWORD = ( 1605 { left-to-rght } { right-to-left } 1606 { paLeft } (TPM_LEFTALIGN, TPM_RIGHTALIGN or TPM_LAYOUTRTL), 1607 { paRight } (TPM_RIGHTALIGN, TPM_LEFTALIGN or TPM_LAYOUTRTL), 1608 { paCenter } (TPM_CENTERALIGN, TPM_CENTERALIGN or TPM_LAYOUTRTL) 1609 ); 1610 lTrackButtons: array[TTrackButton] of DWORD = ( 1611 { tbRightButton } TPM_RIGHTBUTTON, 1612 { tbLeftButton } TPM_LEFTBUTTON 1613 ); 1614begin 1615 MenuHandle := APopupMenu.Handle; 1616 WinHandle:=Win32WidgetSet.AppHandle; 1617 if (WinHandle=0) and (Screen.ActiveCustomForm<>nil) and Screen.ActiveCustomForm.HandleAllocated then 1618 WinHandle:=Screen.ActiveCustomForm.Handle; 1619 GetWin32WindowInfo(WinHandle)^.PopupMenu := APopupMenu; 1620 TrackPopupMenuEx(MenuHandle, 1621 lAlignment[APopupMenu.Alignment, APopupMenu.IsRightToLeft] or lTrackButtons[APopupMenu.TrackButton], 1622 X, Y, WinHandle, nil); 1623end; 1624 1625end. 1626