Custom Menus, Rotated Text, and Special Lines

Mirror

Custom Menus, Rotated Text, and Special Lines (Views: 711)

Problem/Question/Abstract:

Custom Menus, Rotated Text, and Special Lines

Answer:

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.

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; see end of article for details.

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:

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:

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.

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.

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.

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.

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.
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.

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.

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.

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.
fdwItalic, // Italic attribute flag.
fdwUnderline, // Underline attribute flag.
fdwStrikeOut, // Strikeout attribute flag.
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.

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.

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.

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.

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.

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
// from current font.
GetObject(OldFont, Sizeof(LogFont), @LogFont);
// Angles range from 0 to 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.
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.

procedure TForm1.Info1Click(Sender: TObject);
var
LogFont: TLogFont;
begin
// Fill LogFont structure with information
// 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.

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.

function LineDDA(
nXStart, // x-coordinate of line's starting point.
nYStart, // y-coordinate of line's starting point.
nXEnd, // x-coordinate of line's ending point.
YEnd: Integer; // y-coordinate of line's ending point.
// 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:

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.

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.

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.

Component download: http://www.baltsoft.com/files/dkb/attachment/Custom_Menus.ziphttp://www.baltsoft.com/files/dkb/attachment/Custom_Menus.zip

<< Back to main page