DELPHI的奇异菜单的编写

翻译者: 李均宇 email: e271828@163.net,okMyDelphi@163.net

Custom Menus, Text, Lines / Delphi 4, 5

自定义菜单,文本,线/ Delphi 4, 5

Fancy Menus, etc.

奇异菜单,等等

Custom Menus, Rotated Text, and Special Lines

自定义菜单,旋转文本,和特殊的线条

Before Delphi 4, it was difficult to customize a menu (add a bitmap, change a font, etc.), because owner drawing (i.e. custom drawing) - although implemented by Windows - was not exposed by the TMainMenu class. Since Delphi 4, however, this situation has been rectified, and we can have our way with menus.

在Delphi 4之前,要想自定义一个菜单是困难的(例如加上一个BMP图像,改变字体等),因为owner drawing事件(也就是custom drawing事件)-虽然是由Windows来执行,但是却并不在TMainMenu class中出现.自从Delphi 4开始后,

这种情况有了改变,我们于是有了可以自定义菜单的功能了.

This article will highlight some techniques you can use to customize the appearance of menus in your Delphi applications. We'll discuss text placement, menu sizing, font assignment, and using bitmaps and shapes to enhance a menu's appearance. Just for fun, this article also features techniques for creating rotated text and custom lines. All of the techniques discussed in this article are demonstrated in projects available for download。

这篇文章将主要着重论述可以用来自定义你的DELPHI应用程序中的菜单的外形的一些技术巧.我们将论述文本的放置，菜单的大小，字体的设置，以及用BMP文件和SHAPE控件来加强菜单的显示效果。仅仅出于娱乐的目的，这篇文章也将对旋转的文本和自定义线条的技巧进行特写。这篇文章所论述到的所有技巧都已在工程文件中通过了调试并且可以到网上下载这些工程文件。

Custom Fonts and Sizes

设置字体和大小

To create a custom menu, set the OwnerDraw property of the menu component -TMainMenu or TPopupMenu - to True, and provide event handlers for its OnDrawItem and OnMeasureItem events. For example, an OnMeasureItem event handler is declared like this:

为了创建一个自定义的菜单，将TmainMenu或TpopupMenu组件的OwnerDraw属性设为TRUE，并且创建它的OnDrawItem和OnMeasureItem的事件过程。例如，一个OnMeasureItem事件过程可以声明如下：

procedure TForm1.Option1MeasureItem(Sender: TObject;

ACanvas: TCanvas; var Width, Height: Integer);

Set the Width and Height variables to adjust the size of the menu item. The OnDrawItem event handler is where all the hard work is done; it's where you draw your menu and make any special settings. To draw the menu option with Times New Roman font, for example, you should do something like this:

设置上面事件过程中的菜单项的Width 和Height变量到合适的大小.所有主要的事情都要由OnDrawItem事件来触发；它是你要重画菜单和作任何特殊设置的地方。举例，为了用Times New Roman字体来重画菜单项，你可以如下面这样做：

