fast convert rgb to grayscale

Por ejemplo, estas serían las funciones desnudas (tu api call), para
crear el ImageAttibutes y setear el ColorMatrix

GpStatus WINGDIPAPI GdipCreateImageAttributes(GpImageAttributes
**imageattr)

GpStatus WINGDIPAPI GdipSetImageAttributesColorMatrix(GpImageAttributes
*imageattr, ColorAdjustType type, BOOL enableFlag, GDIPCONST
ColorMatrix* colorMatrix, GDIPCONST ColorMatrix* grayMatrix,
ColorMatrixFlags flags)

On 18 nov, 18:07, "Langosta" wrote:

Por ejemplo, estas ser an las funciones desnudas (tu api call),  para
crear el ImageAttibutes y setear el ColorMatrix

GpStatus WINGDIPAPI GdipCreateImageAttributes(GpImageAttributes
**imageattr)

GpStatus WINGDIPAPI GdipSetImageAttributesColorMatrix(GpImageAttributes
*imageattr, ColorAdjustType type, BOOL enableFlag, GDIPCONST
ColorMatrix* colorMatrix, GDIPCONST ColorMatrix* grayMatrix,
ColorMatrixFlags flags)

bien voy a seguir investigando

hasta ahora tengo esto, es 100% funcional, usa acceso directo al
bitmap dentro del objeto StdPicture... por ahi a muchos les sirve para
no tener que andar usando objetos PictureBox.

Podés modificar la imágen dentro del stdpicture sin ningún proceso de
copiarla a ningún lado.

[CODE]

