apricot
A major feature of the Windows interface is the display of colorful icons. The icons not only beautify the Windows desktop, but also facilitate intuitive operation, bringing great convenience to users. Windows style is a good reference when designing program interfaces.
Delphi generally provides two methods for setting icons, one is to specify the application's icon in the PRoject Options, and the other is to provide the Icon attribute in the properties page of the Object Inspector. If you want to design a pop-up menu as beautiful as the Windows Start menu, you have to write the code yourself.
We know that most Windows applications have icons themselves. As long as you take out the icons from the program itself, adjust the size of the icon and add it to the pop-up menu, a beautiful menu is completed.
First, use ExtractAssociatedIcon to obtain the icon from a certain program. However, the size of the icon varies and may not be directly added to the menu. At the same time, Delphi does not provide the function of adjusting the icon size, so the icon file must be converted into a bitmap file. Then adjust the size of the bitmap file, and finally replace the menu items with the bitmap file. Its source code is as follows:
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
/****Items in the menu bar****/
Open1: TMenuItem;
/****items in 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 an icon from a program**/
Ic:=TIcon.Create;
Ic.Handle:=ExtractAssociatedIcon(Hinstance, /*file name and path*/, Index);
/** Create 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 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 final 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;
/** Replace menu item Open1 with bitmap **/
SetMenuItemInfo( GetSubMenu( MainMenu1.Handle, File1.MenuIndex ),
Open1.MenuIndex, true, ItemInfo );
end;
The above program has been debugged under Windows98 and Delphi 4.0 environments.