procedure TForm1.Times1DrawItem(Sender: TObject;

ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

begin

ACanvas.Font.Name := 'Times New Roman';

ACanvas.TextOut(ARect.Left+1, ARect.Top+1,

(Sender as TMenuItem).Caption);

end;

This code is flawed, however. If it's run, the menu caption will be drawn aligned with the left border of the menu. This isn't default Windows behavior; usually, there's a space to put bitmaps and checkmarks in the menu. Therefore, you should calculate the space needed for this checkmark with code like that shown in Figure 1. Figure 2 shows the resulting menu.

然而这段代码是有缺陷的。如果运行这段代码，菜单项的标题（caption）会在菜单项中靠左对齐.这并不是Windows的默认行为，通常，在菜单左边那儿有一个空间用来放置BMP图像和选择标志的。因此，你应该用代码计算要多少空间来放置这个选择标志的，就象Figure 1中显示的那样。Figure 2显示的是菜单的运行效果。

procedure TForm1.Times2DrawItem(Sender: TObject;

ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

var

dwCheck : Integer;

MenuCaption : string;

begin

// Get the checkmark dimensions.

获取选择标志所需的像素数

dwCheck := GetSystemMetrics(SM_CXMENUCHECK);

// Adjust left position.

调整左边位置

ARect.Left := ARect.Left + LoWord(dwCheck) + 1;

MenuCaption := (Sender as TMenuItem).Caption;

// The font name is the menu caption.

ACanvas.Font.Name := 'Times New Roman';

// Draw the text.

画文本

DrawText(ACanvas.Handle, PChar(MenuCaption),

Length(MenuCaption), ARect, 0);

end;

Figure 1: This OnDrawItem event handler places menu item text correctly.

[译者省略掉所有的FigureS，以下同样]

Figure 2: A menu drawn with custom fonts.

If the text is too large to be drawn in the menu, Windows will cut it to fit. Therefore, you should set the menu item size so all the text can be drawn. This is the role of the OnMeasureItem event handler shown in Figure 3.

如果文本太长，Windows会自动裁剪长度来合适。因此，你应该设置菜单大小使所有的文本都可以显示出来。在OnMeasureItem事件中也应如此，这在Figure 3可以看到。

procedure TForm1.Times2MeasureItem(Sender: TObject;

ACanvas: TCanvas; var Width, Height: Integer);

begin

ACanvas.Font.Name := 'Times New Roman';

ACanvas.Font.Style := [];

// The width is the space of the menu check

这个长度是菜单的选择标志的长度

// plus the width of the item text.

再加上菜单项的长度

Width := GetSystemMetrics(SM_CXMENUCHECK) +

ACanvas.TextWidth((Sender as TMenuItem).Caption) + 2;

Height := ACanvas.TextHeight(

(Sender as TMenuItem).Caption) + 2;

end;

Figure 3: This OnMeasureItem event handler insures that an item fits in its menu.

Custom Shapes and Bitmaps

设置图形和位图

It's also possible to customize menu items by including bitmaps or other shapes. To add a bitmap, simply assign a bitmap file to the TMenuItem.Bitmap property - with the Object Inspector at design time, or with code at run time. To draw colored rectangles as the caption of a menu item, you could use the OnDrawItem event handler shown in Figure 4. Figure 5 shows the result.

用位图和其它图形来设置菜单是可能的事.要想添加一个位图，只需在设计时简单地在Object Inspector中把一个BMP文件赋给TmenuItem的Bitmap属性即可，或者运行时用代码赋值也可以。要想用一个有颜色的矩形来代替菜单标题，你可以使用OnDrawItem事件，例如在Figure 4中显示的那样。在Figure 5中显示的是结果。

procedure TForm1.ColorDrawItem(Sender: TObject;

ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

var

dwCheck : Integer;

MenuColor : TColor;

begin

// Get the checkmark dimensions.

dwCheck := GetSystemMetrics(SM_CXMENUCHECK);

ARect.Left := ARect.Left + LoWord(dwCheck);

// Convert the caption of the menu item to a color.

将菜单项的标题转换为颜色

MenuColor :=

StringToColor((Sender as TMenuItem).Caption);

// Change the canvas brush color.

改变画布canvas的画笔颜色

ACanvas.Brush.Color := MenuColor;

// Draws the rectangle. If the item is selected,

画矩形，如果菜单项是被选择的

// draw a border.

画边框

if Selected then

ACanvas.Pen.Style := psSolid

else

ACanvas.Pen.Style := psClear;

ACanvas.Rectangle(ARect.Left, ARect.Top,

ARect.Right, ARect.Bottom);

end;

Figure 4: Using the OnDrawItem event to draw colored rectangles on menu items.

Figure 5: A menu featuring colored rectangles as items.

There's just one catch. If you're using Delphi 5, you must set the menu's AutoHotkeys property to maManual. If you leave it as the default, maAutomatic, Delphi will add an ampersand character (&) to the caption, which will break this code. Another solution is to remove the ampersand with the StripHotKey function.

比较流行的做法是，如果你用的是Delphi 5，你应设置菜单的AutoHotkeys属性为maManual。如果你不这样做，而让缺省值maAutomatic留着，Delphi会自动添加一个&号给标题，这将破坏这些代码。另一个解决办法是用StripHotKey函数来移去&号。

Another way to use the OnDrawItem and OnMeasureItem events is to write text vertically on a menu (as shown in Figure 7). To do this, you must create a rotated font. This is only possible using the Windows API function CreateFont or CreateLogFont (see the "Rotated Text" tip later in this article). Then you must draw it in the OnDrawItem event handler. This event is fired every time a menu item is drawn, so if a menu has 20 items, it will be drawn 20 times. To make it faster, the vertical text will be drawn only when the menu item is selected (since there's is only one menu item selected at a time). Figure 6 shows how this is implemented with code, and Figure 7 shows the run-time result.

OnDrawItem和OnMeasureItem事件的另一个用途是用来在菜单侧旁写垂直的文字（例如在Figure 7显示的那样）。为了做到这样，你必须创建一个旋转的字体。唯一办法是用Windows API的CreateFont或者CreateLogFont函数（稍后看本文中的“旋转的文字”技巧）。于是你必须在OnDrawItem事件中重画它。这个事件在菜单项被拉出时执行，所以如果一个菜单有20项，那么它将被执行20次。为了使它快些，这垂直的文字可以在菜单项被选择时才重画一次（虽然每次只有一个菜单项被选择）。Figure 6显示的是代码如何执行，而Figure 7显示的是运行结果。

procedure TForm1.VerticalDrawItem(Sender: TObject;

ACanvas: TCanvas; ARect: TRect; Selected: Boolean);

var

lf : TLogFont;

OldFont : HFont;

clFore, clBack : LongInt;

Rectang : TRect;

dwCheck : LongInt;

MenuHeight : Integer;

begin

dwCheck := GetSystemMetrics(SM_CXMENUCHECK);

// This will be done once, when the item is selected.

当菜单项被选中时，这将被执行

if Selected then begin

// Create a rotated font.

创建一个旋转的字体

FillChar(lf, SizeOf(lf), 0);

lf.lfHeight := -14;

lf.lfEscapement := 900;

lf.lfOrientation := 900;

lf.lfWeight := Fw_Bold;

StrPCopy(lf.lfFaceName, 'Arial');

// Select this font to draw.

选取这个字体来画

OldFont := SelectObject(ACanvas.Handle,

CreateFontIndirect(lf));

// Change foreground and background colors.

改变前景色和背景色

clFore := SetTextColor(ACanvas.Handle, clSilver);

clBack := SetBkColor(ACanvas.Handle, clBlack);

// Get the menu height.

获取菜单高度

MenuHeight := (ARect.Bottom-ARect.Top) *

((Sender as TMenuItem).Parent as TMenuItem).Count;

Rectang := Rect(-1, 0, dwCheck-1, MenuHeight);

// Draw the text.

画文本

ExtTextOut(ACanvas.Handle, -1, MenuHeight, Eto_Clipped,

@Rectang, 'Made in Borland', 15, nil);

// Returns to the original state.

返回到最初状态

DeleteObject(SelectObject(ACanvas.Handle, OldFont));

SetTextColor(ACanvas.Handle, clFore);

SetBkColor(ACanvas.Handle, clBack);

end;

// Draw the real menu text.

画真实的菜单项文本

ARect.Left := ARect.Left + LoWord(dwCheck) + 2;

DrawText(ACanvas.Handle,

PChar((Sender as TMenuItem).Caption),

Length((Sender as TMenuItem).Caption), ARect, 0);

end;

Figure 6: Using OnDrawItem to draw vertical text on a menu.

Figure 7: Menu with vertical text.

One tricky detail is knowing where to begin drawing the text. It should begin at the bottom of the last item on the menu. To get its position, we get the height of the menu item, using:

从哪儿开始画文本是应该知道的。它应该在菜单的最后一项的底部开始。为了得到这个位置，我们如下这样要获取菜单项的高度：

ARect.Top - ARect.Bottom

and multiply it by the number of items in the menu:

并且乘上菜单项的数目：

(((Sender as TMenuItem).Parent as TMenuItem).Count)

Rotated Text

旋转的文本

The Windows API allows you to draw text at any angle. To do this in Delphi, you must use the API function CreateFont or CreateFontIndirect. CreateFont is declared as shown in Figure 8.

Windows API可以让你用任何角度来画文本。为了在Delphi中做到这点，你必须用到CreateFont或者CreateFontIndirect这两个API函数。Figure 8显示了如何声明CreateFont。

function CreateFont(

nHeight, // Logical height of font. 字体的逻辑高度

nWidth, // Logical average character width. 字符的逻辑平均宽度

nEscapement, // Angle of escapement. 旋转的角度

nOrientation, // Base-line orientation angle. 底线的定位角度

fnWeight: Integer; // Font weight. 字体的weight子属性

fdwItalic, // Italic attribute flag. 是否斜体

fdwUnderline, // Underline attribute flag. 是否下划线

fdwStrikeOut, // Strikeout attribute flag. 是否Strikeout属性

fdwCharSet // Character set identifier. 字符集

fdwOutputPrecision, // Output precision.

fdwClipPrecision, // Clipping precision.

fdwQuality, // Output quality.

fdwPitchAndFamily: DWORD; // Pitch and family.

lpszFace: PChar // Pointer to typeface name string.

): HFONT; stdcall;

Figure 8: The Object Pascal declaration for the CreateFont Windows API function.

While this function has many parameters, you will usually want only to change one or two attributes of the text. In such cases, you should use the CreateFontIndirect function instead. It takes only one argument - a record of type TLogFont, as shown in Figure 9.

虽然这函数有很多参数,但你通常只须改变文本的一个或两个属性。在这种情形下，你将使用CreateFontIndirect函数来代替。它只须一个参数----一个TlogFont的记录类型的参数，在Figure 9可以看到。

tagLOGFONTA = packed record

lfHeight: Longint;

lfWidth: Longint;

lfEscapement: Longint;

lfOrientation: Longint;

lfWeight: Longint;

lfItalic: Byte;

lfUnderline: Byte;

lfStrikeOut: Byte;

lfCharSet: Byte;

lfOutPrecision: Byte;

lfClipPrecision: Byte;

lfQuality: Byte;

lfPitchAndFamily: Byte;

lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;

end;

TLogFontA = tagLOGFONTA;

TLogFont = TLogFontA;

Figure 9: The TLogFont record.

Looking at this record, you'll notice its members match the parameters for the CreateFont function. The advantage of using this function/record combination is that you can fill the record's members with a known font using the GetObject API function, change the members you want, and create the new font.

仔细看下这个记录类型，你会发现它的成员与CreateFont函数的参数十分相似。使用这个函数/记录的联合体的好处是，你可以用GetObject这个API函数来将一个已知的字体来填满这个记录的成员值，然后改变你想改变的成员值来产生一个新字体。

To draw rotated text, the only member you must change is lfEscapement, which sets the text angle in tenths of degrees. So, if you want text drawn at 45 degrees, you must set lfEscapement to 450.

为了画出旋转的文字，你仅仅只须改变的成员值是lfEscapement，它可以用十分之一度的单位来设置字体的角度。所以，如果你想字符旋转45度，你必须设置

lfEscapement为450。

Notice that there are flags to draw italic, underline, and strikeout text, but there is no flag to draw bold text. This is done with the lfWeight member, a number between 0 and 1000. 400 is normal text, values above this draw bold text, and values below it draw light text.

注意到这里有不少标记来选取斜体，下划线，凸出文字，但是却没有标记来画粗体。这是因为用lfWeight成员来代替了，这个成员的数值介于0与1000之间。400是正常值，高于这个值的是粗体，低于这个值的是细体。

The code in Figure 10 draws text at angles ranging from 0 degrees to 360 degrees, at 20-degree intervals. It's the form's OnPaint event handler, so the text is redrawn each time the form is painted. Figure 11 shows the result.

Figure 10中的代码从0度到360度每隔20度就画一次字符。这是在窗体的OnPaint事件中触发的，所以文字在窗体每次描绘时重画。在Figure 11可以看到效果。

procedure TForm1.FormPaint(Sender: TObject);

var

OldFont, NewFont : hFont;

LogFont : TLogFont;

i : Integer;

begin

// Get handle of canvas font.

获取窗体字体对象的句柄

OldFont := Canvas.Font.Handle;

i := 0;

// Transparent drawing.

设置透明属性

SetBkMode(Canvas.Handle, Transparent);

// Fill LogFont structure with information

用信息填写LogFont结构

// from current font.

从当前字体

GetObject(OldFont, Sizeof(LogFont), @LogFont);

// Angles range from 0 to 360.

从0到360度

while i < 3600 do begin

// Set escapement to new angle.

设置文字方向到新的角度

LogFont.lfEscapement := i;

// Create new font.

创建新字体

NewFont := CreateFontIndirect(LogFont);

// Select the font to draw.

选取字体来输出

SelectObject(Canvas.Handle, NewFont);

// Draw text at the middle of the form.

在窗体中间输出文字

TextOut(Canvas.Handle, ClientWidth div 2,

ClientHeight div 2, 'Rotated Text', 21);

// Clean up.

清空

DeleteObject(SelectObject(Canvas.Handle, OldFont));

// Increment angle by 20 degrees.

每隔20度递增

Inc(i, 200);

end;

Figure 10: Code to draw text rotated in 20-degree intervals.

Figure 11: Text rotated 360 degrees.

The form's font is set to Arial, a TrueType font. This code works only with TrueType fonts; other kinds of fonts don't support text rotation. To get current font settings and fill the TLogFont structure, you must use the GetObject API function. The code in Figure 12 shows how to fill and display the TLogFont settings for the form's font.

这个窗体的字体设置成Arial，一种TrueType字体。这段代码仅仅在TrueType字体下才能运行；其它字体不支持文字旋转。为了获取当前字体设置和填写TlogFont结构体，你必须用到GetObject这个API函数。在Figure 12中的代码中可以看到如何填写和显示窗体中TlogFont的设置。

procedure TForm1.Info1Click(Sender: TObject);

var

LogFont : TLogFont;

begin

// Fill LogFont structure with information

填写LogFont结构体的成员值

// from current font.

从当前字体

GetObject(Canvas.Font.Handle, Sizeof(LogFont), @LogFont);

// Display font information.

显示字体信息

with LogFont do ShowMessage(

'lfHeight: ' + IntToStr(lfHeight) + #13 +

'lfWidth: ' + IntToStr(lfWidth) + #13 +

'lfEscapement: '+IntToStr(lfEscapement) + #13 +

'lfOrientation: ' + IntToStr(lfOrientation) + #13 +

'lfWeight: ' + IntToStr(lfWeight) + #13 +

'lfItalic: ' + IntToStr(lfItalic) + #13 +

'lfUnderline: ' + IntToStr(lfUnderline) + #13 +

'lfStrikeOut: ' + IntToStr(lfStrikeOut) + #13 +

'lfCharSet: ' + IntToStr(lfCharSet) + #13 +

'lfOutPrecision: ' + IntToStr(lfOutPrecision) + #13 +

'lfClipPrecision: ' + IntToStr(lfClipPrecision) + #13 +

'lfQuality: ' + IntToStr(lfQuality) + #13 +

'lfPitchAndFamily: '+IntToStr(lfPitchAndFamily) + #13 +

'lfFaceName: ' + string(lfFaceName));

end;

Figure 12: Getting and displaying font attributes.

Once you have the settings in a TLogFont structure, the only change left is to set lfEscapement to the desired angle and create a new font with CreateFontIndirect. Before using this new font, it must be selected with SelectObject. Another way is to assign the handle of this new font to the handle of the canvas's font, before drawing the text. After drawing the text, this work must be reversed; the old font must be selected, and the new font deleted. If the new font isn't deleted, there will be a memory leak, and - if the routine is executed many times - Windows (especially 95/98) will run out of resources, and crash.

一旦你已设置好了TlogFont结构体，剩下唯一要做的事是改变lfEscapement的值为目的值并且用CreateFontIndirect来产生一个新字体。在使用这个新字体之前，必须用SelectObject来选择它。另一种方法是在描绘文字之前用这个新字体对象的句柄赋给窗体的canvas的字体对象的句柄。在描绘完文字后，这个过程要巅倒；旧字体必须被选中，新字体被删除。如果新字体没有被删除，会造成内存泄漏，并且-----如果程序被执行多次------ Windows (尤其是 95/98)会耗尽资源，并且

死机。

Stylish Lines

流行的线条

When you draw lines, the individual pixels usually don't matter; you simply set the line style, and it's drawn by Windows. Sometimes however, you need to do something special and draw a line style not provided by Windows. This can be done using a Windows API function named LineDDA, defined in Figure 13.

当你描绘线条时，单独的象素通常是不重要的；你只须简单地设置线条的类型，它将交给Windows来描绘。然而有时你想要做一些特殊的并且Windows没有提供的线条类型。这可以用一个名叫LineDDA的API函数来实现，在Figure 13中可以看到它的定义。

function LineDDA(

nXStart, // x-coordinate of line's starting point.

X坐标起点

nYStart, // y-coordinate of line's starting point.

Y坐标起点

nXEnd, // x-coordinate of line's ending point.

X坐标终点

YEnd : Integer; // y-coordinate of line's ending point.

Y坐标终点

// Address of application-defined callback function.

应用程序定义的回调函数的地址

lpLineFunc : TFNLineDDAProc;

lpData : LPARAM // Address of application-defined data.

应用程序定义的数据的地址

): BOOL; stdcall;

Figure 13: Object Pascal declaration for the Windows API function, LineDDA.

The first four parameters are the starting and ending points of the line. The fifth parameter is a callback function that will be called every time a pixel should be drawn. You put your drawing routines there. The last parameter is a user parameter that will be passed to the callback function. You can pass any Integer or pointer to the function, because it is an LParam (in Win32, it is translated to a Longint). The callback function must take the form shown here:

这开始的四个参数是线条的开始和结束点。第五个参数是一个回调函数，每次像素被描绘时都将被调用到。你可以将你的描绘过程写在这里。最后一个参数是用户定义的可以传给回调函数。你可以传递任何整数或指针给这个函数，因为它是

一个Lparam型（在WIN32，它是被解释成Longint型）。这个回调函数必须使用象如下的形式：

procedure CallBackDDA(x, y: Integer;

UserParam: LParam); stdcall;

where x and y are the coordinates of the drawn point, and UserParam is a parameter that is passed to the function. This function must be declared as stdcall. The routine in Figure 14 draws a line of bitmaps, and Figure 15 shows the result.

这里X和Y都是被描绘的坐标点，而UserParam是一个参数。这个函数必须被子定义为stdcall。Figure 14中的程序描绘了一个BMP线条，而Figure 15则显示结果。

type

TForm1 = class(TForm)

ImageList1: TImageList;

procedure FormPaint(Sender: TObject);

procedure FormResize(Sender: TObject);

end;

var

Form1: TForm1;

procedure CallDDA(x, y: Integer; Form: TForm1); stdcall;

implementation

{ $R *.DFM }

procedure CallDDA(x, y: Integer; Form: TForm1);

begin

if x mod 13 = 0 then

Form.ImageList1.Draw(Form.Canvas, x, y, 0);

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

LineDDA(0, 0, ClientWidth, ClientHeight,

@CallDDA, Integer(Self));

end;

procedure TForm1.FormResize(Sender: TObject);

begin

Invalidate;

end;

Figure 14: Code to draw a line of bitmaps.

Figure 15: Window with a custom line.

This routine handles the form's OnPaint event, calling LineDDA, so every time the form must be painted, it redraws the line. Another event that is handled is OnResize, which invalidates the form client area, so the line must be redrawn when someone changes its size. The LineDDA callback function, CallDDA, is very simple. At every 13th point it is called, it draws the bitmap stored in the ImageList. As you may notice, Self is passed as the last parameter to the callback function, so it can access the instance data.

这个程序处理窗体的OnPaint事件，调用LineDDA，所以每次窗体被描绘时，它将重画这条线。另一个事件是OnResize，它使窗体的客户区无效，所以当有人改变它的大小时线条亦将重画。LineDDA回调函数，CallDDA都是非常简单的。每当被调用了13次后，它将描绘存贮在ImageList中的位图。也许你注意到，SELF被作为最后一个参数传递给回调函数，所以它可以存取程序的数据。

Conclusion

结论

Since owner drawing was exposed on TMainMenu in Delphi 4, there have been many ways to augment your menus. Using the techniques we've discussed here, you can easily enhance your Delphi application's menus with custom text, bitmaps, and colors.

既然owner drawing在Delphi 4的TmainMenu中已出现了，它就可以有很多方法来扩展你的菜单功能。使用我们在上面讨论过的技巧，你能够轻易地用自定义文字，位图，和颜色来加强你的DELPHI应用程序的菜单功能。