• Delphi制作带图标的弹出式选单


    Windows界面的一大特色就是显示丰富多彩的图标,图标不仅美化了Windows的桌面,而且便于直观的操作,给用户带来了极大的方便。在设计程序界面时,Windows风格是很好的参考。

      Delphi一般提供两种设置图标的方法,一个是在Project Options 中指定应用程序的图标,另一个是在Object Inspector 的properties页中提供Icon特性。如果想设计出像Windows开始选单那样美丽的弹出选单,就要自己编写代码了。

      我们知道大多数Windows应用程序本身带有图标,只要将程序本身所带的图标取出,调整图标的大小加入到弹出选单中,一个美丽的选单就完成了。

      首先用ExtractAssociatedIcon从某一程序中获取图标,而图标的尺寸大小不一,不一定能直接添加到选单中,同时Delphi没有提供调整图标大小的功能,这就必须将图标文件转化成位图文件,然后调整位图文件的大小,最后用位图文件取代选单项目即可。其源代码如下:

      type

       TForm1 = class(TForm)

       MainMenu1: TMainMenu;

       File1: TMenuItem;

      /**** 选单条中的项目****/

       Open1: TMenuItem;

      /****选单文件中的项目 ****/

      procedure FormCreate(Sender: TObject);

      procedure FormShow(Sender: TObject);

       private

       {局部参数声明}

       public

       {全局参数声明}

       Icn, Txt, MnuItm: TBitmap;

       end;

      procedure TForm2.FormCreate(Sender: TObject);

      var R: TRect;

       HIcn: HIcon;

       Ic: TIcon;

       Index: Word;

       FileName: PChar;

      begin

       /**从某一程序中获取图标**/

       Ic:=TIcon.Create;

       Ic.Handle:=ExtractAssociatedIcon(Hinstance, /*文件名称及其路径*/, Index);

       /** 创建位图**/

       Txt:=TBitmap.Create;

       with Txt do

       begin

       Width:=Canvas.TextWidth(' Test');

       Height:=Canvas.TextHeight(' Tes');

       Canvas.TextOut(0,0,' Test');

      end;

       /**将图标复制到上述创建的位图中,并调整它的尺寸 **/

       Icn:=TBitmap.Create;

       with Icn do

       begin

       Width:=32;

       Height:=32;

       Brush.Color:=clBtnFace;

       Canvas.Draw(0,0,Ic);

       end;

       /** 创建最后的位图文件**/

       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;

       /** 用位图取代选单项目Open1 **/

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

      Open1.MenuIndex, true, ItemInfo );

       end;

      以上程序在Windows98、Delphi 4.0环境下调试通过

  • 相关阅读:
    idou老师教你学Istio 08: 调用链埋点是否真的“零修改”?
    idou老师教你学Istio 07: 如何用istio实现请求超时管理
    idou老师教你学Istio06: 如何用istio实现流量迁移
    Strusts2笔记8--文件的上传和下载
    Strusts2笔记7--国际化
    Strusts2笔记6--拦截器
    Strusts2笔记5--数据验证
    Strusts2笔记4--类型转换器
    Struts2笔记3--获取ServletAPI和OGNL与值栈
    Struts2笔记2--动态方法调用和Action接收请求方式
  • 原文地址:https://www.cnblogs.com/martian6125/p/9631361.html
Copyright © 2020-2023  润新知