[RESOLVED] About ScaleGray

[joaquim]

i have these function for do scalegray:

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Const DIB_RGB_COLORS = 0&
Private Const BI_RGB = 0&

Private Const pixR As Integer = 3
Private Const pixG As Integer = 2
Private Const pixB As Integer = 1

'Put the image black and white
Public Sub MakeGray(ByVal picColor As PictureBox)
    Dim bitmap_info As BITMAPINFO
    Dim pixels() As Byte
    Dim bytes_per_scanLine As Integer
    Dim pad_per_scanLine As Integer
    Dim X As Integer
    Dim Y As Integer
    Dim ave_color As Byte

    ' Prepare the bitmap description.
    With bitmap_info.bmiHeader
        .biSize = 40
        .biWidth = picColor.ScaleWidth
        ' Use negative height to scan top-down.
        .biHeight = -picColor.ScaleHeight
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        bytes_per_scanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)
        pad_per_scanLine = bytes_per_scanLine - (((.biWidth * .biBitCount) + 7) \ 8)
        .biSizeImage = bytes_per_scanLine * Abs(.biHeight)
    End With

    ' Load the bitmap's data.
    ReDim pixels(1 To 4, 1 To picColor.ScaleWidth, 1 To picColor.ScaleHeight)
    GetDIBits picColor.hdc, picColor.Image, _
        0, picColor.ScaleHeight, pixels(1, 1, 1), _
        bitmap_info, DIB_RGB_COLORS

    ' Modify the pixels.
    For Y = 1 To picColor.ScaleHeight
        For X = 1 To picColor.ScaleWidth
            ave_color = CByte((CInt(pixels(pixR, X, Y)) + _
                pixels(pixG, X, Y) + _
                pixels(pixB, X, Y)) \ 3)
            pixels(pixR, X, Y) = ave_color
            pixels(pixG, X, Y) = ave_color
            pixels(pixB, X, Y) = ave_color
        Next X
    Next Y

    ' Display the result.
    SetDIBits picColor.hdc, picColor.Image, _
        0, picColor.ScaleHeight, pixels(1, 1, 1), _
        bitmap_info, DIB_RGB_COLORS
    picColor.Picture = picColor.Image
End Sub

the picturebox that i use are both pixel scalemode.
in images(*.gif(animated and static); *.ico;*.ani;*.cur and others) is working ok.
but i'm using a strips images too(is a big image that have very subimages and the plus images can do an animation). for use these subimages i use the transparentbl() api function.
in these images(strips) these function doesn't the normal way, can anyone
heres the image for see...
has you can see the 1st, 2nd and 4th are ok, but the 3rd isn't...
can anyone explain to me why?
thanks

[Milk]

As you know TransparentBlt uses a colour to define the transparent area. It looks to me that the colour you have chosen is not unique to the image, hence the red eyes.

[joaquim]

As you know TransparentBlt uses a colour to define the transparent area. It looks to me that the colour you have chosen is not unique to the image, hence the red eyes.

maybe you have right... but i have tested with other images(i tested yesterday) and some images give me the same problem... the transparent color isn't red but cyan, in that image(you can see in my group project(these Sonic 04 copy.gif in Imagens folder)) how can i resolve the problem in my MakeGray() procedure?
thanks

[Milk]

When you make the image grey you make the transparent colour grey also. There is always going to be a risk that the new grey transparent colour will not be unique.

Either the greyscale routine has to check the colour and only change it if it is not the transparent colour, or you could use 1 bit monochrome masks and render the images with BitBlt instead of TransparentBlt. (I suspect transparentBlt uses BitBlt anyway)

[joaquim]

honestly, in moment, i think that isn't the Transparentblt() api function but otherthing.
yesterday i use some static gif images and give me the same problem...
what i can see is that the problem is in my procedure. and i don't know what is the constant neutral of getpixel() api function.
can you give me that constant?
thanks

[Milk]

Trust me, if your making a colour bitmap greyscale that you intend to use TransparentBlt with, there will always be a risk that the mask colour won't be unique.

I have no idea what you mean by constant neutral. Besides you are not even using GetPixel in this procedure. What do you mean?

[joaquim]

Trust me, if your making a colour bitmap greyscale that you intend to use TransparentBlt with, there will always be a risk that the mask colour won't be unique.

