关于Delphi自绘菜单,有一个菜单项就得DrawItem和MeasureItem各一次要有几十不精神病?

冥界3大法王

如下面源码所示，有一个菜单项就得DrawItem和MeasureItem各一次，要有几十个呢，不得神经病了？

[Delphi] 纯文本查看 复制代码

unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus;

type
  TForm4 = class(TForm)
    MainMenu1: TMainMenu;
    MenuItem11: TMenuItem;
    MenuItem12: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N1111: TMenuItem;
    N31: TMenuItem;
    N3331: TMenuItem;
    C1: TMenuItem;
    reffind0x1ECtrlShiftAltR1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    procedure MenuItem11DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure MenuItem11MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure reffind0x1ECtrlShiftAltR1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure reffind0x1ECtrlShiftAltR1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure N11DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
    procedure N11MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.FormCreate(Sender: TObject);
begin
  MainMenu1.OwnerDraw := True;
  PopupMenu1.OwnerDraw := True;
end;

procedure TForm4.MenuItem11DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
  ACanvas.FillRect(ARect);
  ACanvas.Font.Size := 12;                                                     //设置为足够大的字号
  ACanvas.Font.Name := '微软雅黑';                                             //设置为你喜欢的字体
  ACanvas.TextOut(ARect.Left, ARect.Top, (Sender as TMenuItem).Caption);       //输出菜单项
end;

procedure TForm4.MenuItem11MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
  Height := 40;   //设置为足够高以容纳你的菜单项
  Width := 750;   //设置为足够宽以容纳你的菜单项
end;

procedure TForm4.N11DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
  ACanvas.FillRect(ARect);
  ACanvas.Font.Size := 12;
  ACanvas.Font.Name := '微软雅黑';
  ACanvas.TextOut(ARect.Left, ARect.Top, (Sender as TMenuItem).Caption);
end;

procedure TForm4.N11MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
  Height := 40;   //设置为足够高以容纳你的菜单项
  Width := 750;   //设置为足够宽以容纳你的菜单项
end;

procedure TForm4.reffind0x1ECtrlShiftAltR1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
begin
  ACanvas.FillRect(ARect);
  ACanvas.Font.Size := 12;                                                     //设置为足够大的字号
  ACanvas.Font.Name := '微软雅黑';                                             //设置为你喜欢的字体
  ACanvas.TextOut(ARect.Left, ARect.Top, (Sender as TMenuItem).Caption);
end;

procedure TForm4.reffind0x1ECtrlShiftAltR1MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer);
begin
  Height := 40;   //设置为足够高以容纳你的菜单项
  Width := 650;   //设置为足够宽以容纳你的菜单项
end;

end.

harlanchou

可以用代码给各个MenuItem的事件赋值。

冥界3大法王

harlanchou 发表于 2024-10-30 09:23
可以用代码给各个MenuItem的事件赋值。

问题2 ，变成DLL之后，在QT程序里调用，就完全没有效果了呢？

yigaosoft

原来一直在用Delphi，现在感觉用易语言还是比较方便一些

冥界3大法王

yigaosoft 发表于 2024-10-30 15:49
原来一直在用Delphi，现在感觉用易语言还是比较方便一些

上次天津电视台出来个非你莫属找工作的节目。。。一问用啥修图工具。。。美图秀秀。。。全场静默。。
全国计算机二级考试里当年出来过Delphi，唯独没听说过有易语言。。

harlanchou

冥界3大法王 发表于 2024-10-30 09:33
问题2 ，变成DLL之后，在QT程序里调用，就完全没有效果了呢？

你是说QT调用delphi DLL里的画面，Menu自绘效果出不来？还是？？？

冥界3大法王

harlanchou 发表于 2024-10-31 11:53
你是说QT调用delphi DLL里的画面，Menu自绘效果出不来？还是？？？

是的，菜单字体变大 效果没有了。。

川小波

可能是Qt绘制系统影响的