Delphi pop-up menu with icon

zhaozj2021-02-11  208

apricot

A large feature of the Windows interface is to show colorful icons, the icon not only beautifies Windows desktop, but also facilitates it, which brings great convenience to users. When the design program interface, the Windows style is a good reference.

Delphi generally provides two ways of setting icons, one is the icon for specifying the application in Project Options, and the other is the ICON feature in the Object Inspector's Properties page. If you want to design a beautiful pop-up menu like Windows start menu, you have to write code.

We know that most Windows applications themselves with icons, as long as the icon belt itself is removed, the adjustment icon is added to the pop-up menu, and a beautiful menu is complete.

First use extractassociated to get icons from a program, and the size of the icon is different, not necessarily directly to the menu, and Delphi does not provide the function of adjusting the icon size, which must transform the icon file into bitmap file. Then adjust the size of the bitmap file, and finally replace the menu item with a bitmap file. The source code is as follows:

Type

TFORM1 = Class (TFORM)

Mainmenu1: TmainMenu;

File1: tmenuitem;

/ **** Project in the single section **** /

Open1: tMenuitem;

/ **** Project 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 icons from a program ** /

IC: = ticon.create;

Ic.handle: = Extractassociated (Hinstance, / * file name and its 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 into the bitmap created above, 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.stylele :=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;

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

END;

/ ** Using the alignment item Open1 ** /

SetMenuItemInfo (GetSubmenu (MainMenu1.Handle, File1.MenuIndex),

Open1.MenuIndex, true, iteminfo;

END;

The above program is debugged in Windows98, Delphi 4.0 environment

转载请注明原文地址:https://www.9cbs.com/read-4059.html

New Post(0)