AtomSoft
Well-Known Member
this is very frustrating heh .. in my mind it should be working but in reality it isnt..
My screen is setup to write from
LEFT to Right then top to bottom like:
So in VB im reading from left to right and top to bottom .. placing the data into a listbox and looping through the listbox (visual array)
I divide each pixel RGB by 17 so 255 == 15 (aka 0x0F) which is the max for each RGB (0xFFF)
Now i get black pretty good but i get sukish results with the rest... here is my 50x50 image i want to convert: (i had to convert to jpg to place here)
VB Code:
My screen is setup to write from
LEFT to Right then top to bottom like:
So in VB im reading from left to right and top to bottom .. placing the data into a listbox and looping through the listbox (visual array)
I divide each pixel RGB by 17 so 255 == 15 (aka 0x0F) which is the max for each RGB (0xFFF)
Now i get black pretty good but i get sukish results with the rest... here is my 50x50 image i want to convert: (i had to convert to jpg to place here)
VB Code:
Code:
Private OnBits(0 To 31) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
ByVal y As Long) As Long
Dim Red As Byte
Dim Green As Byte
Dim Blue As Byte
Dim Color As Long
Public Function LShiftLong(ByVal Value As Long, _
ByVal Shift As Integer) As Long
MakeOnBits
If (Value And (2 ^ (31 - Shift))) Then GoTo OverFlow
LShiftLong = ((Value And OnBits(31 - Shift)) * (2 ^ Shift))
Exit Function
OverFlow:
LShiftLong = ((Value And OnBits(31 - (Shift + 1))) * _
(2 ^ (Shift))) Or &H80000000
End Function
Public Function RShiftLong(ByVal Value As Long, _
ByVal Shift As Integer) As Long
Dim hi As Long
MakeOnBits
If (Value And &H80000000) Then hi = &H40000000
RShiftLong = (Value And &H7FFFFFFE) \ (2 ^ Shift)
RShiftLong = (RShiftLong Or (hi \ (2 ^ (Shift - 1))))
End Function
Private Sub MakeOnBits()
Dim j As Integer, _
v As Long
For j = 0 To 30
v = v + (2 ^ j)
OnBits(j) = v
Next j
OnBits(j) = v + &H80000000
End Sub
Private Sub Command1_Click()
'The following code example counts the number of red pixels on the active form:
' assumes that form's ScaleMode
' is set to 3 - Pixels
Text2 = ""
Text4 = ""
Text3 = ""
Dim x As Long, y As Long
Dim h As Long, count As Long
Dim q As Long, w As Long
Dim tmp As Integer
Dim tmpf As Integer
' cache form's hDC property
h = Picture1.hdc
'For y = 0 To Picture1.ScaleHeight - 1
' For x = 0 To Picture1.ScaleWidth - 1
Dim hMax As Integer, wMax As Integer
hMax = Picture1.ScaleHeight - 1
wMax = Picture1.ScaleWidth - 1
For y = 0 To hMax
For x = 0 To wMax
Color = GetPixel(h, x, y)
Red = Color And &HFF& 'mind the ampersand at the end of constant
Green = (Color And &HFF00&) / 256 'bit masking and "shift"
Blue = (Color And &HFF0000) / 65535 'bit masking and "shift"
Red = Red / 17
Green = Green / 17
Blue = Blue / 17
List1.AddItem Red
List1.AddItem Green
List1.AddItem Blue
Text2.Text = Text2.Text & Red & "-" & Green & "-" & Blue & ", "
Next
Next
h = List1.ListCount - 1
If h Mod 2 = 1 Then List1.AddItem 0
count = List1.ListCount / 2
h = List1.ListCount - 1
For y = 0 To List1.ListCount - 1
tmpf = 0
For x = 0 To 1
tmpf = tmpf Or Val(List1.List(y + x))
If tmpf > 9 Then
Select Case List1.List(y + x)
Case 10
tmpf = tmpf Or &HA
Case 11
tmpf = tmpf Or &HB
Case 12
tmpf = tmpf Or &HC
Case 13
tmpf = tmpf Or &HD
Case 14
tmpf = tmpf Or &HE
Case 15
tmpf = tmpf Or &HF
End Select
End If
If x = 0 Then
tmpf = LShiftLong(tmpf, 4)
End If
Next x
y = y + 2
List2.AddItem tmpf
Next y
Text3 = Str(List1.ListCount - 1)
Text4 = Str(List2.ListCount - 1)
End Sub
Private Sub List1_Click()
Dim x As Integer, y As Integer
Text2.Text = ""
For x = 0 To List1.ListCount - 1
Text2.Text = Text2.Text & List1.List(x) & ","
y = y + 1
If y = 40 Then
y = 0
Text2.Text = Text2.Text & vbNewLine
End If
Next x
Text2.Text = Mid$(Text2.Text, 1, (Len(Text2.Text) - 1))
End Sub
Private Sub List2_Click()
Dim x As Integer, y As Integer
Text2.Text = ""
For x = 0 To List2.ListCount - 1
Text2.Text = Text2.Text & List2.List(x) & ","
y = y + 1
If y = 40 Then
y = 0
Text2.Text = Text2.Text & vbNewLine
End If
Next x
Text2.Text = Mid$(Text2.Text, 1, (Len(Text2.Text) - 1))
End Sub
Private Sub Picture1_Click()
Picture1.Picture = LoadPicture("d:\colors.bmp")
End Sub
