РАБОТА С КАРТИНКОЙ

[el-niko]

У меня есть двухцветная картинка к примеру размером 2 на 2 пикселей. Как сделать, чтобы прога циклом "смотрела" какого цвета точка в в определённом месте изобрпжения и последовательно записывала в переменную следующее: если точка была чёрной прога пишет 1, если белой - пишет 0. Таким образом, если картинка была 2х2 и вехняя левая и нижняя правая точки были чёрными, а остальные 2 - белыми, то прога должна записать в переменную следующее: "1001".

Подскажите пожалуйста ещё как программно перевести данное значение (1001) в 16-ричный код.

Заранне благодарен, спасибо за уделённое мне время

[SHURUP]

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

Private Sub Command1_Click()
Dim res As String
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = True
.AutoSize = True
    For y = 0 To .ScaleHeight - 1
        For x = 0 To .ScaleWidth - 1
            tmpcolor = .Point(x, y)
            If tmpcolor = vbBlack Then res = res & "1" Else res = res & "0"
        Next
    Next
End With
MsgBox res
End Sub


Вместо ".ScaleHeight - 1", ".ScaleWidth - 1" можешь набирать "1"

[el-niko]

А как эту тему перевести в 16-ричный код ?

[SHURUP]

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

For i = 1 To Len(res)
    tmpDec = tmpDec + Val(Mid(res, i, 1)) * 2 ^ (i - 1)
Next
HEXRres = Hex(tmpDec)


[el-niko]

Что-то не прокатило, ошибка номер 6 на последней строке !

[SHURUP]

А что за ошибка, я их пока не помню по номерам!
У меня все работает

[el-niko]

Пожалуйста, напиши мне весь код - объедини и 1 и второй, чтобы переменная res аерекодировалась срезу в 16 код и записывалась в текс. поле, допустим, с имемен KOD

[SHURUP]

Имя текстбокса - txtCOD
Имя пикчуреса - Picture1

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

Private Sub Command1_Click()
Dim res As String
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = True
.AutoSize = True
    For y = 0 To .ScaleHeight - 1
        For x = 0 To .ScaleWidth - 1
            tmpColor = .Point(x, y)
            If tmpColor = vbBlack Then res = res & "1" Else res = res & "0"
        Next
    Next
End With

For i = 1 To Len(res)
    tmpDec = tmpDec + Val(Mid(res, i, 1)) * 2 ^ (i - 1)
Next
HEXRres = Hex(tmpDec)
txtCOD.Text = HEXRres
End Sub

Кстати, а картинка, как я понял далеко не 2х2

[el-niko]

HEXRres = Hex(tmpDec)

в этой строчке выскакивает ошибка "Runtime Error '6' : Overfolow" и всё,чё за косяк хоть ?

=)

[SHURUP]

OverFlow - переполнение

А tmpDec перед ошибкой - сколько?

[el-niko]

Давай выходи на связь по ICQ =)

[tyomitch]

Кхм-кхм
Если картинка и вправду двухцветная, то вместо двойного цикла от SHURUP-а можно просто вызвать GetBitmapBits в Long-переменную.

[GSerg]

Дык же сканлайны выровнены на DWORD, и поэтому так получиться не должно?

[tyomitch]

У монохромных - на WORD
Два ряда как раз поместятся в Long.