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

表单上加一个 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
* -----------------------------------------------------


评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值