on VB6 how i get the colors values?

[Joaquim_5]

i use the RtlFillMemory():

Call RtlFillMemory(ByVal DataPtr, DIBInf.bmiHeader.biSizeImage, &H80)

the '&H80' is the mid-grey color.... what are the others colors code?

[SCBWV]

There are color constants in VB6 for the basic colors. Specifying the color with hex or RGB values allows you to select one of 16,777,216, thus there aren't constants for all of them.

vbBlack 0x0
vbRed 0xFF
vbGreen 0xFF00
vbYellow 0xFFFF
vbBlue 0xFF0000
vbMagenta 0xFF00FF
vbCyan 0xFFFF00
vbWhite 0xFFFFFF

[Joaquim_5]

Private Declare Sub RtlFillMemory Lib "Kernel32.dll" ( _
ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Long)

with RtlFillMemory() i only get black and white :(

Private Function AlignScan(ByVal inWidth As Long, ByVal inDepth As Integer) As Long
    AlignScan = (((inWidth * inDepth) + &H1F) And Not &H1F&) \ &H8
End Function


Private Sub Form_Load()
    Me.Show
    With DIBInf.bmiHeader
        .biSize = Len(DIBInf.bmiHeader)
        .biWidth = 100
        .biHeight = -100
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = AlignScan(.biWidth, .biBitCount) * -.biHeight
        '.biXPelsPerMeter = (GetDeviceCaps(MemhDC, HORZRES) / _
            'GetDeviceCaps(MemhDC, HORZSIZE)) * 1000
        '.biYPelsPerMeter = (GetDeviceCaps(hDC, VERTRES) / _
            'GetDeviceCaps(MemhDC, VERTSIZE)) * 1000
        .biClrUsed = 0
        .biClrImportant = 0
    End With
    MemhDC = CreateCompatibleDC(0&)
    hDIB = CreateDIBSection(MemhDC, DIBInf, DIB_RGB_COLORS, DataPtr, 0, 0)
    Form1.AutoRedraw = True ' Messy, but ok for test
    hOldBMP = SelectObject(MemhDC, hDIB)
    Call RtlFillMemory(ByVal DataPtr, DIBInf.bmiHeader.biSizeImage, vbRed)
    Call BitBlt(Form1.hDC, 0, 0, DIBInf.bmiHeader.biWidth, _
    -DIBInf.bmiHeader.biHeight, MemhDC, 0, 0, vbSrcCopy)
    Call SelectObject(MemhDC, hOldBMP)



End Sub

[SCBWV]

I don't know. RflFillMemory expects a long for the Fill, so perhaps try &HFF&

[Joaquim_5]

'&HFF&' give me white :(
the problem here is: why i can't use another colors?

[SCBWV]

You haven't posted enough code for me to use in replicating the error. Perhaps attach as zip of files that include your types and definitions.

[Joaquim_5]

Option Explicit

Private Type BITMAPINFOHEADER ' 40 bytes
    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

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(0 To 255) As Long
End Type
Private Const BI_RGB As Long = &H0
Private Const DIB_RGB_COLORS As Long = &H0 ' Colour table in RGBs

Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, _
ByRef pBMI As BITMAPINFO, ByVal iUsage As Long, ByRef ppvBits As Long, _
ByVal hSection As Long, ByVal dwOffset As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32.dll" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const HORZSIZE As Long = &H4 ' Horizontal size in millimetres
Private Const VERTSIZE As Long = &H6 ' Vertical size in millimetres
Private Const HORZRES As Long = &H8 ' Horizontal width in pixels
Private Const VERTRES As Long = &HA ' Vertical width in pixels

Private Declare Function SelectObject Lib "gdi32.dll" ( _
ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Sub RtlFillMemory Lib "Kernel32.dll" ( _
ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Long)

Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" ( _
ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Long, Source As Any, ByVal Length As Long)

Private Type Bitmap ' 24 bytes
    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 DIBSection
    dsBm As Bitmap
    dsBmih As BITMAPINFOHEADER
    dsBitfields(0 To 2) As Long
    dshSection As Long
    dsOffset As Long
End Type

Dim DIBInf As BITMAPINFO
Dim hOldBMP As Long
Dim MemhDC As Long
Dim hDIB As Long
Dim DataPtr As Long

Private Function AlignScan(ByVal inWidth As Long, ByVal inDepth As Integer) As Long
    AlignScan = (((inWidth * inDepth) + &H1F) And Not &H1F&) \ &H8
End Function


Private Sub Form_Load()
    Me.Show
    With DIBInf.bmiHeader
        .biSize = Len(DIBInf.bmiHeader)
        .biWidth = 100
        .biHeight = -100
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = AlignScan(.biWidth, .biBitCount) * -.biHeight
        '.biXPelsPerMeter = (GetDeviceCaps(MemhDC, HORZRES) / _
            'GetDeviceCaps(MemhDC, HORZSIZE)) * 1000
        '.biYPelsPerMeter = (GetDeviceCaps(hDC, VERTRES) / _
            'GetDeviceCaps(MemhDC, VERTSIZE)) * 1000
        .biClrUsed = 0
        .biClrImportant = 0
    End With
    MemhDC = CreateCompatibleDC(0&)
    hDIB = CreateDIBSection(MemhDC, DIBInf, DIB_RGB_COLORS, DataPtr, 0, 0)
    Form1.AutoRedraw = True ' Messy, but ok for test
    hOldBMP = SelectObject(MemhDC, hDIB)
    Call RtlFillMemory(ByVal DataPtr, DIBInf.bmiHeader.biSizeImage, &HFF&)
    Call BitBlt(Form1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, _
    -DIBInf.bmiHeader.biHeight, MemhDC, 0, 0, vbSrcCopy)
    Call SelectObject(MemhDC, hOldBMP)



End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call DeleteObject(hDIB)
    Call DeleteDC(hdc)
End Sub

[SCBWV]

The error is in the color value, and I don't know what value would display red. I randomly achieved a gray with the code below, which is improved from your code. I'm not sure why you were assigning a negative value to biHeight, then taking a negative of the negative to achieve a positive. Fixed in the code below.

Private Sub Form_Load()
    Me.Show
    With DIBInf.bmiHeader
        .biSize = Len(DIBInf.bmiHeader)
        .biWidth = 100
        .biHeight = 100
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = AlignScan(.biWidth, .biBitCount) * .biHeight
        '.biXPelsPerMeter = (GetDeviceCaps(MemhDC, HORZRES) / _
            'GetDeviceCaps(MemhDC, HORZSIZE)) * 1000
        '.biYPelsPerMeter = (GetDeviceCaps(hDC, VERTRES) / _
            'GetDeviceCaps(MemhDC, VERTSIZE)) * 1000
        .biClrUsed = 0
        .biClrImportant = 0
    End With
    MemhDC = CreateCompatibleDC(0&)
    hDIB = CreateDIBSection(MemhDC, DIBInf, DIB_RGB_COLORS, DataPtr, 0, 0)
    Form1.AutoRedraw = True ' Messy, but ok for test
    hOldBMP = SelectObject(MemhDC, hDIB)
    Call RtlFillMemory(ByVal DataPtr, DIBInf.bmiHeader.biSizeImage, &H808080)
    Call BitBlt(Form1.hdc, 0, 0, DIBInf.bmiHeader.biWidth, DIBInf.bmiHeader.biHeight, MemhDC, 0, 0, vbSrcCopy)
    Call SelectObject(MemhDC, hOldBMP)
End Sub

[Joaquim_5]

'&H808080' is gray :(
"I'm not sure why you were assigning a negative value to biHeight, then taking a negative of the negative to achieve a positive."
if is positive, when we change a pixel, the Y start point is on bottom, instead on top ;)