[bmx] [Win32] Icon to Pixmap/Image by grable [ 1+ years ago ]

[BlitzBot]

Title : [Win32] Icon to Pixmap/Image
Author : grable
Posted : 1+ years ago

Description : Should be able to load from any icon resource (dll,exe,ico)

Its not perfect though, it has problems with some 32bit icons.
Especially those with alpha.

If you know how to fix this please let me know =)

Code :

Code: BlitzMax

1. ?Win32
2. Type TIconInfo
3.         Field fIcon:Int
4.         Field xHotspot:Int
5.         Field yHotspot:Int
6.         Field hbmMask:Int
7.         Field hbmColor:Int
8. EndType
9.  
10. Type TBitmap
11.         Field bmType:Int
12.         Field bmWidth:Int
13.         Field bmHeight:Int
14.         Field bmWidthBytes:Int
15.         Field bmPlanes:Short
16.         Field bmBitsPixel:Short
17.         Field bmBits:Byte Ptr
18. EndType
19.  
20. Extern "Win32"
21.         Const DI_MASK:Int = 1
22.         Const DI_IMAGE:Int = 2
23.         Const DI_NORMAL:Int = 3
24.         Const DI_COMPAT:Int = 4
25.         Const DI_DEFAULTSIZE:Int = 8
26.        
27.         Function ExtractIconA:Int( hwnd:Int, filename$z, index:Int)
28.         Function GetIconInfo( icon:Int, iinfo:Byte Ptr)
29.         Function GetObjectA:Int( handle:Int, size:Int, binfo:Byte Ptr)
30.         Function DrawIconEx:Int( dc:Int, x:Int,y:Int, icon:Int, w:Int,h:Int, anicurstep:Int, flickerfreebrush:Int, flags:Int)
31.         Function GetDIBits:Int( dc:Int, bm:Int, x:Int,y:Int, src:Byte Ptr, bmi:Byte Ptr, flags:Int)    
32. EndExtern      
33.  
34. Function IconToPixmap:TPixmap( icon:Int, getmask:Int = False)
35.         Local width:Int,height:Int, bits:Int
36.         Local info:TIconInfo = New TIconInfo   
37.         Local bitmap:TBitmap = New TBitmap
38.         If icon <> 0 And GetIconInfo( icon, info) Then
39.                 If GetObjectA( info.hbmColor, SizeOf(bitmap), bitmap) <> 0 Then
40.                         width = bitmap.bmWidth
41.                         height = bitmap.bmHeight
42.                         'bits = bitmap.bmBitsPixel
43.                         ' seems most icons work with 24 bits, but some need 32 bits. how to detect this?
44.                         bits = 24      
45.         EndIf                  
46.                 DeleteObject( info.hbmMask)
47.                 DeleteObject( info.hbmColor)
48.         EndIf
49.         If width <> 0 And height <> 0 Then
50.                        
51.                 Local dc:Int = GetDC(0)
52.                 Local mdc:Int = CreateCompatibleDC(dc)
53.                 Local bm:Int = CreateCompatibleBitmap( dc, width,height)
54.                 If Not bm Then Return Null
55.                 Local oldbm:Int = SelectObject( mdc, bm)
56.  
57.                 If getmask Then
58.                         DrawIconEx( mdc, 0, 0, icon, 0,0,0, Null, DI_MASK)
59.                 Else
60.                         DrawIconEx( mdc, 0, 0, icon, 0,0,0, Null, DI_IMAGE)
61.                 EndIf
62.                
63.                 Local bi:BITMAPINFOHEADER = New BITMAPINFOHEADER
64.                 bi.biSize = SizeOf(bi)
65.                 bi.biWidth = width
66.                 bi.biHeight = height
67.                 bi.biPlanes = 1
68.                 bi.biBitCount = bits
69.                 bi.biCompression = BI_RGB
70.                
71.                 Local pixmap:TPixmap
72.                 Select bits
73.                         Case 24 pixmap = CreatePixmap( width,height, PF_BGR888)
74.                         Case 32 pixmap = CreatePixmap( width,height, PF_BGRA8888)
75.                         Default
76.                                 Throw "IconToPixmap() supports only 24 and 32 bits (got " + bits + ")"
77.                 EndSelect              
78.                
79.                 Local src:Byte Ptr = pixmap.Pixels
80.                 For Local y:Int = 0 Until height
81.                         GetDIBits( mdc, bm, height - y - 1,1, src, bi, DIB_RGB_COLORS)
82.                         src :+ pixmap.Pitch
83.                 Next
84.                
85.                 SelectObject( mdc, oldbm)
86.                 DeleteObject( bm)
87.                 DeleteDC( mdc)
88.                 Return pixmap
89.         EndIf
90. EndFunction
91. ?
92.  
93. Function LoadFileIconImage:TImage( fn:String, id:Int = 0)
94. ?Win32
95.         Local icon:Int = ExtractIconA( 0, fn, id)
96.         If icon <> 0 Then
97.                 Local mask:TPixmap = IconToPixmap( icon, True).Convert( PF_BGRA8888)
98.                 Local pix:TPixmap = IconToPixmap( icon).Convert( PF_BGRA8888)
99.                 Local mp:Int Ptr = Int Ptr mask.Pixels
100.                 Local pp:Int Ptr = Int Ptr pix.Pixels
101.                 For Local i:Int = 0 Until pix.Width * pix.Height
102.                         If mp[i] = $FFFFFFFF Then
103.                                 pp[i] :& $00FFFFFF
104.                         EndIf
105.                 Next
106.                 Return LoadImage( pix, 0)
107.         EndIf
108. ?
109.         Return Null
110. EndFunction

Comments : none...