Option Explicit

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr"
_
(Ptr() 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 GetObjectAPI Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As
Long



Private Type SAFEARRAYBOUND

cElements As Long

lLbound As Long

End Type



Private Type SAFEARRAY2D

cDims As Integer

fFeatures As Integer

cbElements As Long

cLocks As Long

pvData As Long

Bounds(0 To 1) As SAFEARRAYBOUND

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

Dim SA As SAFEARRAY2D

Dim BMP As BITMAP

Dim mvarBytesPerPixel



Public Sub LoadPicArray(p As StdPicture, data() As Byte)

' Retrieve bitmap information about p.

If GetObjectAPI(p.Handle, Len(BMP), BMP) Then

mvarBytesPerPixel = BMP.bmWidthBytes \ BMP.bmWidth

' Make the local matrix point to bitmap pixels.

With SA

.cbElements = 1

.cDims = 2

.Bounds(0).lLbound = 0

.Bounds(0).cElements = BMP.bmHeight

.Bounds(1).lLbound = 0

.Bounds(1).cElements = BMP.bmWidthBytes

.pvData = BMP.bmBits

End With

' Copy bitmap pointer to array pointer.

CopyMemory ByVal VarPtrArray(data), VarPtr(SA), 4

End If

End Sub

Public Sub ReleaseData(data() As Byte)

CopyMemory ByVal VarPtrArray(data), 0&, 4

End Sub

Public Sub GrayScale(data() As Byte)
Dim c As Byte, x As Long, xx As Long, y As Long

Select Case mvarBytesPerPixel
Case 3
' Solo si es 24bpp.
For x = 0 To BMP.bmWidth - 1
xx = x * 3
For y = 0 To BMP.bmHeight - 1
c = data(xx, y) * 0.114 + data(xx + 1, y) * 0.587 +
data(xx + 2, y) * 0.2989
data(xx, y) = c ' Azul.
data(xx + 1, y) = c ' Verde.
data(xx + 2, y) = c ' Rojo.
Next y
Next x
End Select

End Sub

[/CODE]

esto va en un módulo standard (.bas)

y este módulo se usa así..



dim pic as stdpicture
dim data() as byte

set pic = loadpicture("blabla")

Call LoadPicArray(pic, data)
Call GrayScale(data)
Call ReleaseData(data)

en fin, te convierte a escala de grises la imagen contenida en el
StdPicture.

como usa acceso directo a memoria, es decir, no se llama a ninguna
API, es realmente muy rápida.

el código para el acceso al bitmap de un stdpicture lo saqué de otro
lado, no recuerdo donde, la rutina GrayScale la hice yo...

que lo disfruten.

KEYS: grayscale, stdpicture, convert, convertion

"flyguille" escribió en el mensaje de noticias
news:
On 18 nov, 18:07, "Langosta" wrote:

bien voy a seguir investigando

hasta ahora tengo esto, es 100% funcional, usa acceso directo al
bitmap dentro del objeto StdPicture... por ahi a muchos les sirve para
no tener que andar usando objetos PictureBox.

Podés modificar la imágen dentro del stdpicture sin ningún proceso de
copiarla a ningún lado.

[CODE]

Option Explicit

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr"
_
(Ptr() 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 GetObjectAPI Lib "gdi32" Alias "GetObjectA" _
(ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As
Long



Private Type SAFEARRAYBOUND

cElements As Long

lLbound As Long

End Type



Private Type SAFEARRAY2D

cDims As Integer

fFeatures As Integer

cbElements As Long

cLocks As Long

pvData As Long

Bounds(0 To 1) As SAFEARRAYBOUND

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

Dim SA As SAFEARRAY2D

Dim BMP As BITMAP

Dim mvarBytesPerPixel



Public Sub LoadPicArray(p As StdPicture, data() As Byte)

' Retrieve bitmap information about p.

If GetObjectAPI(p.Handle, Len(BMP), BMP) Then

mvarBytesPerPixel = BMP.bmWidthBytes \ BMP.bmWidth

' Make the local matrix point to bitmap pixels.

With SA

.cbElements = 1

.cDims = 2

.Bounds(0).lLbound = 0

.Bounds(0).cElements = BMP.bmHeight

.Bounds(1).lLbound = 0

.Bounds(1).cElements = BMP.bmWidthBytes

.pvData = BMP.bmBits

End With

' Copy bitmap pointer to array pointer.

CopyMemory ByVal VarPtrArray(data), VarPtr(SA), 4

End If

End Sub

Public Sub ReleaseData(data() As Byte)

CopyMemory ByVal VarPtrArray(data), 0&, 4

End Sub

Public Sub GrayScale(data() As Byte)
Dim c As Byte, x As Long, xx As Long, y As Long

Select Case mvarBytesPerPixel
Case 3
' Solo si es 24bpp.
For x = 0 To BMP.bmWidth - 1
xx = x * 3
For y = 0 To BMP.bmHeight - 1
c = data(xx, y) * 0.114 + data(xx + 1, y) * 0.587 +
data(xx + 2, y) * 0.2989
data(xx, y) = c ' Azul.
data(xx + 1, y) = c ' Verde.
data(xx + 2, y) = c ' Rojo.
Next y
Next x
End Select

End Sub

[/CODE]

esto va en un módulo standard (.bas)

y este módulo se usa así..



dim pic as stdpicture
dim data() as byte

set pic = loadpicture("blabla")

Call LoadPicArray(pic, data)
Call GrayScale(data)
Call ReleaseData(data)

en fin, te convierte a escala de grises la imagen contenida en el
StdPicture.

como usa acceso directo a memoria, es decir, no se llama a ninguna
API, es realmente muy rápida.

el código para el acceso al bitmap de un stdpicture lo saqué de otro
lado, no recuerdo donde, la rutina GrayScale la hice yo...

que lo disfruten.

KEYS: grayscale, stdpicture, convert, convertion


==
Está bueno. Debería hacerlo rápido.

Y supongo que sería más rápido si en vez de editar el array de 24bits,
outputearas una nueva imagen de sólo 8 bits. El valor <c> calculado
sería cada pixel de la nueva imagen. Digamos, si el valor es 177,
referiría a la entrada 177 de la paleta con su rgb valiendo el gris
(177, 177, 177).

otraData(xx, y) = data(xx, y) * 0.114 + data(xx + 1, y) * 0.587 +
data(xx + 2, y) * 0.2989

Todo bien.

On 18 nov, 20:17, "Langosta" wrote:

"flyguille" escribió en el mensaje de noticiasnews:
On 18 nov, 18:07, "Langosta" wrote:

> bien voy a seguir investigando

hasta ahora tengo esto, es 100% funcional, usa acceso directo al
bitmap dentro del objeto StdPicture... por ahi a muchos les sirve para
no tener que andar usando objetos PictureBox.

Podés modificar la imágen dentro del stdpicture sin ningún proceso de
copiarla a ningún lado.

[CODE]

Option Explicit

Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr"
_
     (Ptr() 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 GetObjectAPI Lib "gdi32" Alias "GetObjectA" _
     (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As
Long

Private Type SAFEARRAYBOUND

    cElements As Long

    lLbound As Long

End Type

Private Type SAFEARRAY2D

    cDims As Integer

    fFeatures As Integer

    cbElements As Long

    cLocks As Long

    pvData As Long

    Bounds(0 To 1) As SAFEARRAYBOUND

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

Dim SA As SAFEARRAY2D

Dim BMP As BITMAP

Dim mvarBytesPerPixel

Public Sub LoadPicArray(p As StdPicture, data() As Byte)

' Retrieve bitmap information about p.

If GetObjectAPI(p.Handle, Len(BMP), BMP) Then

    mvarBytesPerPixel = BMP.bmWidthBytes \ BMP.bmWidth

    ' Make the local matrix point to bitmap pixels.

    With SA

      .cbElements = 1

      .cDims = 2

      .Bounds(0).lLbound = 0

      .Bounds(0).cElements = BMP.bmHeight

      .Bounds(1).lLbound = 0

      .Bounds(1).cElements = BMP.bmWidthBytes

      .pvData = BMP.bmBits

    End With

    ' Copy bitmap pointer to array pointer.

    CopyMemory ByVal VarPtrArray(data), VarPtr(SA), 4

End If

End Sub

Public Sub ReleaseData(data() As Byte)

CopyMemory ByVal VarPtrArray(data), 0&, 4

End Sub

Public Sub GrayScale(data() As Byte)
Dim c As Byte, x As Long, xx As Long, y As Long

Select Case mvarBytesPerPixel
    Case 3
        ' Solo si es 24bpp.
        For x = 0 To BMP.bmWidth - 1
            xx = x * 3
            For y = 0 To BMP.bmHeight - 1
                c = data(xx, y) * 0.114 + data(xx + 1, y) * 0.587 +
data(xx + 2, y) * 0.2989
                data(xx, y) = c    ' Azul.
                data(xx + 1, y) = c ' Verde.
                data(xx + 2, y) = c ' Rojo.
            Next y
        Next x
End Select

End Sub

[/CODE]

esto va en un módulo standard (.bas)

y este módulo se usa así..

dim pic as stdpicture
dim data() as byte

set pic = loadpicture("blabla")

Call LoadPicArray(pic, data)
Call GrayScale(data)
Call ReleaseData(data)

en fin, te convierte a escala de grises la imagen contenida en el
StdPicture.

como usa acceso directo a memoria, es decir, no se llama a ninguna
API, es realmente muy rápida.

el código para el acceso al bitmap de un stdpicture lo saqué de otro
lado, no recuerdo donde, la rutina GrayScale la hice yo...

que lo disfruten.

KEYS: grayscale, stdpicture, convert, convertion

==>
Está bueno. Debería hacerlo rápido.

Y supongo que sería más rápido si en vez de editar el array de 24bits,
outputearas una nueva imagen de sólo 8 bits. El valor <c> calculado
sería cada pixel de la nueva imagen. Digamos, si el valor es 177,
referiría a la entrada 177 de la paleta con su rgb valiendo el gris
(177, 177, 177).

otraData(xx, y) = data(xx, y) * 0.114 + data(xx + 1, y) * 0.587 +
data(xx + 2, y) * 0.2989

Todo bien.

está buena la recomendación, pero pasar la imagen a 8bpp, implicaría
cambiar los atributos de la imagen, redireccionar el array.

Ese código está hermoso básicamente lo que hace es modificar el
puntero de la variable array q le pases de modo que, dimenciona la
variable que le pases a un array 2D (2 elementos) del tamaño de la
imagen, y sobreescribe el puntero de memoria del array (el q indica en
donde están almacenados los valores del array), para superponer en
memoria la ubicación de la imagen (el bitmap) con los valores
accesibles a través de la variable array ,valores que la misma rutina
dimensiona, vos solo le tenés que pasar un array vacío.

Una vez que ya hayas trabajado con el array, debes borrar el puntero
de la variable array, para que al descargarla no afecte al objeto
stdpicture.

en pocas palabras superpone en memoria RAM el objeto stdpicture con
los datos accesible de una simple variable array. De esa forma,
leyendo, escribiendo el array accedemos la imagen del StdPicture
cosa q en todos lados, en muchos sitios de internet decían q no, que
con VB6 no se podía tener acceso directo para modificar la imagen bla
bla bla bla

bla bla bla , bla bla bla.