Как заменить пиксель в структуре BITMAP ?

[ALX_2002]

Челы. Я получил картинку в структуру BITMAP

Код: Выделить всё

Private Type BITMAP '14 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type


GetObject Picture1.Image, Len(PicInfo), PicInfo

'reallocate storage space
BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC

ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte

'Copy the bitmapbits to the array
GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)


Массив получил.

Но там каждый пиксель по 3 байта и вдобавок они в линию записаны.

А как по X и Y изменить цвет пикселя в этой структуре ?

[ALX_2002]

Челы, я что в игноре ???? Или какая то личная / коллективная неприязнь просто ???

Я третий пост делаю и НИ ОДНОГО ОТВЕТА !!!

Если игнор, то так и скажите, что отвечать не собираетесь.

Не могу поверить, что ни кто не может ответить на мой вопрос.

[GSerg]

Главное, за 20 минут он ответ хочет сразу... И обижается ведь... Странно...

Если индексация с нуля, то берёшь число y*bmWidth+x, это первый из трёх байт. Изменяешь его и два следующих. Это r, g, b соответственно. Может быть наоборот.

[ALX_2002]

2 Gserg: УРА ! Живые ! . Не я ж говорю на мои посты перестали отвечать почему то. 3 поста сделал ни в одном ответа не было. Расстроился поимаешь .

Я вроде допёр что куда. Но всё равно чё то код не пашет.

Дебажу...


Пасиб

[GSerg]

Спрашивай, что знаем - будем отвечать...

[ALX_2002]

Чёрт... Долбаусь уже час.

Взял пример с allapi.net

http://www.mentalis.org/apilist/FCF52530F97D901283E74DFB0D54D5D4.html

Вся проблема в следующих строках

Код: Выделить всё

GetObject Picture1.Image, Len(PicInfo), PicInfo
'reallocate storage space


Тут как то вычисляется количество байт в строке.
умножение на 3 вроде понятно. Из-за того что по 3 байта. А вот + 3 для меня остаётся тайной.

Код: Выделить всё

BytesPerLine = (PicInfo.bmWidth * 3 + 3) And &HFFFFFFFC


Тут тоже понять не могу. Почему умножается на 3.

Код: Выделить всё

ReDim PicBits(1 To BytesPerLine * PicInfo.bmHeight * 3) As Byte


Пробывал перебирать массив и так и сяк

Код: Выделить всё

For Y = 1 To PicInfo.bmHeight
     For X = 1 To PicInfo.bmWidth
          PicBits((Y * BytesPerLine) + X) = 0  '255 - PicBits(Cnt + x)
     Next
Next


Хотел просто всю картинку чёрным закрасить. НИ В КАКУЮ ! не идёт

Спасайте братцы

[Юстас]

Надо учитывать, что адрес первого байта каждой новой линии должен быть выравнен на 4

[BV]

А искать, наверно, пробовал?

http://www.google.com/search?client=ope ... 8&oe=utf-8

[ALX_2002]

2 BV: Ммм... Эт я нашёл. на том же Allapi.net

Проблемка одна. GetDIBits работает медленнее.

Хотя возможно я не прав.

Когда проверял тормозило сильнее.

[ALX_2002]

Облом. GetDIbits тормозит. Как я не пытался.

GetBitmapBits работает быстрее, но изменять пиксели в структуре BITMAP так и не смог. Туплю

[keks-n]

Грузи в пикчебокс а потом на его DC GetPixel и SetPixel.

[ALX_2002]

2 keks-n: AФИГЕТЬ ! АФТАР ЖЖЁШЬ !

BY DEFAULT Самый простой, но и САМЫЙ медленный способ !

Неужели я б стал так париться, если б можно было бы так ???

[ALX_2002]

ААААА ! !!! СПАСИТЕ ПОМОГИТЕ !!!!!!

Код: Выделить всё

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
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long

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

