by tHuNd3rSp0t (3 Submissions)
Category: Graphics
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 21st January 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Transform any picture and shrink into a 8 color picture.
API Declarations
'If anybody can help improving this one...
VBcoders
Dim thisPoint As Long
Dim colortoDraw As Long
Dim cRed As Byte
Dim cBlue As Byte
Dim cGreen As Byte
Screen.MousePointer = vbHourglass
picFrom.ScaleMode = vbPixels
picTo.ScaleMode = vbPixels
For Y = 1 To picFrom.ScaleHeight - 1
For X = 1 To picFrom.ScaleWidth - 1
thisPoint = picFrom.Point(X, Y)
cRed = thisPoint Mod 256
thisPoint = thisPoint \ 256
cGreen = thisPoint Mod 256
thisPoint = thisPoint \ 256
cBlue = thisPoint Mod 256
thisPoint = 0
If cRed < 128 And cGreen < 128 And cBlue < 128 Then
colortoDraw = 0
ElseIf cRed > 128 And cGreen < 128 And cBlue < 128 Then
colortoDraw = vbRed
ElseIf cRed < 128 And cGreen > 128 And cBlue < 128 Then
colortoDraw = vbGreen
ElseIf cRed < 128 And cGreen < 128 And cBlue > 128 Then
colortoDraw = vbBlue
ElseIf cRed > 128 And cGreen < 128 And cBlue > 128 Then
colortoDraw = vbMagenta
ElseIf cRed > 128 And cGreen > 128 And cBlue < 128 Then
colortoDraw = vbYellow
ElseIf cRed < 128 And cGreen > 128 And cBlue > 128 Then
colortoDraw = vbCyan
Else
colortoDraw = vbWhite
End If
picTo.PSet (X, Y), colortoDraw
Next
DoEvents
Next
Screen.MousePointer = vbDefault
'Copyright©2003 - IceSoft's Development and Design
End Sub