在Vista或更高版本Windows系统中, 获取超大图标的办法
这几天写个小东西, 需要获取系统正在运行的程序图标, 一般来说32*32就足够了, 不过既然Win7能够支持超大图标(256*256), 咱们也需要与时俱进, 说不定什么时候遇到个变态客户就有这要求了
找了下以前的资料, 获取程序图标基本都是用SHGetFileInfo来获取, 这样只能得到最大32*32的
想获取超大的需要用SHGetImageList这个API, 不过很奇怪Delphi里面虽然有这个API, 可是调用出错, 只能从DLL里面重新加载了
网上相关资料很少, 但是还是能找到的, 不过不知道为什么, 找到的都是一样的代码, 相对下面的代码网上的资料都是这样获取图标句柄的
Result := ImageList_GetIcon(nImageList, Pred(ImageList_GetImageCount(nImageList)), ILD_NORMAL);
虽然执行结果一样, 但是很让人费解, 另外, 这样做如果在程序内多次获取多个程序的图标就会出现得到的都是一样的图标的问题(是一个BUG)
解决方法: SHGetFileInfo函数本来就是获取图标索引的, 直接使用得到的结果就行了
Result := ImageList_GetIcon(nImageList, nFileInfo.iIcon, ILD_NORMAL);
完整函数如下
uses
ShellAPI, CommCtrl; const
SHIL_LARGE = ; {32x32}
SHIL_SMALL = ; {16x16}
SHIL_EXTRALARGE = ; {48x48}
SHIL_SYSSMALL = ; {16x16}
SHIL_JUMBO = ; {256x256} function GetFileIconEX(AFile: string; ASHIL_FLAG: Cardinal): HICON; function _X: Boolean; {判断是否符合系统版本}
begin
Result := False;
if Win32MajorVersion < then
Exit;
if (Win32MajorVersion = ) and (Win32MinorVersion < ) then
Exit;
Result := True;
end; type
_SHGetImageList = function (iImageList: Integer; const riid: TGUID;
var ppvObj: Pointer): HResult; stdcall;
var
nHandle: THandle;
nImageList: HIMAGELIST;
nSHGetImageList: _SHGetImageList;
nFileInfo: TSHFileInfo;
const
IID_IImageList: TGUID = '{46EB5926-582E-4017-9FDF-E8998DAA0950}';
begin
Result := ;
nHandle:= LoadLibrary('Shell32.dll');
nImageList := ;
if nHandle <> S_OK then
try
nSHGetImageList := GetProcAddress(nHandle, PChar());
if Assigned(nSHGetImageList) and _X then
nSHGetImageList(ASHIL_FLAG, IID_IImageList, Pointer(nImageList));
finally
FreeLibrary(nHandle);
end;
if nImageList > then
begin
SHGetFileInfo(PChar(AFile), FILE_ATTRIBUTE_NORMAL, nFileInfo, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX);
Result := ImageList_GetIcon(nImageList, nFileInfo.iIcon, ILD_NORMAL);
end;
end;
在Vista或更高版本Windows系统中, 获取超大图标的办法的更多相关文章
- 解决Macbook Pro 2017安装Windows10双系统后在Windows系统中Apple蓝牙鼠标不能使用问题
MAC BOOK PRO 2017安装Windows10双系统 在Windows系统中蓝牙鼠标不能使用解决办法 最近因工作需要,macOS系统不能要求,大部分工作必须要在Windows系统中进行,最初 ...
- 如何在Windows Server 2012及更高版本中将域控制器降级
如何在Windows Server 2012及更高版本中将域控制器降级 如果不降级就重装系统,会出问题,所以在将域控系统重装系统之前一定要先降级. 使用服务器管理器将 Windows Server 2 ...
- 关于IIS部署时出现“System.Data.OracleClient 需要 Oracle 客户端软件 8.1.7 或更高版本”的问题解决摘要
系统环境:windows2008 X64 IIS版本:iis7 oracle客户端版本:11g,另外装了32位的客户端. 网站.net framework版本: 4.0 目前状况,IIS可以正常运行, ...
- 【2016-09-16】UbuntuServer14.04或更高版本安装问题记录
出于项目需要,我们的Qt程序需要运行在 1. Windows/Linux-X86平台(CPU为常见的桌面级CPU如G3220.I3等): 2. Windows/Linux-X86低功耗平台(CPU为I ...
- “System.Exception: System.Data.OracleClient 需要 Oracle 客户端软件 8.1.7 或更高版本” 的解决方案
在项目部署过程中ORACLE客户端多次会遇"System.Exception: System.Data.OracleClient 需要 Oracle 客户端软件 8.1.7 或更高版本&qu ...
- 转发:maven打包时始终出现以下提示:-source 1.3 中不支持泛型(请使用 -source 5 或更高版本以启用泛型)
maven打包时始终出现以下提示: 1.-source 1.3 中不支持泛型(请使用 -source 5 或更高版本以启用泛型)List<User> userList= new Array ...
- EBS报错FRM-92095:Oracle JInitiator版本太旧,请安装版本1.1.8.2或更高版本
EBS打开报错FRM-92095:Oracle JInitiator版本太旧,请安装版本1.1.8.2或更高版本 打开EBS的form,系统报错,中文提示信息是:FRM-92095:oracle ji ...
- 2019年9月(System.Data.OracleClient 需要 Oracle 客户端软件 version 8.1.7 或更高版本。)问题解决记录
System.Data.OracleClient 需要 Oracle 客户端软件 version 8.1.7 或更高版本. 在百度上寻找了很久,都说是权限的问题,可是更改过后一点效果也没有. 实际上真 ...
- Win10安装.Net Framework4.7及更高版本
问题描述 使用VS打开项目工程时,提示未安装.net framework4.7,但在启用或关闭windows功能里已经勾选了.net framework 4.7的全部功能. 直接从网上下载.net f ...
随机推荐
- web应用配置
tomcat 的 server.html 配置文件 加在</Host>之上 <Context path=”/itcast” docBase=”c:\news” /> path虚 ...
- kali实用链接
1.Kali-linux安装之后的简单设置 :http://xiao106347.blog.163.com/blog/static/215992078201342410347137/ 2.kali文 ...
- Ubuntu 11.10升级Ruby (1.8.7 --> 1.9.3或者其他任意版本)
使用apt-get install ruby,安装的默认版本为1.8.7.想要使用更高版本,只能采用手工升级的方式. 方式1 使用RVM(推荐方式) 1 安装RVM http://rvm.io/rvm ...
- 【wikioi】1250 Fibonacci数列(矩阵乘法)
http://wikioi.com/problem/1250/ 我就不说这题有多水了. 0 1 1 1 矩阵快速幂 #include <cstdio> #include <cstri ...
- hdu Strange fuction
本题是一道二分题,但是要利用导数来求最小值.对原函数进行求导,得到的导函数为f(x)=42*pow(x,6)+48*pow(x,5)+21*pow(x,2)+10*x-y;因为0<=x<= ...
- hdu 饭卡
本题的思路是:首先如果m<5,直接输出:若m>5,则先拿出5元钱买最贵的东西,这样背包容量就变成了m-5,商品数量为n-1的0/1背包问题. 此题的状态转移方程为:dp[j]=max{dp ...
- ThinkPHP 中M方法和D方法详解----转载
转载的地址,http://blog.163.com/litianyichuanqi@126/blog/static/115979441201223043452383/ 自己学到这里的时候,不能清除的分 ...
- 导航栏下a标签失效的原因
前天我一直没找到失效的结果,就在刚才,我用不同的浏览器打开我编写的网页,有一个浏览器的图片循环播放效果错位了,我觉得就是它上边的div把他挤下来了.正如前天网上看到的高手的们的说法.我用firebug ...
- workerman使用编译安装workerman的php环境
提示 workerman只是一个代码包,如果php环境满足要求,下载后即可使用,实际上没有安装过程. workerman对php环境的要求是: 1.php>=5.3.3,可以运行命令php-v查 ...
- 应用服务器上部署自己的 blog 和 wiki 组件。
协作性应用程序 这就是 Web 2.0 的全部,尽管该术语出现才几乎一年的时间,但现在好像只有烹饪杂志还没有加入到讨论 Web 2.0 未来出路的行列中.自从出现了里程碑式的文章 "What ...