home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#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
- FontSize = 2.54052e-29
- 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 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, j
- Dim red As Integer, green As Integer, blue As Integer
- Dim pixel&
- Dim PictureName
- CommonDialog1.Action = 1
- PictureName = CommonDialog1.filename
- If PictureName = "" Then Exit Sub
- Picture1.Picture = LoadPicture(PictureName)
- Form1.Refresh
- X = Picture1.ScaleWidth
- Y = Picture1.ScaleHeight
- If X > 500 Or Y > 500 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.Refresh
- For i = 0 To Y - 1
- For j = 0 To X - 1
- pixel& = Form1.Picture1.Point(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)
- Next
- Form3.Hide
- End Sub
- Private Sub FileSave_Click()
- Dim PictureName
- CommonDialog1.Action = 2
- PictureName = CommonDialog1.filename
- SavePicture Picture1.IMAGE, PictureName
- End Sub
- Public Sub LoadImage_Click()
- End Sub
- Private Sub ProcessCustom_Click()
- Dim RedSum, GreenSum, BlueSum
- Dim red, green, blue
- Dim fi, fj
- Dim i, j
- Dim Offset
- Form2.Show 1 ' wait for user to define filter
- If FilterCancel = True Then Exit Sub
- If FilterNorm = 0 Then FilterNorm = 1
- If Form2.Option1.Value Then
- Offset = 1
- Else
- Offset = 2
- End If
- 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
- RedSum = RedSum + ImagePixels(0, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
- GreenSum = GreenSum + ImagePixels(1, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
- BlueSum = BlueSum + ImagePixels(2, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
- Next
- Next
- red = Abs(RedSum / FilterNorm + FilterBias)
- green = Abs(GreenSum / FilterNorm + FilterBias)
- blue = Abs(BlueSum / FilterNorm + FilterBias)
- Picture1.PSet (j, i), RGB(red, green, blue)
- Next
- DoEvents
- Next
- End Sub
- Private Sub ProcessDiffuse_Click()
- Dim i, j
- Dim Rx, Ry
- Dim red, green, blue
- 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)
- Picture1.PSet (j, i), RGB(red, green, blue)
- Next
- DoEvents
- Next
- End Sub
- Private Sub ProcessEmboss_Click()
- Dim i, j
- Dim Dx, Dy
- Dx = 1
- Dy = 1
- Dim red, green, blue
- 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)
- Picture1.PSet (j, i), RGB(red, green, blue)
- Next
- Picture1.Refresh
- Next
- End Sub
- Private Sub ProcessSharpen_Click()
- Dim i, j
- Dim Dx, Dy
- Dx = 1
- Dy = 1
- Dim red, green, blue
- 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
- Picture1.PSet (j, i), RGB(red, green, blue)
- Next
- Picture1.Refresh
- Next
- End Sub
- Private Sub ProcessSmooth_Click()
- Dim i, j As Integer
- 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)
- Picture1.PSet (j, i), RGB(red / 9, green / 9, blue / 9)
- Next
- Picture1.Refresh
- Next
- End Sub
-