1 Attachment(s)
Bitmap problems [resolved by self!]
This seems weird... I have bitmaps storaged in memory and most of them display correctly, but all ones with odd width and also some others (it is quite random) display incorrectly. Attached is a file that shows what kind of results I get.
Is there a reason for this? I give the bytes correctly. Here is the code I use to storage the graphics to memory:
VB Code:
'IN A CLASS MODULE
Option Explicit
Private BMP_INFO As BITMAPINFO_256, BMP_DATA() As Byte
Private hDIB As Long, hWidth As Integer, hHeight As Integer
Public Sub Create(ByVal NewWidth As Integer, ByVal NewHeight As Integer, ByRef Pixels() As Byte, ByRef Palette() As Byte)
Dim Screen_hDC As Long, A As Integer, B As Long
'set width and height
hWidth = NewWidth
hHeight = NewHeight
B = UBound(Pixels)
'resize graphics array
ReDim BMP_DATA(B)
'copy graphics data
RtlMoveMemory ByVal VarPtr(BMP_DATA(0)), ByVal VarPtr(Pixels(0)), B + 1
'copy palette data
RtlMoveMemory ByVal VarPtr(BMP_INFO.bmiColors(0)), ByVal VarPtr(Palette(0)), UBound(Palette) + 1
'set DIB header
With BMP_INFO.bmiHeader
.biSize = Len(BMP_INFO.bmiHeader)
.biWidth = hWidth ' width in pixels
.biHeight = hHeight ' height in pixels
.biPlanes = 1 ' 1 color plane
.biBitCount = 8 ' 8 bits per pixel
.biCompression = BI_RGB ' no compression
.biSizeImage = 0 ' unrequired with no compression
.biXPelsPerMeter = 0 ' unrequired
.biYPelsPerMeter = 0 ' unrequired
.biClrUsed = 256 ' number colors in color table that are used by the image (0 means all)
.biClrImportant = 256 ' number important colors (0 means all)
End With
'get the screen's device context
Screen_hDC = GetDC(0)
'create the DIB
hDIB = CreateDIBitmap(Screen_hDC, BMP_INFO.bmiHeader, CBM_INIT, BMP_DATA(0), BMP_INFO, DIB_RGB_COLORS)
'free up memory
ReleaseDC 0, Screen_hDC
End Sub
Public Sub Draw(ByRef Form_hDC As Long, ByRef Target_hDC As Long, ByVal TargetWidth As Integer, ByVal TargetHeight As Integer)
Dim Compat_DC As Long
'create a compatible device context
Compat_DC = CreateCompatibleDC(Form_hDC)
'select the DIB into the compatible DC
SelectObject Compat_DC, hDIB
'copy the compatible DC's image to the target
StretchBlt Target_hDC, 0, 0, TargetWidth, TargetHeight, Compat_DC, 0, hHeight - 1, hWidth, -hHeight, vbSrcCopy
'destroy the compatible DC
DeleteDC Compat_DC
End Sub
VB Code:
'IN A MODULE
Option Explicit
Public Const BI_RGB = 0&
Public Const CBM_INIT = &H4
Public Const DIB_RGB_COLORS = 0
Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type BITMAPINFO_256
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As RGBQUAD
End Type
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateDIBitmap Lib "gdi32" (ByVal hDC As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_256, ByVal wUsage As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Hope someone can answer the question. I can't see anything wrong with the code, since it is a modification of a code made by someone else.
Finally! Figured it! Just had to make so that each data row is dividable by four. Code to make this clearer in case somebody happens to have the same problem some day:
VB Code:
Public Sub Create(ByVal NewWidth As Integer, ByVal NewHeight As Integer, ByRef Pixels() As Byte, ByRef Palette() As Byte)
Dim Screen_hDC As Long, A As Integer, B As Long, C As Integer
'set width and height
hWidth = NewWidth
hHeight = NewHeight
B = IIf(hWidth Mod 4, (hWidth + 4 - hWidth Mod 4) * hHeight - 1, UBound(Pixels))
'resize graphics array
ReDim BMP_DATA(B)
If hWidth Mod 4 Then
C = hWidth + 4 - hWidth Mod 4
For A = 0 To hHeight - 1
RtlMoveMemory ByVal VarPtr(BMP_DATA(A * C)), ByVal VarPtr(Pixels(A * hWidth)), hWidth
Next A
Else
'copy graphics data
RtlMoveMemory ByVal VarPtr(BMP_DATA(0)), ByVal VarPtr(Pixels(0)), B + 1
End If
'... rest match with the code above