Date: 02-16-2022
Return to Index
created by gbSnippets
'... this snippet is in work
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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
http://www.garybeene.com/sw/gbsnippets.htm