本实例实现的功能是能够从用户选择的可执行文件(后缀名为exe)中提取所有图标并且显示在窗体上。

  在窗体中添加TImage 组件、TOpenDialog组件和TButton组件,TImage组件充当显示文件内图标的容器,TOpenDialog组件和TButton组件用来激活提示用户选择GIF动画的对话框。添加组件后的窗体如图1所示。

图1 添加组件后的窗体

  首先在窗体的uses段中添加ShellAPI,然后添加按钮响应代码如下:

procedure TfrmMain.btnOpenClick(Sender: TObject);
var
 i: Integer;
 Large, Small: HICON;
 nIcons: Integer;
begin
 if OpenDialog1.Execute then
 begin
  self.Image1.Canvas.Refresh;
  nIcons:=ExtractIconEx(PChar(OpenDialog1.FileName), -1, Large, Small, 1);
  for i:=0 to nIcons-1 do
  begin
   ExtractIconEx(PChar(self.OpenDialog1.FileName), i, Large, Small, 1);
   DrawIcon(self.Image1.Canvas.Handle,(i div 4)*40,(i mod 4)*40,Large);
  end;
 end;
end;

  当用户在程序运行过程中选择一个可执行文件后,程序首先通过self.Image1.Canvas. Refresh语句清除TImage组件上的显示内容,然后通过将ExtractIconEx函数的第2个参数指定为-1来取得可执行文件中图标的数目。得到数目后,通过一个循环中的ExtractIconEx (PChar(self.OpenDialog1.FileName), i, Large, Small, 1)语句把可执行文件中的大、小图标分别存储在Large和Small变量中。最后通过DrawIcon函数在TImage组件上绘制图标。

  程序代码如下:

unit Unit1;
interface
uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, Grids, ExtCtrls;

type
 TfrmMain = class(TForm)
 btnOpen: TButton;
 OpenDialog1: TOpenDialog;
 Image1: TImage;
 procedure btnOpenClick(Sender: TObject);
private
 { Private declarations }
public
 { Public declarations }
end;
var
 frmMain: TfrmMain;
 implementation
 {$R *.dfm}

 procedure TfrmMain.btnOpenClick(Sender: TObject);
 var
  i: Integer;
  Large, Small: HICON;
  nIcons: Integer;
 begin
  if OpenDialog1.Execute then
 begin
  self.Image1.Canvas.Refresh;
  nIcons:=ExtractIconEx(PChar(OpenDialog1.FileName), -1, Large, Small, 1);
  for i:=0 to nIcons-1 do
  begin
   ExtractIconEx(PChar(self.OpenDialog1.FileName), i, Large, Small, 1);
   DrawIcon(self.Image1.Canvas.Handle,(i div 4)*40,(i mod 4)*40,Large);
  end;
 end;
end;

end.

  保存文件,然后按F9键运行程序,程序运行的初始画面如图2所示。

  单击“打开”按钮,弹出一个提示用户选择可执行文件的对话框。确认后,在窗体的TImge组件上显示所选择的可执行文件中存储的图标,如图3所示。

图2 程序运行的初始画面

图3 程序运行结果

  读者从这个实例中可以学到如何提取可执行文件内部的所有图标并应用到自己的程序中。

Delphi实现提取可执行文件内部所有图标的更多相关文章

  1. delphi编写提取exe文件的ICO图标

    http://www.duote.com/tech/4/11797.html delphi编写提取exe文件的ICO图标 7.0分 出处:天下网吧 时间:2011-08-05 人气:2390 核心提示 ...

  2. Delphi 在任务栏隐藏程序图标

    Delphi 在任务栏隐藏程序图标 方法一:1.修改工程文件中的“Application.MainFormOnTaskbar := True;”为“Application.MainFormOnTask ...

  3. delphi 动态获取文件类型的图标

    delphi 动态获取文件类型的图标.txt我不奢望什么,只希望你以后的女人一个不如一个.真怀念小时候啊,天热的时候我也可以像男人一样光膀子!在应用程序的编写中,组合框(ComboBox).列表框(L ...

  4. Delphi提取EXE,DLL文件图标

    //uses ShellAPIprocedure TForm1.Button1Click(Sender: TObject);var IconIndex:Word; h:hICON;begin Icon ...

  5. 【win】【qt5打包】【qt程序打包成一个可执行文件(带图标任何win都可以运行哦)】

    [前言] 业务需求将qt程序打包成win可执行文件.咱是做linux的,奈何用的麒麟系统,程序运行在win,好嘛,重新在win qtcreator编译后打包呗. [目标] 1.给qt程序添加一个图标. ...

  6. 读取Devexpress内部的图标

    1.图标在Dev源码的存储路径: Sources D.x.u 15.1.3\DevExpress.Images\Images   2.引用DevExpress.Images.v15.1.dll文件,代 ...

  7. Delphi 注册文件类型 设置文件图标

        {------------------------------------------------------------------------------- @过程名: slpert -& ...

  8. Delphi 实现任务栏多窗口图标显示(使用WS_EX_APPWINDOW风格)

    uses Windows;type TfrmLogin = class(TForm) end; implementation {$R *.dfm} procedure TfrmLogin.FormCr ...

  9. Delphi 实现任务栏多窗口图标显示

    uses Windows; type TfrmLogin = class(TForm) end; implementation {$R *.dfm} procedure TfrmLogin.FormC ...

随机推荐

  1. 阿里云移动研发平台EMAS,是如何连续5年安全护航双11的?

    摘要: 阿里云作为阿里巴巴IT基础设施的基石,每年的双十一都面临前所未有的巨大技术挑战.阿里云的EMAS移动研发平台,连续5年支持双11,不仅保障了手机淘宝.支付宝这些阿里巴巴集团App的使用体验,也 ...

  2. (18)C++ string和标准模板库

    一.stringl类 1.string构造函数 string a1("abc");//初始化字符串 cout<<a1<<endl;//abc , '#'); ...

  3. java对象属性为date oracle数据库字段为Timestamp 处理方式

    解决方案 SimpleDateFormat df1 = new SimpleDateFormat("yyyy-MM-dd HH:mm:ss"); java.util.Date da ...

  4. Linux安装Oracle 10g

    目录 目录 环境 RHEL6 Configuration Update JDK 配置Oracle安装环境 硬件检测 软件检测 编辑配置文件 安装Oracle Database 环境 系统 RHEL6 ...

  5. 【消息中间件】kafka

    一.kafka整体架构 kafka是一个发布订阅模式的消息队列,生产者和消费者是多对多的关系,将发送者与接收者真正解耦: 生产者将消息发送到broker: 消费者采用拉(pull)模式订阅并消费消息: ...

  6. intellij免费激活码

    IDEA官方下载地址:https://www.jetbrains.com/idea/nextversion/ IntelliJ IDEA 2019.2最新版本免费激活码 支持IDEA所有版本 正版授权 ...

  7. centos python3.7 报错 No module named ‘_ctypes’ make: ***

    1.先装好python的依赖 2.yum install libffi-devel -y(解决)

  8. ORA-13639: The CURRENT operation was interrupted because it timed OUT

    该错误是由于SQL Tune Job执行超时导致,默认“Time Limit"是3600秒,即一个小时.DECLARE   l_sql_tune_task_id CLOB; BEGIN   ...

  9. 洛谷 P1742 最小圆覆盖 (随机增量)

    题目链接:P1742 最小圆覆盖 题意 给出 N 个点,求最小的包含所有点的圆. 思路 随机增量 最小圆覆盖一般有两种做法:随机增量和模拟退火.随机增量的精确度更高,这里介绍随机增量的做法. 先将所有 ...

  10. Cocos2d-x之Layer

    |   版权声明:本文为博主原创文章,未经博主允许不得转载. Layer是处理玩家事件响应的Node子类.与场景不同,层通常包含的是直接在屏幕上呈现的内容,并且可以接受用户的输入事件,包括触摸,加速度 ...