Creation of DELPHI’s strange menu
Translator: Li Junyu email: [email protected],[email protected]
Custom Menus, Text, Lines / Delphi 4, 5
Custom menu, text, line/Delphi 4, 5
Fancy Menus, etc.
Bizarre menus, etc.
Custom Menus, Rotated Text, and Special Lines
Customized 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 (ie 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.
Before Delphi 4, it was difficult to customize a menu (such as adding a BMP image, changing the font, etc.) because the owner drawing event (that is, the custom drawing event) - although executed by Windows, is not Appears in TMainMenu class. Since Delphi 4,
This situation has changed, and we now have the ability to customize menus.
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.
This article will focus on some techniques you can use to customize the appearance of the menus in your DELPHI applications. We will cover text placement, menu sizing, font settings, and enhancements with BMP files and the SHAPE control. The display effect of the menu. Just for fun purposes, this article will also feature a close-up of techniques for rotating text and custom lines. All techniques discussed in this article have been debugged in project files and can be downloaded online.
Custom Fonts and Sizes
Set font and size
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:
To create a custom menu, set the OwnerDraw property of the TmainMenu or TpopupMenu component to TRUE, and create its OnDrawItem and OnMeasureItem event procedures. For example, an OnMeasureItem event procedure could be declared as follows:
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:
Set the menu item's Width and Height variables in the event procedure above to the appropriate sizes. All the main things are triggered by the OnDrawItem event; this is where you'll redraw the menu and make any special settings. For example, to redraw a menu item in Times New Roman font, you would do the following:
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.
However this code is flawed. If you run this code, the menu item's caption will be aligned to the left of the menu item. This is not the default behavior of Windows. Normally, there is a space on the left side of the menu for a BMP image and a selection mark. Therefore, you should use code to calculate how much space is needed to place the selection flag, as shown in Figure 1. Figure 2 shows the menu in action.
procedure TForm1.Times2DrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
dwCheck : Integer;
MenuCaption: string;
begin
// Get the checkmark dimensions.
Get the number of pixels required for the selection logo
dwCheck := GetSystemMetrics(SM_CXMENUCHECK);
// Adjust left position.
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.
draw text
DrawText(ACanvas.Handle, PChar(MenuCaption),
Length(MenuCaption), ARect, 0);
end;
Figure 1: This OnDrawItem event handler places menu item text correctly.
[The translator omitted all FigureS, the same below]
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 .
If the text is too long, Windows will automatically crop it to fit. Therefore, you should size the menu so that all text can be displayed. The same should be true in the OnMeasureItem event, which can be seen in 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
This length is the length of the menu selection mark
// plus the width of the item text.
Plus the length of the menu item
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
Set up graphics 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.
It is possible to set up menus with bitmaps and other graphics. To add a bitmap, simply assign a BMP file to the Bitmap property of TmenuItem in the Object Inspector at design time, or use code at runtime. Assignment is also possible. To replace the menu title with a colored rectangle, you can use the OnDrawItem event, such as shown in Figure 4. Shown in Figure 5 are the results.
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.
Convert menu item's title to color
MenuColor :=
StringToColor((Sender as TMenuItem).Caption);
// Change the canvas brush color.
Change the brush color of canvas
ACanvas.Brush.Color := MenuColor;
// Draws the rectangle. If the item is selected,
Draws a rectangle if the menu item is selected
// draw a border.
draw borders
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.
The more popular approach is that if you are using Delphi 5, you should set the menu's AutoHotkeys property to maManual. If you don't do this and leave the default value of maAutomatic, Delphi will automatically add an ampersand to the title, which will break the code. Another solution is to use the StripHotKey function to remove the ampersand.
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 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.
Another use for the OnDrawItem and OnMeasureItem events is to write vertical text next to the menu (such as shown in Figure 7). In order to do this, you have to create a rotated font. The only way is to use the Windows API's CreateFont or CreateLogFont function (see the "rotated text" technique later in this article). So you have to redraw it in the OnDrawItem event. This event is executed when the menu item is pulled out, so if a menu has 20 items, then it will be executed 20 times. To make it faster, the vertical text can be redrawn every time a menu item is selected (although only one menu item is selected at a time). Figure 6 shows how the code executes, while Figure 7 shows the results.
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.
This will be executed when the menu item is selected
if Selected then begin
// Create a rotated font.
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.
Select this font to draw
OldFont := SelectObject(ACanvas.Handle,
CreateFontIndirect(lf));
// Change foreground and background colors.
Change foreground and background colors
clFore := SetTextColor(ACanvas.Handle, clSilver);
clBack := SetBkColor(ACanvas.Handle, clBlack);
// Get the menu height.
Get menu height
MenuHeight := (ARect.Bottom-ARect.Top) *
((Sender as TMenuItem).Parent as TMenuItem).Count;
Rectang := Rect(-1, 0, dwCheck-1, MenuHeight);
// Draw the text.
draw text
ExtTextOut(ACanvas.Handle, -1, MenuHeight, Eto_Clipped,
@Rectang, 'Made in Borland', 15, nil);
// Returns to the original state.
Return to original state
DeleteObject(SelectObject(ACanvas.Handle, OldFont));
SetTextColor(ACanvas.Handle, clFore);
SetBkColor(ACanvas.Handle, clBack);
end;
// Draw the real menu text.
Draw real menu item 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:
You should know where to start drawing text. It should start at the bottom of the last item in the menu. In order to get this position, we get the height of the menu item as follows:
ARect.Top - ARect.Bottom
and multiply it by the number of items in the menu:
And multiplied by the number of menu items:
(((Sender as TMenuItem).Parent as TMenuItem).Count)
Rotated Text
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.
The Windows API lets you draw text at any angle. In order to do this in Delphi, you must use the two API functions CreateFont or CreateFontIndirect. Figure 8 shows how CreateFont is declared.
function CreateFont(
nHeight, // Logical height of font. The logical height of the font.
nWidth, // Logical average character width. Logical average character width.
nEscapement, // Angle of escapement. Angle of rotation
nOrientation, // Base-line orientation angle. Base-line orientation angle.
fnWeight: Integer; // Font weight. The weight sub-property of the font
fdwItalic, // Italic attribute flag. Is it italic?
fdwUnderline, // Underline attribute flag. Whether to underline
fdwStrikeOut, // Strikeout attribute flag. Whether to strikeout attribute
fdwCharSet // Character set identifier. Character set
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.
Although this function takes many parameters, you usually only need to change one or two properties of the text. In this case, you would use the CreateFontIndirect function instead. It requires only one parameter - a record type parameter of TlogFont, as can be seen in 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.
If you look closely at this record type, you will find that its members are very similar to the parameters of the CreateFont function. The advantage of using this function/record combination is that you can use the GetObject API function to fill the member values of this record with a known font, and then change the member value you want to change to generate a new font.
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.
In order to draw rotated text, the only member you need to change is lfEscapement, which sets the angle of the font in tenths of a degree. So if you want the character to rotate 45 degrees, you have to set
lfEscapement is 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.
Notice that there are quite a few markers to italicize, underline, and highlight text, but there are no markers to make bold text. This is because the lfWeight member is used instead, and the value of this member is between 0 and 1000. 400 is the normal value, anything above this is bold, and anything below this is thin.
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.
The code in Figure 10 draws characters every 20 degrees from 0 to 360 degrees. This is triggered in the form's OnPaint event, so the text is redrawn each time the form is painted. The effect can be seen in Figure 11.
procedure TForm1.FormPaint(Sender: TObject);
var
OldFont, NewFont: hFont;
LogFont: TLogFont;
i : Integer;
begin
// Get handle of canvas font.
Gets the handle to the form font object
OldFont := Canvas.Font.Handle;
i := 0;
// Transparent drawing.
Set transparency property
SetBkMode(Canvas.Handle, Transparent);
// Fill LogFont structure with information
Fill in the LogFont structure with information
// from current font.
from current font
GetObject(OldFont, Sizeof(LogFont), @LogFont);
// Angles range from 0 to 360.
from 0 to 360 degrees
while i < 3600 do begin
// Set escapement to new angle.
Set text orientation to new angle
LogFont.lfEscapement := i;
//Create new font.
Create new font
NewFont := CreateFontIndirect(LogFont);
// Select the font to draw.
Select fonts for output
SelectObject(Canvas.Handle, NewFont);
// Draw text at the middle of the form.
Output text in the middle of the form
TextOut(Canvas.Handle, ClientWidth div 2,
ClientHeight div 2, 'Rotated Text', 21);
// Clean up.
Clear
DeleteObject(SelectObject(Canvas.Handle, OldFont));
// Increment angle by 20 degrees.
increments every 20 degrees
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.
The font of this form is set to Arial, a TrueType font. This code only runs under TrueType fonts; other fonts do not support text rotation. In order to obtain the current font settings and fill in the TlogFont structure, you must use the GetObject API function. In the code in Figure 12 you can see how to fill in and display the TlogFont settings in the form.
procedure TForm1.Info1Click(Sender: TObject);
var
LogFont: TLogFont;
begin
// Fill LogFont structure with information
Fill in the member values of the LogFont structure
// from current font.
from current font
GetObject(Canvas.Font.Handle, Sizeof(LogFont), @LogFont);
// Display font information.
Show 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. 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.
Once you have set up the TlogFont structure, the only thing left to do is to change the value of lfEscapement to the target value and use CreateFontIndirect to generate a new font. Before using this new font, you must use SelectObject to select it. Another method is to use the handle of this new font object to the handle of the font object of the form's canvas before drawing the text. After the text is drawn, the process begins; the old font must be selected and the new font deleted. If the new font is not removed, it will cause a memory leak, and -----if the program is executed multiple times------ Windows (especially 95/98) will run out of resources, and
crash.
Stylish Lines
popular 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.
When you draw lines, individual pixels are usually unimportant; you simply set the type of line and it will be left to Windows to draw it. Sometimes, however, you want to do some special line types that Windows doesn't provide. This can be achieved using an API function called LineDDA, whose definition can be seen in Figure 13.
function LineDDA(
nXStart, // x-coordinate of line's starting point.
X coordinate starting point
nYStart, // y-coordinate of line's starting point.
Y coordinate starting point
nXEnd, // x-coordinate of line's ending point.
X coordinate end point
YEnd : Integer; // y-coordinate of line's ending point.
Y coordinate end point
// Address of application-defined callback function.
The address of the application-defined callback function
lpLineFunc: TFNLineDDAProc;
lpData : LPARAM // Address of application-defined data.
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:
The first four parameters are the start and end points of the line. The fifth parameter is a callback function that will be called each time a pixel is drawn. You can write about your drawing process here. The last parameter is user-defined and can be passed to the callback function. You can pass any integer or pointer to this function because it is
An Lparam type (in WIN32, it is interpreted as a Longint type). This callback function must use a form like the following:
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.
Here X and Y are the coordinate points being drawn, and UserParam is a parameter. This function must be subdefined as stdcall. The program in Figure 14 plots a BMP line, and Figure 15 displays the results.
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.
This program handles the form's OnPaint event, calling LineDDA, so it will redraw the line each time the form is painted. Another event is OnResize, which invalidates the client area of the form so the lines will be redrawn when someone changes its size. LineDDA callback function and CallDDA are very simple. Whenever called 13 times, it will draw the bitmap stored in the ImageList. Maybe you noticed that SELF is passed as the last parameter to the callback function, so it can access the program's data.
Conclusion
in 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.
Now that owner drawing has appeared in TmainMenu in Delphi 4, it can have many ways to extend your menu functionality. Using the techniques we discussed above, you can easily enhance your DELPHI application's menu functionality with custom text, bitmaps, and colors.