• Home
 · 
• Graphics
 · 
• Transform any picture and shrink into a 8 color picture.

Transform any picture and shrink into a 8 color picture.

Transform any picture and shrink into a 8 color picture.

API Declarations


'If anybody can help improving this one...



Rate Transform any picture and shrink into a 8 color picture.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    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