GetWindowMenuItemRect example

Project1.dpr

program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Unit1.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 186
  ClientWidth = 391
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  Menu = MainMenu1
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 268
    Top = 16
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object MainMenu1: TMainMenu
    Left = 32
    Top = 8
    object MenuItem11: TMenuItem
      Caption = 'MenuItem1'
      object MenuItem41: TMenuItem
        Caption = 'MenuItem4'
      end
      object MenuItem51: TMenuItem
        Caption = 'MenuItem5'
      end
      object MenuItem61: TMenuItem
        Caption = 'MenuItem6'
      end
    end
    object MenuItem21: TMenuItem
      Caption = 'MenuItem2'
      object MenuItem71: TMenuItem
        Caption = 'MenuItem7'
      end
      object MenuItem81: TMenuItem
        Caption = 'MenuItem8'
      end
      object MenuItem91: TMenuItem
        Caption = 'MenuItem9'
      end
    end
    object MenuItem31: TMenuItem
      Caption = 'MenuItem3'
      object MenuItem101: TMenuItem
        Caption = 'MenuItem10'
      end
      object MenuItem111: TMenuItem
        Caption = 'MenuItem11'
      end
      object MenuItem121: TMenuItem
        Caption = 'MenuItem12'
      end
    end
  end
end

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Button1: TButton;
    MenuItem11: TMenuItem;
    MenuItem21: TMenuItem;
    MenuItem31: TMenuItem;
    MenuItem41: TMenuItem;
    MenuItem51: TMenuItem;
    MenuItem61: TMenuItem;
    MenuItem71: TMenuItem;
    MenuItem81: TMenuItem;
    MenuItem91: TMenuItem;
    MenuItem101: TMenuItem;
    MenuItem111: TMenuItem;
    MenuItem121: TMenuItem;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  {$A8} // default quadword-alignment
  PMenuBarInfo = ^TMenuBarInfo;
  tagMENUBARINFO = record
    cbSize: DWORD;
    rcBar: TRect;
    hMenu: HMENU;
    hwndMenu: HWND;
    { fBarFocused:1: BOOL;} { bar, popup has the focus }
    { fFocused:1: BOOL; }  { item has the focus }
    FocusedBits: BYTE;
  end;
  TMenuBarInfo = tagMENUBARINFO;

function GetMenuBarInfo(hend: HWND; idObject, idItem: Longint;
  var pmbi: TMenuBarInfo): BOOL; stdcall; external user32 name 'GetMenuBarInfo';

function GetWindowMenuItemRect(Handle: THandle; Index: Integer): TRect;
var
  Info: TMenuBarInfo;
begin
  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(Info);
  Win32Check(GetMenuBarInfo(Handle, $FFFFFFFD, Index, Info));
  Result := Info.rcBar;
end;

function GetScreenCanvas: TCanvas;
begin
  Result := TCanvas.Create;
  try
    Result.Handle := GetDC(0);
    Result.Pen.Style := psSolid;
    Result.Pen.Color := clRed;
    Result.Brush.Style := bsClear;
  except
    Result.Free;
    raise;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  C: TCanvas;
  I: Integer;
begin
  C := GetScreenCanvas;
  try
    for I := 0 to MainMenu1.Items.Count - 1 do
      C.Rectangle(GetWindowMenuItemRect(Handle, I + 1));
  finally
    C.Free;
  end;
end;

end.