DECLARE INTEGER SHGetFileInfo IN shell32;
STRING pszPath,;
LONG dwFileAttributes,;
STRING @psfi,;
LONG cbFileInfo,;
LONG uFlags
DECLARE INTEGER GdipCreateBitmapFromHICON IN gdiplus;
INTEGER hicon,;
INTEGER @hbitmap
DECLARE INTEGER GdipGetImageHeight IN gdiplus;
INTEGER img,;
INTEGER @ imgheight
DECLARE INTEGER GdipGetImageWidth IN gdiplus;
INTEGER img,;
INTEGER @ imgwidth
DECLARE Long GdipSaveImageToFile IN Gdiplus LONG nativeImage, STRING cFile, ;
STRING EncoderClsID,;
STRING EncoderParameters
DECLARE LONG GdipDisposeImage IN Gdiplus LONG nativeImage
Declare Long GdipBitmapSetPixel in GdiPlus.dll ;
Long nativeImage, Long x, Long y, Long argb
Declare Long GdipBitmapGetPixel in GdiPlus.dll ;
Long nativeImage, Long x, Long y, Long @argb
DECLARE INTEGER GdiplusStartup IN gdiplus;
INTEGER @token, STRING @INPUT, INTEGER OUTPUT
FUNCTION SaveIco2Jpg
**定义函数
LPARAMETERS cFilename as string,lcOutputFile as string,utype as long
**cFilename 参数：文件类型，如.xls .mdb 等等
**lcOutputFile参数：保存到本地的文件名称，如 dbf.jpg
**utype参数：图标类型，0为大图标，1为小图标
*******************************************
*算法制作:行者孙(QQ:310727570)
*******************************************
*VFP应用程式算法群:12787940
*******************************************
declareAPIFunction()
LOCAL hToken, cInput
hToken = 0
cInput = PADR(CHR(1), 16, CHR(0))
GdiplusStartup(@hToken, @cInput, 0)
LOCAL cBuffer,nResult,hIcon,hbitmap,argb,imgwidth,imgheigh,ClsID_JPG
ClsID_JPG=0h01F47C55041AD3119A730000F81EF32E
STORE 0 TO hbitmap,argb,imgwidth,imgheight
cBuffer=REPLICATE(CHR(0),1024)
nResult=SHGetFileInfo(cFilename,utype,@cBuffer,1024,272)
hIcon=ctobin(SUBSTR(cBuffer,1,4),'4rs')
GdipCreateBitmapFromHICON(hIcon,@hbitmap)
GdipGetImageHeight(hbitmap,@imgheight)
GdipGetImageWidth(hbitmap,@imgwidth)
FOR i=0 TO imgwidth-1
FOR ii=0 TO imgheight-1
GdipBitmapGetPixel(hbitmap,i,ii,@argb)
IF argb=0
GdipBitmapSetPixel(hbitmap,i,ii,0xFFFFFF)
ENDI
ENDF
ENDF
GdipSaveImageToFile(hbitmap,STRCONV(lcOutputFile+CHR(0),5),ClsID_JPG, NULL)
GdipDisposeImage(hbitmap)
ENDFUNC
========================================以上放到一个program.prg中
调用
=saveico2jpg(cFileName,"c:\app.jpg",0)
this.image1.Picture="c:\app.jpg"
