[RESOLVED] About ScaleGray

i have these function for do scalegray:

Code:

---

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

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.

Quote:

---

Originally Posted by 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.

---

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

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)

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

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?

Quote:

---

Originally Posted by 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?

---

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

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*

Code:

---

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

---

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