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