用 PictureVal 直接在 Image 控件上显示系统默认文件类型的图标

原创 2014年03月30日 11:37:59

表单上加一个 Image 和 CommandButton 控件,按钮的 Click 中贴下面代码:

If Version(5) < 900 or Val(GetWordNum(Version(4), 4, '.')) < 5815
    MessageBox('版本太低,至少要 vfp9sp2(5815)。', '')
    Return
EndIf

Local cFile, nSize, cSFI, nBuf, nWidth, nHeight, nSize, cPicVal
Local hIcon, hTk, hBmp, pMem, hStream

* ------------------------------------------------------------------------------
* -- 提取某类或某个文件的默认图标(在 Windows 文件夹中显示的图标)
m.cFile = InputBox('指定要提取图标的文件扩展名或留空待选定某个确定的文件:')
m.nSize = 0        && 0/1 - 大/小图标
* ------------------------------------------------------------------------------
Do case
Case Empty(m.cFile)
    m.cFile = GetFile()
Case Empty(JustExt(m.cFile))
    m.cFile = ForceExt('sample', m.cFile)
EndCase
If Empty(m.cFile)
    Return
EndIf

Declare Long SHGetFileInfo in shell32 String, Long, String @, Long, Long
Declare Long GdiplusStartup in GDIPlus Long @, String @, Long @
Declare Long GdiplusShutdown in GDIPlus Long
Declare Long GdipCreateBitmapFromHICON in GDIPlus Long, Long @
Declare Long GdipGetImageHeight in GDIPlus Long, Long @
Declare Long GdipGetImageWidth in GDIPlus Long, Long @
Declare Long GdipSaveImageToStream In GDIPlus Long, Long, String, Long
Declare Long GdipDisposeImage In GDIPlus Long
Declare Long GlobalAlloc in win32api Long, Long
Declare Long GlobalFree in win32api Long
Declare Long CreateStreamOnHGlobal in ole32 Long, Long, Long @
Declare Long ReleaseStgMedium in ole32  String

m.cSFI = Replicate(Chr(0), 4*3 + 260 + 80)
SHGetFileInfo(m.cFile, 0, @ m.cSFI, Len(m.cSFI), 0x100+0x10+m.nSize)
m.hIcon = CToBin(Left(m.cSFI,4),'4rs')

m.hTk = 0
m.nBuf = 0h01 + Replicate(Chr(0),15)
GdiplusStartup(@ m.hTk, @m.nBuf, 0)
m.hBmp = 0
GdipCreateBitmapFromHICON(m.hIcon, @ m.hBmp)
m.nWidth = 0
m.nHeight = 0
GdipGetImageWidth(m.hBmp, @ m.nWidth)
GdipGetImageHeight(m.hBmp, @ m.nHeight)
    
m.nSize = m.nWidth * m.nHeight * 4 + 64
m.pMem = GlobalAlloc(0x40, m.nSize)
m.hStream = 0
CreateStreamOnHGlobal(m.pMem, 0, @ m.hStream)
GdipSaveImageToStream(m.hBmp, m.hStream, 0h06F47C55041AD3119A730000F81EF32E, 0)
m.cPicVal = Sys(2600, m.pMem, m.nSize)

ReleaseStgMedium(BinToC(4,'rs')+BinToC(m.hStream,'rs')+BinToC(0,'rs'))
GlobalFree(m.pMem)

GdipDisposeImage(m.hBmp)
GdiplusShutdown(m.hTk)

* -----------------------------------------------------
Thisform.Image1.PictureVal = m.cPicVal
* -----------------------------------------------------


版权声明:本文为博主原创文章,未经博主允许不得转载。

相关文章推荐

05/11/07

今天不错。中午给弄了一下OD,把OD那个什么修改文件的一个菜单问题弄了一下。下午老大也不在,比较爽。据说老D把钱给我打过来了,虽然没有预想的多,但是也不错了。周末可以去找猪头购物去。打算买个大内存,再...
  • nbw
  • nbw
  • 2005-11-08 00:38
  • 571

COM 免注册技术

通常,实例化 COM 组件(包括采用这一技术的 DLL/ActiveX 控件)前,都需要先用 Regsvr32 注册该组件(或控件),从 XP sp2 开始,微软提供了一种采用 manifest(文件...

扩展 vfp9 自带的对象浏览器提取枚举值

Foxer 在使用第三方控件时,常为枚举值犯愁,这里提供一个简单的方法 1. 下载这个修改过的对象浏览器:http://download.csdn.net/detail/dkfdtf/949...

使用 BLOB 类型字段

vfp9 中增加了 blob 型字段,这可是个好东西!用它来存储图像数据最合适,与 SQL 的交换也很顺利,接下来就是使用它了。使用它当然无外乎是显示/打印图像;显示很简单,表单上放一个 Image ...
  • dkfdtf
  • dkfdtf
  • 2008-09-05 23:32
  • 4932

编程实现可执行文件的数字签名验证及证书安装

为何要制作数字签名,请参见我以前的文章 http://dkfdtf.blogbus.com/logs/10896854.html,我最近的一个项目也需要实现自验证功能,狐狸天堂上的金威先生也恰好有这个...
  • dkfdtf
  • dkfdtf
  • 2009-07-14 22:09
  • 9503

让 Anchor 属性拥有设计时行为

用过 vfp9 的人都知道这个好用的新属性,宿主控件大小变化时,其内部控件可以用这个属性来自动调整它们的位置和大小,不用再像 vfp6 中要写代码来调整;不过,大家也看到了,这个属性只是一个运行时行为...

改变 vfp 可执行文件的运行库位置和名称

今天分析了一下如何将 vfp 的 exe 运行时要使用的运行库更名的问题。下面是分析结果,以 vfp9 + 简体中文 Windows 系统为例。我们知道,编译成 exe 的 vfp 程序要加载两个运行...
  • dkfdtf
  • dkfdtf
  • 2009-04-07 17:05
  • 2303

身份证号15位转18位

源自:http://blog.csdn.net/zhanghongju/archive/2009/06/11/4261422.aspx做少量修改,传15位转18位,传17补18位,传18位验证最后一位...
  • dkfdtf
  • dkfdtf
  • 2009-06-26 21:11
  • 1777

转帖:使用 .NET ClickOnce 技术发布和更新 vfp 应用程序

xinjie 最新翻译力作,foxer 从现在开始也可以使用 .Net ClickOnce 技术来发布自己的应用程序,拥有可配置的自动更新方式。来自:http://www.foxsky.net/bbs...
  • dkfdtf
  • dkfdtf
  • 2009-08-09 07:13
  • 2654
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

(最多只允许输入30个字)