Convert hBMP to hIcon (Gary+Paul)

Category: Convert Bitmap to Icon

Date: 03-28-2012

Return to Index


 
'... this snippet is in work
 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
#Resource "gbsnippets.pbr"
 
Global hDlg As DWord, P As IconInfo, w As Long, h As Long, bmp$, hLst As DWord
Global bmpXOR() As Byte, bmpAND() As Byte, hIcon As DWord
Global hBMPXor As DWord, hBMPAnd As DWord
%ID_Graphic = 400 : %ID_Button = 300
 
Function PBMain() As Long
   Dialog New Pixels, 0, "GDI Convert BMP Test II",300,300,250,260, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %ID_Button,"Convert I", 60,10,120,25
   Control Add Graphic, hDlg, %ID_Graphic,"", 10,70,100,100
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   If CB.Msg = %WM_Command AND CB.Ctl = %ID_Button Then  ConvertBMPtoIcon  : DisplayNewIcon
End Function
 
Sub ConvertBMPtoIcon
   Local i As Long, bmp2$
   'retrieve bitmap string, get w/h
   bmp$ = Bitstring                      'will be XOR bitmap bits - happy face from the DATA statements
   bmp2$ = bmp$                          'will be AND bitmap bits
   w = CVL(bmp$,1) : h = CVL(bmp$,5)     'get w/h from bitstring
 
   'Create an XOR bitmap using bmp$
   Graphic Bitmap New w,h To hBMPXOR
   Graphic Attach hBMPXOR, 0
   Graphic Set Bits bmp$
 
   'Create an AND bitmap - monochrome, transparent backgrounf
   CreateMonoChromeBitmap_Dixon     'use hBMPAND as handle
   CreateMonoChromeBitmap_original  'use hBMPAND as handle
 
   'fill in the Global P variable (ICONINFO), including handles to bmpXOR/bmpAND bitmaps
   P.fIcon = %True
   P.xHotSpot = w/2   'MSDN says this is ignored
   P.yHotSpot = h/2   'MSDN says this is ignored
   P.hbmColor = hBMPXOR
   P.hbmMask = hBMPAND
 
   hIcon = CreateIconIndirect (P)
End Sub
 
Function BitString() As String
   'bit string for:   FACE    16x16
   Local bmp$, i As Long
   Data 000010, 000010, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, 000000, 000000, 000000, 000000, 000000, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000
   Data 000000, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00
   Data FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00
   Data FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000
   Data 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00
   Data 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, 000000
   Data FFFF00, FFFF00, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 808000, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, ECE9D8, 000000, 000000, 000000, 000000, 808000, FFFF00, FFFF00, FFFF00, 000000, ECE9D8
   Data ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, ECE9D8
   Data ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, 000000, 000000, 000000, 000000, 000000, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8
   For i = 1 To Datacount
      bmp$ = bmp$ + Mkl$(Val("&H"+Read$(i)))
   Next i
   Function = bmp$
End Function
 
Sub CreateMonochromeBitmap_Original
   Local i as Long, bmp2$
   'create the monochrome AND bitmask, with &HECE9D8 as the transparent color
   For i = 9 To Len(bmp2$) Step 4
      Mid$(bmp2$,i,4) = IIF$ (CVL(bmp2$,i) = &HECE9D8, Mkl$(Bgr(%Black)), Mkl$(Bgr(%White)) )
   Next
 
   'put the bmp2$ bits in the XOR bitmap
   Graphic Bitmap New w,h To hBMPAnd
   Graphic Attach hBMPAnd, 0
   Graphic Set Bits bmp2$
End Sub
 
Sub CreateMonochromeBitmap_Dixon
   'create the monochrome AND bitmask, with &HECE9D8 as the transparent color
   Local B AS Bitmap, iPos As Long, x As Long
   Dim Mask(1 TO w*h/8) AS Static BYTE
   For x = 9 TO Len(bmp$) Step 4
      '    INCR iPos                     'not here
      If CVL(bmp$,x) = &HECE9D8 Then
         'bit is transparent
         Bit Set Mask(1),(iPos AND &hfffffff8) + 7 - (iPos AND &h7)
      Else
         Bit Reset Mask(1),(iPos AND &hfffffff8) + 7 - (iPos AND &h7)
      End If
      Incr iPos   'put it here instead
   Next
 
   B.bmType = 0
   B.bmWidth = w
   B.bmHeight = h
   B.bmWidthBytes = w/8
   B.bmPlanes = 1
   B.bmBitsPixel = 1
   B.bmBits = VarPTR(Mask(1))   '######### needs to be a pointer to the data
   hBMPAND = CreateBitmapIndirect(B)
 
End Sub
 
Sub DisplayNewIcon
End Sub
 
'gbs_00539
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm