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;
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應用程序的菜單功能。
