Date: 02-16-2022
Return to Index
created by gbSnippets
'Primary Code:
'Credit: Peter
'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, hBMP As DWord, bmp$, w As Long, h As Long
Global bmpAND() As Byte, bmpXOR() As Byte, hIcon As DWord
%ID_Graphic = 400 : %ID_Button = 300
Function PBMain() As Long
Dialog New Pixels, 0, "GDI Load Image Test",300,300,250,260, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %ID_Button,"Convert", 60,10,90,25
' CONTROL ADD GRAPHIC, hDlg, %ID_Graphic,"", 10,40,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 AND CB.Ctlmsg = %BN_Clicked Then
ConvertBMPtoIcon
'use the icon to show it works
SendMessage hDlg, %WM_SETICON, %ICON_SMALL, hIcon
' Show the source icon, just so we know it's ok.
Control Add Graphic, hDlg, %ID_Graphic, "", 10, 40, w, h
Graphic Attach hDlg, %ID_Graphic
Graphic Set Bits bmp$
Graphic Detach
End If
End Function
Sub ConvertBMPtoICON
Local i As Long
'retrieve bitmap string, get w/h
bmp$ = Bitstring 'happy face from the DATA statements
w = CVL(bmp$,1) : h = CVL(bmp$,5) 'get w/h from bitstring
'convert bmp$ to AND and XOR bytes arrays
CreateIconByteArrays
'create an icon using w,h and the Byte arrays.
' Bitmaps are monochrome, so use 1 for planes / bpp
hIcon = CreateIcon( ByVal %Null, w,h,1,1,ByVal VarPTR(bmpXOR(0)), ByVal VarPTR(bmpAND(0)) )
End Sub
Sub CreateIconByteArrays
Local i As Long, j As Long, colTransparent As Long
Local lByte As Long, lBit As Long
Local bRed, bGreen, bBlue, bGrey As Byte
Local bSetXOR, bSetAND As Byte
Local lWhite As Long, lBlack As Long, lScreen As Long, lReverse As Long
' colTransparent = 0
' colTransparent = RGB(&HFF, &HFF, &H00)
' colTransparent = %WHITE
colTransparent = Rgb(&HEC, &HE9, &HD8)
' How many BYTEs do we need to store (w*h) bits ? (Less 1 for zero-based array)
Dim bmpAND(((w*h) \ 8) - 1) , bmpXOR(((w*h) \ 8) - 1)
' Each four characters in the string equal one Long RGB(A) value
For i = 9 To Len(bmp$) Step 4
bRed = CVByt(bmp$, i + 2)
bGreen = CVByt(bmp$, i + 1)
bBlue = CVByt(bmp$, i + 0)
' Could play around with proportions for better greyscale, but for now, leave at 1 for all
bGrey = ((bRed * 1) + (bGreen * 1) + (bBlue * 1)) \ 3
' IF cvl(bmp$, i) = colTransparent then
If Rgb(bRed, bGreen, bBlue) = colTransparent Then
' Transparent pixel = SCREEN (?)
bSetAND = 0
bSetXOR = 1
Incr lScreen
Else
' If not transparent...
If bGrey > 127 Then
' MSDN says WHITE is AND=0, XOR=1, but tests seem to show vice versa
' White pixel
bSetAND = 1
bSetXOR = 0
Incr lWhite
Else
' Black pixel
bSetAND = 0
bSetXOR = 0
Incr lBlack
End If
End If
If IsTrue(bSetAND) Then
Bit Set bmpAND(0), (lByte * 8) + (8 - lBit) - 1
End If
If IsTrue(bSetXOR) Then
Bit Set bmpXOR(0), (lByte * 8) + (8 - lBit) - 1
End If
Incr lBit
If lBit = 8 Then
Incr lByte
lBit = 0
End If
Next i
MsgBox "Set " & Format$(lScreen) & " as SCREEN, " & Format$(lBlack) & " as BLACK, and " & Format$(lWhite) & " as WHITE"
End Sub
Function BitString() As String
'bit string for: HAPPY FACE 16x16
Local bmp$, i As Long
Data 000010, 000010
Data ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8, 000000, 000000, 000000, 000000, 000000, 000000, ECE9D8, ECE9D8, ECE9D8, ECE9D8, ECE9D8
Data ECE9D8, ECE9D8, ECE9D8, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, ECE9D8, ECE9D8, ECE9D8
Data ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8
Data ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8
Data ECE9D8, 000000, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, 000000, ECE9D8
Data 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000
Data 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000
Data 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000
Data 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000
Data 000000, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, 000000
Data 000000, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, FFFF00, FFFF00, FFFF00, 000000
Data ECE9D8, 000000, FFFF00, FFFF00, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, FFFF00, FFFF00, 000000, ECE9D8
Data ECE9D8, 000000, FFFF00, FFFF00, FFFF00, ECE9D8, 000000, 000000, 000000, 000000, ECE9D8, FFFF00, FFFF00, FFFF00, 000000, ECE9D8
Data ECE9D8, ECE9D8, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, ECE9D8, ECE9D8
Data ECE9D8, ECE9D8, ECE9D8, 000000, 000000, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, FFFF00, 000000, 000000, ECE9D8, ECE9D8, ECE9D8
Data 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
'gbs_00486
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm