Mastering Visual Basic 6/mastvb6.iso/ch_code/ch12/image2/image.frm

Visual Basic Form | 1996-03-07 | 14.0 KB | 384 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "Image Processing"
   ClientHeight    =   4515
   ClientLeft      =   3090
   ClientTop       =   2385
   ClientWidth     =   5085
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   301
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   339
   ShowInTaskbar   =   0   'False
   Begin VB.PictureBox Picture1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   4470
      Left            =   0
      ScaleHeight     =   294
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   333
      TabIndex        =   0
      Top             =   0
      Width           =   5055
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   6045
      Top             =   105
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontSize        =   1.17485e-38
   End
   Begin VB.Menu FileMenu
      Caption         =   "File"
      Begin VB.Menu FileOpen
         Caption         =   "Open Image"
      End
      Begin VB.Menu FileSave
         Caption         =   "Save Image"
      End
      Begin VB.Menu FileExit
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu ProcessMenu
      Caption         =   "Process Image"
      Begin VB.Menu ProcessSmooth
         Caption         =   "Smooth"
      End
      Begin VB.Menu ProcessSharpen
         Caption         =   "Sharpen"
      End
      Begin VB.Menu ProcessEmboss
         Caption         =   "Emboss"
      End
      Begin VB.Menu ProcessDiffuse
         Caption         =   "Diffuse"
      End
      Begin VB.Menu ProcessPixelize
         Caption         =   "Pixelize"
      End
      Begin VB.Menu ProcessSolarize
         Caption         =   "Solarize"
      End
      Begin VB.Menu separator
         Caption         =   "-"
      End
      Begin VB.Menu ProcessCustom
         Caption         =   "Custom Filter"
      End
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub FileExit_Click()
    End
End Sub
Private Sub FileOpen_Click()
Dim i As Long, j As Long
Dim red As Integer, green As Integer, blue As Integer
Dim pixel As Long
Dim PictureName As String
CommonDialog1.InitDir = App.Path
CommonDialog1.FileName = ""
CommonDialog1.Filter = "Images|*.GIF;*.BMP;*.JPG|All Files|*.*"
CommonDialog1.Action = 1
PictureName = CommonDialog1.FileName
If PictureName = "" Then Exit Sub
On Error GoTo BadImageType
Picture1.Picture = LoadPicture(PictureName)
Form1.Refresh
x = Picture1.ScaleWidth
y = Picture1.ScaleHeight
If x > 800 Or y > 800 Then
    MsgBox "Image too large to process. Please try loading a smaller image."
    x = 0
    y = 0
    Exit Sub
End If
Form1.Width = Form1.ScaleX(Picture1.Width + 6, vbPixels, vbTwips)
Form1.Height = Form1.ScaleY(Picture1.Height + 30, vbPixels, vbTwips)
Form1.Refresh
Form3.Show
Form3.Caption = "Reading pixels"
Form3.Refresh
    For i = 0 To y - 1
        For j = 0 To x - 1
            pixel = GetPixel(Form1.Picture1.hdc, j, i)
            red = pixel Mod 256
            green = ((pixel And &HFF00) / 256&) Mod 256&
            blue = (pixel And &HFF0000) / 65536
            ImagePixels(0, i, j) = red
            ImagePixels(1, i, j) = green
            ImagePixels(2, i, j) = blue
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    Me.Caption = CommonDialog1.FileTitle & "    (" & x & ", " & y & ")"
    Exit Sub
BadImageType:
    MsgBox Err.Description
    x = 0
    y = 0
    Exit Sub
End Sub
Private Sub FileSave_Click()
Dim PictureName
    CommonDialog1.DefaultExt = "*.BMP"
    CommonDialog1.Action = 2
    PictureName = CommonDialog1.FileName
    SavePicture Picture1.Image, PictureName
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub ProcessCustom_Click()
Dim RedSum As Integer, GreenSum As Integer, BlueSum As Integer
Dim i As Integer, j As Integer
Dim red As Integer, green As Integer, blue As Integer
Dim fi As Integer, fj As Integer
Dim Offset As Integer
Dim Weight As Single
    Form2.Show 1    ' wait for user to define filter
    If FilterCancel = True Then Exit Sub
    T1 = Timer
    If FilterNorm = 0 Then FilterNorm = 1
    If Form2.Option1.Value Then
        Offset = 1
    Else
        Offset = 2
    End If
    DoEvents
    Form3.Show
    Form3.Caption = "Processing pixels..."
    Form3.Refresh
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    For i = Offset To y - Offset - 1
        For j = Offset To x - Offset - 1
            RedSum = 0: GreenSum = 0: BlueSum = 0
            For fi = -Offset To Offset
                For fj = -Offset To Offset
                    Weight = CustomFilter(fi + 2, fj + 2)
                    RedSum = RedSum + ImagePixels(0, i + fi, j + fj) * Weight
                    GreenSum = GreenSum + ImagePixels(1, i + fi, j + fj) * Weight
                    BlueSum = BlueSum + ImagePixels(2, i + fi, j + fj) * Weight
                Next
            Next
            red = Abs(RedSum / FilterNorm + FilterBias)
            green = Abs(GreenSum / FilterNorm + FilterBias)
            blue = Abs(BlueSum / FilterNorm + FilterBias)
            SetPixelV hDestDC, j, i, RGB(red, green, blue)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessDiffuse_Click()
Dim i As Long, j As Long
Dim red As Integer, green As Integer, blue As Integer
Dim Rx As Integer, Ry As Integer
    T1 = Timer
    Form3.Show
    Form3.Caption = "Diffusing image ..."
    Form3.Refresh
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    For i = 2 To y - 3
        For j = 2 To x - 3
            Rx = Rnd * 4 - 2
            Ry = Rnd * 4 - 2
            red = ImagePixels(0, i + Rx, j + Ry)
            green = ImagePixels(1, i + Rx, j + Ry)
            blue = ImagePixels(2, i + Rx, j + Ry)
            SetPixelV hDestDC, j, i, RGB(red, green, blue)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessEmboss_Click()
Dim i As Long, j As Long
Dim Dx As Integer, Dy As Integer
Dim red As Integer, green As Integer, blue As Integer
    Dx = 1
    Dy = 1
    Form3.Show
    Form3.Caption = "Embossing image ..."
    Form3.Refresh
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    T1 = Timer
    For i = 1 To y - 2
        For j = 1 To x - 2
            red = Abs(ImagePixels(0, i, j) - ImagePixels(0, i + Dx, j + Dy) + 128)
            green = Abs(ImagePixels(1, i, j) - ImagePixels(1, i + Dx, j + Dy) + 128)
            blue = Abs(ImagePixels(2, i, j) - ImagePixels(2, i + Dx, j + Dy) + 128)
            SetPixelV hDestDC, j, i, RGB(red, green, blue)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessPixelize_Click()
Dim i As Long, j As Long
Dim Dx As Integer, Dy As Integer
Dim red As Integer, green As Integer, blue As Integer
    T1 = Timer
    Picture1.FillStyle = vbSolid
    For i = 1 To y / 3
        For j = 1 To x / 3
            Ypixel = Rnd * x + 4 - 2
            Xpixel = Rnd * y + 4 - 2
            R = Int(Rnd() * 3) + 2
            red = ImagePixels(0, Xpixel, Ypixel)
            green = ImagePixels(1, Xpixel, Ypixel)
            blue = ImagePixels(2, Xpixel, Ypixel)
            Picture1.FillColor = RGB(red, green, blue)
            Picture1.Circle (Ypixel, Xpixel), R, RGB(red, green, blue)
        Next
        Picture1.Refresh
    Next
    Picture1.FillStyle = vbTransparent
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessSharpen_Click()
Dim i As Long, j As Long
Dim Dx As Integer, Dy As Integer
Dim red As Integer, green As Integer, blue As Integer
    Dx = 1: Dy = 1
    T1 = Timer
    Form3.Show
    Form3.Caption = "Sharpening image ..."
    Form3.Refresh
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    For i = 1 To y - 2
        For j = 1 To x - 2
            red = ImagePixels(0, i, j) + 0.5 * (ImagePixels(0, i, j) - ImagePixels(0, i - Dx, j - Dy))
            green = ImagePixels(1, i, j) + 0.5 * (ImagePixels(1, i, j) - ImagePixels(1, i - Dx, j - Dy))
            blue = ImagePixels(2, i, j) + 0.5 * (ImagePixels(2, i, j) - ImagePixels(2, i - Dx, j - Dy))
            If red > 255 Then red = 255
            If red < 0 Then red = 0
            If green > 255 Then green = 255
            If green < 0 Then green = 0
            If blue > 255 Then blue = 255
            If blue < 0 Then blue = 0
            SetPixelV hDestDC, j, i, RGB(red, green, blue)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessSmooth_Click()
Dim i As Long, j As Long
Dim red As Integer, green As Integer, blue As Integer
    Form3.Show
    Form3.Caption = "Smoothing image ..."
    Form3.Refresh
    T1 = Timer
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    For i = 1 To y - 2
        For j = 1 To x - 2
            red = ImagePixels(0, i - 1, j - 1) + ImagePixels(0, i - 1, j) + ImagePixels(0, i - 1, j + 1) + _
            ImagePixels(0, i, j - 1) + ImagePixels(0, i, j) + ImagePixels(0, i, j + 1) + _
            ImagePixels(0, i + 1, j - 1) + ImagePixels(0, i + 1, j) + ImagePixels(0, i + 1, j + 1)

            green = ImagePixels(1, i - 1, j - 1) + ImagePixels(1, i - 1, j) + ImagePixels(1, i - 1, j + 1) + _
            ImagePixels(1, i, j - 1) + ImagePixels(1, i, j) + ImagePixels(1, i, j + 1) + _
            ImagePixels(1, i + 1, j - 1) + ImagePixels(1, i + 1, j) + ImagePixels(1, i + 1, j + 1)

            blue = ImagePixels(2, i - 1, j - 1) + ImagePixels(2, i - 1, j) + ImagePixels(2, i - 1, j + 1) + _
            ImagePixels(2, i, j - 1) + ImagePixels(2, i, j) + ImagePixels(2, i, j + 1) + _
            ImagePixels(2, i + 1, j - 1) + ImagePixels(2, i + 1, j) + ImagePixels(2, i + 1, j + 1)

            SetPixelV hDestDC, j, i, RGB(red / 9, green / 9, blue / 9)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub
Private Sub ProcessSolarize_Click()
Dim i As Long, j As Long
Dim red As Integer, green As Integer, blue As Integer
    Form3.Show
    Form3.Caption = "Solarizing image ..."
    Form3.Refresh
    T1 = Timer
    hBMP = CreateCompatibleBitmap(Picture1.hdc, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hDestDC = CreateCompatibleDC(Picture1.hdc)
    SelectObject hDestDC, hBMP
    For i = 1 To y - 2
        For j = 1 To x - 2
            red = ImagePixels(0, i, j)
            green = ImagePixels(1, i, j)
            blue = ImagePixels(2, i, j)
            If ((red < 128) Or (red > 255)) Then red = 255 - red
            If ((green < 128) Or (green > 255)) Then green = 255 - green
            If ((blue < 128) Or (blue > 255)) Then blue = 255 - blue
            SetPixelV hDestDC, j, i, RGB(red, green, blue)
        Next
        Form3.ProgressBar1.Value = i * 100 / (y - 1)
        DoEvents
    Next
    Form3.Hide
    BitBlt Picture1.hdc, 1, 1, Picture1.ScaleWidth - 2, Picture1.ScaleHeight - 2, hDestDC, 1, 1, &HCC0020
    Picture1.Refresh
    Call DeleteDC(hDestDC)
    Call DeleteObject(hBMP)
' UNCOMMENT NEXT LINE TO TIME OPERATION
    MsgBox "Processing completed in " & Format(Timer - T1, "##.000")
End Sub