image32.bas

image processing example

Attribute VB_Name = "image32"
Option Explicit
'**********************************
'* CODE BY: PATRICK MOORE (ZELDA) *
'* Feel free to re-distribute or  *
'* Use in your own projects.      *
'* Giving credit to me would be   *
'* nice :)                        *
'*                                *
'* Please vote for me if you find *
'* this code useful :]   -Patrick *
'**********************************
'
'PS: Please look for more submissions to PSC by me
'    shortly.  I've recently been working on a lot
'    :))  All my submissions are under author name
'    "Patrick Moore (Zelda)"

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Public rRed As Long, rBlue As Long, rGreen As Long
Function RGBfromLONG(LongCol As Long)
' Get The Red, Blue And Green Values Of A Colour From The Long Value
Dim Blue As Double, Green As Double, Red As Double, GreenS As Double, BlueS As Double
Blue = Fix((LongCol / 256) / 256)
Green = Fix((LongCol - ((Blue * 256) * 256)) / 256)
Red = Fix(LongCol - ((Blue * 256) * 256) - (Green * 256))
rRed = Red: rBlue = Blue: rGreen = Green
End Function

Function GetRandomNumber(Upper As Integer, Lower As Integer) As Integer
'Get a random number
Randomize
GetRandomNumber = Int((Upper) * Rnd)
End Function

Public Sub S_Noise(picBox, Intensity As Integer)
'Add noise to a picture
Dim X As Integer, W As Integer, H As Integer, Num As Integer, Num2 As Integer
picBox.ScaleMode = 3
W = picBox.ScaleWidth
H = picBox.ScaleHeight
For X = 1 To Intensity * 50
    Randomize
    Num = Int(Rnd * W - 1) + 1
    Randomize
    Num2 = Int(Rnd * H - 1) + 1
    SetPixel picBox.hdc, Num, Num2, GetPixel(picBox.hdc, Num2, Num)
Next X
End Sub
Public Sub S_Pixelate(picBox, Size As Integer)
'Pixelate a picture
Dim W As Integer, H As Integer, NumC As Integer
Dim Color As Long, CA As Integer
Dim C(1 To 100) As Long, S As Integer
Dim G As Long, R As Long, b As Long
picBox.ScaleMode = 3
For H = 0 To picBox.ScaleHeight - 2 Step Size
    For W = 0 To picBox.ScaleWidth - 2 Step Size
        NumC = 1
        For S = 1 To Size
            C(NumC) = GetPixel(picBox.hdc, W, H)
            NumC = NumC + 1
            C(NumC) = GetPixel(picBox.hdc, W + S, H)
            NumC = NumC + 1
            C(NumC) = GetPixel(picBox.hdc, W + S, H + S)
            NumC = NumC + 1
            C(NumC) = GetPixel(picBox.hdc, W, H + S)
            NumC = NumC + 1
        Next S
        For CA = 1 To NumC
            RGBfromLONG C(CA)
            G = G + rGreen
            R = R + rRed
            b = b + rBlue
        Next CA
        R = R / NumC
        G = G / NumC
        b = b / NumC
        Color = RGB(R, G, b)
        
        For S = 0 To Size
            picBox.Line (W + S, H)-(W + S, H + Size), Color, BF
        Next S
    Next W
    DoEvents
Next H
End Sub
Public Sub S_Lighten(Percent As Integer, picBox)
'Lighten a picture
Dim newVal As Integer, H As Integer, W As Integer, K As Integer
Dim C As Long
Dim opRed As Long, opBlue As Long, opGreen As Long

newVal = Percent * 5
picBox.ScaleMode = 3

For W = 0 To picBox.ScaleWidth
    For H = 0 To picBox.ScaleHeight
        C = GetPixel(picBox.hdc, W, H)
        RGBfromLONG C
        opRed = rRed
        opGreen = rGreen
        opBlue = rBlue
        rRed = rRed + newVal
        If rRed > -1 And rRed < 256 Then opRed = rRed
        
        rGreen = rGreen + newVal
        If rGreen > -1 And rGreen < 256 Then opGreen = rGreen
        rBlue = rBlue + newVal
        If rBlue > -1 And rBlue < 256 Then opBlue = rBlue
        If rRed <> 1000 Then
           C = RGB(opRed, opGreen, opBlue)
           SetPixel picBox.hdc, W, H, C
        End If
    Next H
Next W
End Sub


