Image conversion
'Features Picture Object Related Action' Category Module
Option expedition
'********************************************************** *************** '* Convert ICON object to VB's Picture object' * parameter: Hicon an effective icon handle '*********** *********************************************************** *** Function icontopicture (Byval Hicon As Long) AS iPicture Dim IPIC AS iPicture Dim Picdes As PictDesc, IIDIPICTURE AS IID
If hIcon = hNull Then Exit Function picdes.cbSizeofstruct = Len (picdes) picdes.picType = vbPicTypeIcon picdes.hgdiobj = hIcon 'Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} iidIPicture.Data1 = & H7BF80980 iidIPicture.Data2 = & HBF32 iidIPicture.Data3 = & H101A iidIPicture.Data4 (0) = & H8B iidIPicture.Data4 (1) = & HBB iidIPicture.Data4 (2) = & H0 iidIPicture.Data4 (3) = & HAA iidIPicture.Data4 (4) = & H0 iidIPicture.Data4 (5) = & H30 Iidipicture.Data4 (6) = & HC Iidipicture.Data4 (7) = & Hab OlecreatePictureIndirect Picdes, Iidipicture, True, IPIC Set icontopicture = ipicnd function
'********************************************************** ***************** '* Convert Cursor object to VB's Picture object' * parameter: Hicon A valid cursor handle '*********** *********************************************************** ***** Function Cursortopicture (Byval Hicon As Long) As iPicture 'It's Just An Alias Set Cursortopicture = ICONTOPICTURE (HICON) END FUNCTION
'********************************************************** ***************** '* Convert Bitmap object to VB's Picture object' * parameter: HBMP a valid bitmap handle '* HPAL a valid palette handle' *********************************************************** **************** Function BitmapToPicture (ByVal hBmp As Long, _ Optional ByVal hPal As Long = hNull) As IPicture Dim ipic As IPicture Dim picdes As PICTDESC, iidIPicture As IID picdes.cbSizeofstruct = Len (picdes) picdes.picType = vbPicTypeBitmap picdes.hgdiobj = hBmp picdes.hPalOrXYExt = hPal 'Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB} iidIPicture.Data1 = & H7BF80980 iidIPicture.Data2 = & HBF32 iidIPicture.Data3 = & H101A iidIPicture.Data4 (0) = & H8B iidIPicture.Data4 (1) = & HBB iidIPicture.Data4 (2) = & H0 iidIPicture.Data4 (3) = & HAA iidIPicture.Data4 (4) = & H0 iidIPicture.Data4 (5) = & H30 Iidipicture.data4 (6) = & hc iidipicture.data4 (7) = & HabolecreatePictureIndirect PicDes, IIDIPICTURE, TRUE, IPIC SET BITMAPTOPICTURE = ipicnd function
The above code from: the source code database (SourceDataBase) Current Version: 1.0.436 Author: Shawls profile: Http://Shawls.Yeah.Net E-Mail: ShawFile@163.Net QQ: 9181729