Private Sub Command1_Click()
Dim PIX As Long
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'Get information (such as height and width) about the picturebox
    GetObject Picture1.Image, Len(PicInfo), PicInfo
   
    BytesPerLine = PicInfo.bmWidth * 3 + 3
   
    ReDim PicBits(BytesPerLine * PicInfo.bmHeight * 3) As Byte
   
    'Copy the bitmapbits to the array
    GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
       
  '      For Y = 0 To UBound(PicBits) Step (PicInfo.bmWidth * 4) - 1
  '          For X = 0 To (PicInfo.bmWidth * 4) - 1 Step 4
  '              PIX = (Y * BytesPerLine) + X
  '              PicBits(PIX + pixR) = 0
  '              PicBits(PIX + pixG) = 0
  '              PicBits(PIX + pixB) = 0
  '          Next
  '      Next
       
    For Cnt = 0 To UBound(PicBits) - 4 Step 4
        PicBits(Cnt + pixR) = 0
        PicBits(Cnt + pixG) = 0
        PicBits(Cnt + pixB) = 0
    Next
   
    'Set the bits back to the picture
    SetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
    'refresh
    Picture1.Refresh
End Sub

Блин... Бред какой то... Последовательно перебрать могу, а вот с X и Y никак

[Юстас]

Код: Выделить всё

Private Sub Command1_Click()
    GetObject Picture1.Image, Len(PicInfo), PicInfo
    BytesPerLine = PicInfo.bmWidth * 3
   
    ReDim PicBits(BytesPerLine * PicInfo.bmHeight) As Byte
    GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
       
    For Y = 0 To (PicInfo.bmHeight - 1)
        For X = 0 To (PicInfo.bmWidth - 1)
            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 1) = 0
            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 2) = 0
            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 3) = 0
        Next
    Next
    SetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
    Picture1.Refresh
End Sub

Оптимизировать наверное сам сможешь ( вычислять постоянно Y * (PicInfo.bmWidth * 3) во внутреннем цикле необязательно)

[ALX_2002]

Пасиба братуха !

Одна только проблемка. На цвета не попадает.

Код: Выделить всё

            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 1) = 0
            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 2) = 0
            PicBits(Y * (PicInfo.bmWidth * 3) + X * 3 + 3) = 255


[Юстас]

А вообще, если надо конкретный пиксель установить в конкретный цвет (а не просто залить картинку черным), то делается так:

Код: Выделить всё

Private Sub Command1_Click()
    Dim yy As Long, xx As Long
    GetObject Picture1.Image, Len(PicInfo), PicInfo
    BytesPerLine = (PicInfo.bmWidth * 4 + 3) And -4
    ReDim PicBits(0 To BytesPerLine * PicInfo.bmHeight - 1) As Byte
    GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(0)
       
    For Y = 0 To (PicInfo.bmHeight - 1)
        yy = Y * BytesPerLine               'Y-coord to byte offset
        For X = 0 To (PicInfo.bmWidth - 1)
            xx = X * 4                      'X-coord to byte offset
            PicBits(yy + xx + 0) = 0        'blue
            PicBits(yy + xx + 1) = 255      'green
            PicBits(yy + xx + 2) = 255      'red
        Next
    Next
    SetBitmapBits Picture1.Image, UBound(PicBits), PicBits(0)
    Picture1.Refresh
End Sub

Если возникнет вопрос, почему 4, смотри описание структуры RGBQUAD

P.S.
Код из предыдущего поста не позволяет установить конкретный пиксель в конкретный цвет, он именно портит картинку, заливая черным

[ALX_2002]

Чё то как не попробую. Всё равно цвета глючат.

Если все на 0 ставлю, то меняет контраст красного, если первый на 0, то в синезелёный красит.

Кривой я

[ALX_2002]

Во ! Всё пошло ! ПАСИБА !!!!!!!!!!

Код: Выделить всё

    For Y = 0 To (PicInfo.bmHeight - 1)
        yy = Y * BytesPerLine               'Y-coord to byte offset
        For X = 0 To (PicInfo.bmWidth - 1)
            xx = X * 4                     'X-coord to byte offset
            PicBits(yy + xx +[b] 1[/b]) = 255        'blue
            PicBits(yy + xx + [b]2[/b]) = 0      'green
            PicBits(yy + xx + [b]3[/b]) = 0      'red
        Next
    Next


В кодах смещения дело было 0 1 2 заменил на 1 2 3.

Пасиба громадное !

[Юстас]

Вообще-то должно быть 0,1,2 а не 1,2,3. Посмотри на свои строки

Код: Выделить всё

ReDim PicBits(0 To BytesPerLine * PicInfo.bmHeight - 1) As Byte
GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(0)
...
...
SetBitmapBits Picture1.Image, UBound(PicBits), PicBits(0)

У тебя как массив PicBits меряется, от нуля или от единицы?
Должно быть от нуля и смещения 0,1,2

[ALX_2002]

Тьфу. Точно. С единицы было. Пасиб