Mike Williams
11/18/2011 10:50:00 AM
"Leo" <ttdhead@gmail.com> wrote in message
news:j9vjtn$j33$1@dont-email.me...
> Mike Williams pretended :
>> [waffle snipped]
>> Private Sub Command1_Click()
>> Dim b(1 To 64) As Byte, temp As Byte, n As Long
>> Open "c:\temp2\PaletteXP.pal" For Binary As 1
>> Get #1, 25, b()
>> Close 1
>> For n = 1 To 60 Step 4
>> temp = b(n)
>> b(n) = b(n + 2)
>> b(n + 2) = temp
>> Next n
>> Open "c:\temp2\BitmapXP.bmp" For Binary As 1
>> Put #1, 55, b()
>> Close 1
>> End Sub
>
> Thanks Mike. I was hoping to do it with GDI since I have
> code to load the resource from the exe as an hBitmap and
> then convert that into a picture object.
I really don't like the various Palette 'black boxes', partly because I
never use low bpp images that contain palettes and partly because the MS
documentation on Palettes is at best confusing and at worst misleading and
incomplete. I've just written some test code to load a 16 colour image and
I've come across various problems loading 16 colour images to a hBitmap in
the way that I want them to load when the image has all 16 palette entries
set to black (as is the case with the original WinXP startup bmp you appear
to be working with, where XP appears to assign suitable palette entries from
a separate palette depending on circumstances). I think the first thing you
need to do is to check whether in your case you do actually have the handle
of a 16 colour bitmap, and that its pixel data has not been messed about
with by whatever code you are using to get it. Try the following code on the
hBitmap you are working with and check the output in the message box when
you run it. The code should report that hBitmap refers a 16 colour bitmap
and it should return the number of pixels that refer to each of the 16
Palette entries. For the image you appear to be working with you should get
a lot of pixels using Palette(0) and each of the other 15 Palette entries
should be used by the number of pixels that you might reasonably expect that
particular image to use. If you get something different, perhaps all pixels
using either Palette(0) or Palette(1) and perhaps none at all using the
other 14 Palette entries, then you need to look at your existing code which
gets the image. Anyway, paste the following into a VB Form containing a
Command Button and read the notes in the Command Button click event and run
the code when you have done what the note asks for. Post back with full
details of the result that you get. I have not included much error checking
in what is simply just testbed code and I have written it specifically for
16 colour bitmaps, so don't expect miracles :-)
Mike
Option Explicit
Private Declare Function GetObject Lib "gdi32" _
Alias "GetObjectA" (ByVal hObject As Long, _
ByVal nCount As Long, lpObject As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (pDst As Any, _
pSrc As Any, ByVal ByteLen As Long)
Private Declare Function VarPtrArray _
Lib "msvbvm60.dll" Alias "VarPtr" _
(Ptr() As Any) As Long
Private Type BmpHeader4Bit
bfType As String * 2
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biDataSize As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
palette(0 To 15) As Long
End Type
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
cElements As Long
lLbound As Long
End Type
Private Sub AnalyzeBitmap(hBmp1 As Long)
Dim sa1 As SAFEARRAY1D, Bmp As BITMAP
Dim pic() As Byte, n As Long
Dim Header As BmpHeader4Bit
GetObject hBmp1, Len(Bmp), Bmp
If Bmp.bmBitsPixel <> 4 Then
MsgBox "This is not a 16 colour bitmap " _
& "(it reports that it is " _
& Bmp.bmBitsPixel & " bpp)"
Exit Sub
End If
' point pic() Byte array to the bitmap bits data
With sa1
.cbElements = 1 ' one byte per element (Byte array)
.cDims = 1 ' one dimension
.lLbound = 0
.cElements = (Bmp.bmHeight * Bmp.bmWidthBytes)
.pvData = Bmp.bmBits ' bitmap bit data
End With
CopyMemory ByVal VarPtrArray(pic), VarPtr(sa1), 4
' check the bits
Dim j As Byte, k As Byte, s1 As String
Dim pal(0 To 15) As Long
For n = LBound(pic) To UBound(pic)
j = (pic(n) And &HF0) \ &H10
k = pic(n) And &HF
pal(j) = pal(j) + 1
pal(k) = pal(k) + 1
Next n
' clear the array to empty
CopyMemory ByVal VarPtrArray(pic), 0&, 4
s1 = "16 colour bitmap (" & Bmp.bmWidth & " x " _
& Bmp.bmHeight & " pixels)" & vbCrLf & vbCrLf
For n = 0 To 15
s1 = s1 & "Palette Entry (" & Format(n) & ") is used by " _
& Format(pal(n)) & " pixels" & vbCrLf
Next n
MsgBox s1
End Sub
Private Sub Command1_Click()
' put here whatever code you are using to get
' your bitmap handle (into a Long called hBitmap
' in this example) and then use the following:
'
AnalyzeBitmap hBitmap
'
End Sub