关于Delphi自绘菜单,有一个菜单项就得DrawItem和MeasureItem各一次要有几十不精神病?
本帖最后由 冥界3大法王 于 2024-10-30 09:23 编辑如下面源码所示，有一个菜单项就得DrawItem和MeasureItem各一次，要有几十个呢，不得神经病了？
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.
可以用代码给各个MenuItem的事件赋值。 harlanchou 发表于 2024-10-30 09:23
可以用代码给各个MenuItem的事件赋值。
问题2 ，变成DLL之后，在QT程序里调用，就完全没有效果了呢？ 原来一直在用Delphi，现在感觉用易语言还是比较方便一些 yigaosoft 发表于 2024-10-30 15:49
原来一直在用Delphi，现在感觉用易语言还是比较方便一些上次天津电视台出来个非你莫属找工作的节目。。。一问用啥修图工具。。。美图秀秀。。。全场静默。。
全国计算机二级考试里当年出来过Delphi，唯独没听说过有易语言。。 冥界3大法王 发表于 2024-10-30 09:33
问题2 ，变成DLL之后，在QT程序里调用，就完全没有效果了呢？
你是说QT调用delphi DLL里的画面，Menu自绘效果出不来？还是？？？ harlanchou 发表于 2024-10-31 11:53
你是说QT调用delphi DLL里的画面，Menu自绘效果出不来？还是？？？
是的，菜单字体变大 效果没有了。。 可能是Qt绘制系统影响的
页:
[1]