Public Sub S_Darken(Percent As Integer, picBox)
'Darken a picture
Dim newVal As Integer, H As Integer, W As Integer, K As Integer
Dim C As Long
Dim icRed As Long, icBlue As Long, icGreen As Long
Dim opRed As Long, opBlue As Long, opGreen As Long

newVal = Percent * -5
picBox.ScaleMode = 3

For H = 0 To picBox.ScaleHeight
    For W = 0 To picBox.ScaleWidth
        C = GetPixel(picBox.hdc, W, H)
        RGBfromLONG C
        opRed = rRed
        opBlue = rBlue
        opGreen = rGreen
        rRed = rRed + newVal
        If rRed > -1 And icRed < 256 Then opRed = rRed
        
        rGreen = rGreen + newVal
        If rGreen > -1 And rGreen < 256 Then opGreen = rGreen
        rBlue = rBlue + newVal
        If rBlue > -1 And rBlue < 256 Then opBlue = rBlue
        If rRed <> 1000 Then
            If opRed < 0 Then opRed = 0
            If opGreen < 0 Then opGreen = 0
            If opBlue < 0 Then opBlue = 0
           C = RGB(opRed, opGreen, opBlue)
           SetPixel picBox.hdc, W, H, C
        End If
    Next W
Next H
End Sub


Public Sub S_GrayScale(picBox)
'Turn a color image to greyscale
Dim AveCol As Integer, A As Integer
Dim Y As Integer, X As Integer

picBox.ScaleMode = 3
For Y = 0 To picBox.ScaleHeight
    For X = 0 To picBox.ScaleWidth
        AveCol = 0
        A = 0
        RGBfromLONG GetPixel(picBox.hdc, X, Y)
        AveCol = AveCol + rGreen: A = A + 1
        If AveCol <= 0 Then AveCol = 0
        AveCol = (AveCol / A)
        SetPixel picBox.hdc, X, Y, RGB(AveCol, AveCol, AveCol)
    Next X
Next Y
End Sub


Function LightenPixel(pixelLong As Long, Percent As Integer)
'Lighten only one pixel
Dim newVal As Integer, C As Long, opRed As Long, opGreen As Long, opBlue As Long
newVal = Percent * 5
C = pixelLong
RGBfromLONG C
opRed = rRed
opGreen = rGreen
opBlue = rBlue
rRed = rRed + newVal
If rRed > -1 And rRed < 256 Then opRed = rRed

rGreen = rGreen + newVal
If rGreen > -1 And rGreen < 256 Then opGreen = rGreen
rBlue = rBlue + newVal
If rBlue > -1 And rBlue < 256 Then opBlue = rBlue
If rRed <> 1000 Then
    C = RGB(opRed, opGreen, opBlue)
    LightenPixel = C
End If
End Function


Function DarkenPixel(pixelLong As Long, Percent As Integer) As Long
'Darken only one pixel
Dim newVal As Integer, C As Long, opRed As Long, opGreen As Long, opBlue As Long
newVal = Percent * -5
C = pixelLong
RGBfromLONG C
opRed = rRed
opGreen = rGreen
opBlue = rBlue
rRed = rRed + newVal
If rRed > -1 And rRed < 256 Then opRed = rRed

rGreen = rGreen + newVal
If rGreen > -1 And rGreen < 256 Then opGreen = rGreen
rBlue = rBlue + newVal
If rBlue > -1 And rBlue < 256 Then opBlue = rBlue
If rRed <> 1000 Then
    C = RGB(opRed, opGreen, opBlue)
    DarkenPixel = C
End If
End Function


Public Sub S_Blur(picBox, Intensity As Integer)
'Blur a picture
Dim W As Integer, H As Integer, NumC As Integer
Dim Color As Long, CA As Integer, Size As Integer
Dim C(1 To 100) As Long, S As Integer, I As Integer
Dim G As Long, R As Long, b As Long
picBox.ScaleMode = 3
Size = 1

For I = 1 To Intensity
    For W = 0 To picBox.ScaleWidth - 2 Step Size
        For H = 0 To picBox.ScaleHeight - 2 Step Size
            NumC = 1
            For S = 1 To Size
                C(NumC) = GetPixel(picBox.hdc, W, H)
                NumC = NumC + 1
                C(NumC) = GetPixel(picBox.hdc, W + S, H)
                NumC = NumC + 1
                C(NumC) = GetPixel(picBox.hdc, W + S, H + S)
                NumC = NumC + 1
                C(NumC) = GetPixel(picBox.hdc, W, H + S)
                NumC = NumC + 1
            Next S
            For CA = 1 To NumC
                RGBfromLONG C(CA)
                G = G + rGreen
                R = R + rRed
                b = b + rBlue
            Next CA
            If G > 0 And R > 0 And b > 0 Then
                R = R / NumC
                G = G / NumC
                b = b / NumC
            Else
                R = 0
                G = 0
                b = 0
            End If
            Color = RGB(R, G, b)
            
            For S = 0 To Size
                picBox.Line (W + S, H)-(W + S, H + Size), Color, BF
            Next S
        Next H
        DoEvents
    Next W
    DoEvents