I have no idea what you mean by constant neutral. Besides you are not even using GetPixel in this procedure. What do you mean?

i was saying that i wanted use the getpixel() for catch that transparent color and ignore it. but i need to know the constant...
thanks

[Milk]

Okay Joaquim, here are two functions for you.
The first is similar to yours except it calculates the greys correctly (The human eye is more sensitive to some colours than others)
The second allows a colour to be passed which is then ignored, I'm ashamed to admit I used a Goto *coughs*

Option Explicit

Private Type BITMAPINFOHEADER '40 bytes
   Size As Long
   Width As Long
   Height As Long
   Planes As Integer
   BitCount As Integer
   Compression As Long
   SizeImage As Long
   XPelsPerMeter As Long
   YPelsPerMeter As Long
   ClrUsed As Long
   ClrImportant As Long
End Type

Private Type BITMAPINFO
   Header As BITMAPINFOHEADER
   Colors As Long
End Type

Private Type BITMAP '24 bytes
   BMType As Long
   Width As Long
   Height As Long
   WidthBytes As Long
   Planes As Integer
   BitsPixel As Integer
   Bits As Long
End Type

Private Declare Function GetObjectA Lib "gdi32" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long

Public Sub GreyScale(SrcPic As PictureBox, TgtPic As PictureBox)
Dim Bm As BITMAP
Dim Bmi As BITMAPINFO
Dim Pix() As Byte
Dim i As Long
Dim Grey As Long

   'Reliably get the Bitmaps dimensions
   GetObjectA SrcPic.Image.handle, 24, Bm

   'Prepare the Bitmap Information Header
   With Bmi.Header
      .Size = 40
      .Width = Bm.Width
      .Height = Bm.Height
      .Planes = 1
      .BitCount = 32
   End With

   ReDim Pix(Bm.Width * Bm.Height * 4 - 1)
   GetDIBits SrcPic.hdc, SrcPic.Image, 0, Bm.Height, Pix(0), Bmi, 0&
   For i = 0 To UBound(Pix) Step 4
      Grey = (28& * Pix(i) + 151& * Pix(i + 1) + 77& * Pix(i + 2)) \ 256&
      Pix(i) = Grey
      Pix(i + 1) = Grey
      Pix(i + 2) = Grey
   Next i
   SetDIBits TgtPic.hdc, TgtPic.Image, 0, Bm.Height, Pix(0), Bmi, 0&
End Sub

Public Sub GreyScaleP(SrcPic As PictureBox, TgtPic As PictureBox, TransColour As Long)
Dim Bm As BITMAP
Dim Bmi As BITMAPINFO
Dim Pix() As Byte
Dim r As Long, g As Long, b As Long
Dim Grey As Long
Dim tR As Byte, tG As Byte, tB As Byte

   tR = TransColour And 255
   tG = TransColour \ &H100 And 255
   tB = TransColour \ &H10000 And 255
   
   
   'Reliably get the Bitmaps dimensions
   GetObjectA SrcPic.Image.handle, 24, Bm

   'Prepare the Bitmap Information Header
   With Bmi.Header
      .Size = 40
      .Width = Bm.Width
      .Height = Bm.Height
      .Planes = 1
      .BitCount = 32
   End With

   ReDim Pix(Bm.Width * Bm.Height * 4 - 1)
   GetDIBits SrcPic.hdc, SrcPic.Image, 0, Bm.Height, Pix(0), Bmi, 0&
   For b = 0 To UBound(Pix) Step 4
      g = b + 1
      r = g + 1
      If Pix(b) = tB Then
         If Pix(g) = tG Then
            If Pix(r) = tR Then GoTo SkipColour
         End If
      End If
      Grey = (28& * Pix(b) + 151& * Pix(g) + 77& * Pix(r)) \ 256&
      Pix(b) = Grey
      Pix(g) = Grey
      Pix(r) = Grey
SkipColour:
   Next b
   SetDIBits TgtPic.hdc, TgtPic.Image, 0, Bm.Height, Pix(0), Bmi, 0&
End Sub

[joaquim]

thanks 1st problem resolved....
now, with your help, problem resolve...
now every type of images can be converted to scale gray...
thanks