Create a pop-up menu with icons in Delphi

Apricot

A major feature of the Windows interface is to display a variety of icons, which not only beautify the Windows desktop, but also facilitate intuitive operations and bring great convenience to users. Windows style is a good reference when designing the program interface.

Delphi generally provides two ways to set icons. One is to specify the application icon in project options, and the other is to provide the icon feature on the properties page of the object inspector. If you want to design a menu that is as beautiful as the Windows Start Menu, you have to write your own code.

We know that most Windows applications have icons. You only need to remove the icons and adjust the size of the icons to the pop-up menu. A beautiful menu is complete.

First, use extractassociatedicon to get the icon from a program. The Icon size is different and may not be directly added to the menu. At the same time, Delphi does not provide the function of adjusting the Icon size, this requires converting the icon file into a bitmap file, adjusting the size of the bitmap file, and replacing the menu item with a bitmap file. The source code is as follows:

Type

Tform1 = Class (tform)

Mainmenu1: tmainmenu;

File1: tmenuitem;

/***** Projects in the menu bar ****/

Open1: tmenuitem;

/***** Projects in the menu file ****/

Procedure formcreate (Sender: tobject );

Procedure formshow (Sender: tobject );

Private

{Local parameter declaration}

Public

{Global parameter declaration}

ICN, txt, mnuitm: tbitmap;

End;

Procedure tform2.formcreate (Sender: tobject );

VaR R: trect;

Hicn: hicon;

IC: ticon;

Index: word;

Filename: pchar;

Begin

/** Get the icon from a program **/

IC: = ticon. Create;

IC. Handle: = extractassociatedicon (hinstance,/* file name and path */, index );

/** Create a bitmap **/

TXT: = tbitmap. Create;

With TXT do

Begin

Width: = canvas. textwidth ('test ');

Height: = canvas. textheight ('tes ');

Canvas. textout (0, 0, 'test ');

End;

/** Copy the icon to the previously created bitmap and adjust its size **/

ICN: = tbitmap. Create;

With ICN do

Begin

Width: = 32;

Height: = 32;

Brush. Color: = clbtnface;

Canvas. Draw (0, 0, IC );

End;

/** Create the last bitmap file **/

Mnuitm: = tbitmap. Create;

With mnuitm do

Begin

Width: = TXT. Width + 18;

Height: = 18;

With canvas do

Begin

Brush. Color: = clbtnface;

Pen. Color: = clbtnface;

Brush. Style: = bssolid;

Rectangle (0, 0, width, height );

Copymode: = cmsrcand;

Stretchdraw (rect (0, 0, 16, 16), ICN );

Copymode: = cmsrcand;

Draw (16, 8-(txt. Height Div 2), txt );

End;

End;

End;

Procedure tform2.formshow (Sender: tobject );

VaR

Iteminfo: tmenuiteminfo;

Hbmp1: thandle;

Begin

Hbmp1: = mnuitm. Handle;

With iteminfo do

Begin

Cbsize: = sizeof (iteminfo );

Fmask: = miim_type;

FTYPE: = mft_bitmap;

Dwtypedata: = pchar (makelong (hbmp1, 0 ));

End;

/** Use bitmap to replace the open1 menu item **/

Setmenuiteminfo (getsubmenu (mainmenu1.handle, file1.menuindex ),

Open1.menuindex, true, iteminfo );

End;

The above programs are successfully debugged in Windows 98 and Delphi 4.0 environments.