Next I
End Sub

Function InvertPixel(colorLong As Long) As Long
'Invert the color of a pixel
Dim opRed As Long, opGreen As Long, opBlue As Long
RGBfromLONG colorLong

InvertPixel = RGB(255 - rRed, 255 - rGreen, 255 - rBlue)
End Function
Public Sub S_Invert(picBox)
'Invert the image of a picturebox
Dim newVal As Integer, H As Integer, W As Integer, K As Integer
Dim C As Long
Dim opRed As Long, opBlue As Long, opGreen As Long

picBox.ScaleMode = 3

For H = 0 To picBox.ScaleHeight
    For W = 0 To picBox.ScaleWidth

        C = GetPixel(picBox.hdc, W, H)
        RGBfromLONG C
        opRed = 255 - rRed
        opGreen = 255 - rGreen
        opBlue = 255 - rBlue
        C = RGB(opRed, opGreen, opBlue)
        SetPixel picBox.hdc, W, H, C
    Next W
Next H
End Sub

Public Sub S_FlipHorizontal(picBox)
'Flip the picturebox (like when you look into a
'mirror).
'
'BTW: I know that BitBlt does a MUCH easier job
'with this, but I was experimenting with Get/Set Pixel
'and thought beginners or people not used to Get/Set Pixel
'would find it useful :]

Dim W As Integer, H As Integer, Num As Integer
Dim OldColor(0 To 1000, 0 To 1000) As Long, cColor As Long
picBox.ScaleMode = 3
Num = picBox.ScaleWidth / 2
For W = picBox.ScaleWidth / 2 To picBox.ScaleWidth
    For H = 0 To picBox.ScaleHeight
        cColor = GetPixel(picBox.hdc, Num, H)
        OldColor(W - (picBox.ScaleWidth / 2), H) = GetPixel(picBox.hdc, W, H)
        SetPixel picBox.hdc, W, H, cColor
    Next H
    Num = Num - 1
    DoEvents
Next W


Num = picBox.ScaleWidth / 2
For W = 0 To picBox.ScaleWidth / 2
    For H = 0 To picBox.ScaleHeight
        SetPixel picBox.hdc, Num, H, OldColor(W, H)
    Next H
    Num = Num - 1
    DoEvents
Next W
End Sub






Public Sub S_Colorize(BaseColor As Long, picBox)
'Colorize a picture
Dim newVal As Integer, H As Integer, W As Integer, K As Integer
Dim C As Long
Dim icRed As Long, icBlue As Long, icGreen As Long
Dim opRed As Long, opBlue As Long, opGreen As Long

Dim origRed As Long, origBlue As Long, origGreen As Long
RGBfromLONG BaseColor
origRed = rRed
origBlue = rBlue
origGreen = rGreen

picBox.ScaleMode = 3
S_GrayScale picBox

For H = 0 To picBox.ScaleHeight
    For W = 0 To picBox.ScaleWidth
        C = GetPixel(picBox.hdc, W, H)
        RGBfromLONG C
        opRed = rRed
        opBlue = rBlue
        opGreen = rGreen
        
        
        If rRed > 0 Then rRed = origRed * (rRed / 255)
        If rRed > -1 And icRed < 256 Then opRed = rRed
        
        If rGreen > 0 Then rGreen = origGreen * (rGreen / 255)
        If rGreen > -1 And rGreen < 256 Then opGreen = rGreen
        
        If rBlue > 0 Then rBlue = origBlue * (rBlue / 255)
        If rBlue > -1 And rBlue < 256 Then opBlue = rBlue

        If rRed <> 1000 Then
            If opRed < 0 Then opRed = 0
            If opGreen < 0 Then opGreen = 0
            If opBlue < 0 Then opBlue = 0
           C = RGB(opRed, opGreen, opBlue)
           SetPixel picBox.hdc, W, H, C
        End If
    Next W
Next H
End Sub