都市夜猫的专栏

夫君子之行,静以修身,俭以养德。非淡泊勿以明志,非宁静勿以致远。

用 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
* -----------------------------------------------------


阅读更多
个人分类: VFP9 Win32API
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

加入CSDN,享受更精准的内容推荐,与500万程序员共同成长!
关闭
关闭