home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / mastvb6.exe / Ch12 / Image / image.Frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-07  |  8.3 KB  |  229 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form Form1 
  4.    BorderStyle     =   5  'Sizable ToolWindow
  5.    Caption         =   "Image Processing"
  6.    ClientHeight    =   4515
  7.    ClientLeft      =   3090
  8.    ClientTop       =   2385
  9.    ClientWidth     =   5085
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    PaletteMode     =   1  'UseZOrder
  14.    ScaleHeight     =   301
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   339
  17.    ShowInTaskbar   =   0   'False
  18.    Begin VB.PictureBox Picture1 
  19.       AutoRedraw      =   -1  'True
  20.       AutoSize        =   -1  'True
  21.       Height          =   4470
  22.       Left            =   0
  23.       ScaleHeight     =   294
  24.       ScaleMode       =   3  'Pixel
  25.       ScaleWidth      =   333
  26.       TabIndex        =   0
  27.       Top             =   0
  28.       Width           =   5055
  29.    End
  30.    Begin MSComDlg.CommonDialog CommonDialog1 
  31.       Left            =   6045
  32.       Top             =   105
  33.       _ExtentX        =   847
  34.       _ExtentY        =   847
  35.       _Version        =   393216
  36.       FontSize        =   2.54052e-29
  37.    End
  38.    Begin VB.Menu FileMenu 
  39.       Caption         =   "File"
  40.       Begin VB.Menu FileOpen 
  41.          Caption         =   "Open Image"
  42.       End
  43.       Begin VB.Menu FileSave 
  44.          Caption         =   "Save Image"
  45.       End
  46.       Begin VB.Menu FileExit 
  47.          Caption         =   "Exit"
  48.       End
  49.    End
  50.    Begin VB.Menu ProcessMenu 
  51.       Caption         =   "Process Image"
  52.       Begin VB.Menu ProcessSmooth 
  53.          Caption         =   "Smooth"
  54.       End
  55.       Begin VB.Menu ProcessSharpen 
  56.          Caption         =   "Sharpen"
  57.       End
  58.       Begin VB.Menu ProcessEmboss 
  59.          Caption         =   "Emboss"
  60.       End
  61.       Begin VB.Menu ProcessDiffuse 
  62.          Caption         =   "Diffuse"
  63.       End
  64.       Begin VB.Menu separator 
  65.          Caption         =   "-"
  66.       End
  67.       Begin VB.Menu ProcessCustom 
  68.          Caption         =   "Custom Filter"
  69.       End
  70.    End
  71. Attribute VB_Name = "Form1"
  72. Attribute VB_GlobalNameSpace = False
  73. Attribute VB_Creatable = False
  74. Attribute VB_PredeclaredId = True
  75. Attribute VB_Exposed = False
  76. Private Sub FileExit_Click()
  77.     End
  78. End Sub
  79. Private Sub FileOpen_Click()
  80. Dim i As Integer, j As Integer
  81. Dim red As Integer, green As Integer, blue As Integer
  82. Dim pixel As Long
  83. Dim PictureName As String
  84. CommonDialog1.InitDir = App.Path
  85. CommonDialog1.Filter = "Images|*.BMP;*.GIF;*.JPG;*.DIB|All Files|*.*"
  86. CommonDialog1.Action = 1
  87. PictureName = CommonDialog1.FileName
  88. If PictureName = "" Then Exit Sub
  89. Picture1.Picture = LoadPicture(PictureName)
  90. Form1.Refresh
  91. X = Picture1.ScaleWidth
  92. Y = Picture1.ScaleHeight
  93. If X > 500 Or Y > 500 Then
  94.     MsgBox "Image too large to process. Please try loading a smaller image."
  95.     X = 0
  96.     Y = 0
  97.     Exit Sub
  98. End If
  99. Form1.Width = Form1.ScaleX(Picture1.Width + 6, vbPixels, vbTwips)
  100. Form1.Height = Form1.ScaleY(Picture1.Height + 30, vbPixels, vbTwips)
  101. Form1.Refresh
  102. Form3.Show
  103. Form3.Refresh
  104.     For i = 0 To Y - 1
  105.         For j = 0 To X - 1
  106.             pixel = Form1.Picture1.Point(j, i)
  107.             red = pixel& Mod 256
  108.             green = ((pixel And &HFF00) / 256&) Mod 256&
  109.             blue = (pixel And &HFF0000) / 65536
  110.             ImagePixels(0, i, j) = red
  111.             ImagePixels(1, i, j) = green
  112.             ImagePixels(2, i, j) = blue
  113.         Next
  114.         Form3.ProgressBar1.Value = i * 100 / (Y - 1)
  115.     Next
  116.     Form3.Hide
  117. End Sub
  118. Private Sub FileSave_Click()
  119. Dim PictureName
  120.     CommonDialog1.Action = 2
  121.     PictureName = CommonDialog1.FileName
  122.     SavePicture Picture1.Image, PictureName
  123. End Sub
  124. Private Sub ProcessCustom_Click()
  125. Dim RedSum As Integer, GreenSum As Integer, BlueSum As Integer
  126. Dim red  As Integer, green As Integer, blue  As Integer
  127. Dim fi  As Integer, fj  As Integer
  128. Dim i  As Integer, j  As Integer
  129. Dim Offset  As Integer
  130.     Form2.Show 1    ' wait for user to define filter
  131.     If FilterCancel = True Then Exit Sub
  132.     If FilterNorm = 0 Then FilterNorm = 1
  133.     If Form2.Option1.Value Then
  134.         Offset = 1
  135.     Else
  136.         Offset = 2
  137.     End If
  138.     For i = Offset To Y - Offset - 1
  139.         For j = Offset To X - Offset - 1
  140.             RedSum = 0: GreenSum = 0: BlueSum = 0
  141.             For fi = -Offset To Offset
  142.                 For fj = -Offset To Offset
  143.                     RedSum = RedSum + ImagePixels(0, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
  144.                     GreenSum = GreenSum + ImagePixels(1, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
  145.                     BlueSum = BlueSum + ImagePixels(2, i + fi, j + fj) * CustomFilter(fi + 2, fj + 2)
  146.                 Next
  147.             Next
  148.             red = Abs(RedSum / FilterNorm + FilterBias)
  149.             green = Abs(GreenSum / FilterNorm + FilterBias)
  150.             blue = Abs(BlueSum / FilterNorm + FilterBias)
  151.             Picture1.PSet (j, i), RGB(red, green, blue)
  152.         Next
  153.         DoEvents
  154.     Next
  155. End Sub
  156. Private Sub ProcessDiffuse_Click()
  157. Dim i As Integer, j As Integer
  158. Dim Rx As Integer, Ry As Integer
  159. Dim red As Integer, green As Integer, blue As Integer
  160.     For i = 2 To Y - 3
  161.         For j = 2 To X - 3
  162.             Rx = Rnd() * 4 - 2
  163.             Ry = Rnd() * 4 - 2
  164.             red = ImagePixels(0, i + Rx, j + Ry)
  165.             green = ImagePixels(1, i + Rx, j + Ry)
  166.             blue = ImagePixels(2, i + Rx, j + Ry)
  167.             Picture1.PSet (j, i), RGB(red, green, blue)
  168.         Next
  169.         DoEvents
  170.     Next
  171. End Sub
  172. Private Sub ProcessEmboss_Click()
  173. Dim i As Integer, j As Integer
  174. Const Dx As Integer = 1
  175. Const Dy As Integer = 1
  176. Dim red As Integer, green As Integer, blue As Integer
  177.     For i = 1 To Y - 2
  178.         For j = 1 To X - 2
  179.             red = Abs(ImagePixels(0, i, j) - ImagePixels(0, i + Dx, j + Dy) + 128)
  180.             green = Abs(ImagePixels(1, i, j) - ImagePixels(1, i + Dx, j + Dy) + 128)
  181.             blue = Abs(ImagePixels(2, i, j) - ImagePixels(2, i + Dx, j + Dy) + 128)
  182.             Picture1.PSet (j, i), RGB(red, green, blue)
  183.         Next
  184.         Picture1.Refresh
  185.     Next
  186. End Sub
  187. Private Sub ProcessSharpen_Click()
  188. Dim i As Integer, j As Integer
  189. Const Dx As Integer = 1
  190. Const Dy As Integer = 1
  191. Dim red As Integer, green As Integer, blue As Integer
  192.     For i = 1 To Y - 2
  193.         For j = 1 To X - 2
  194.             red = ImagePixels(0, i, j) + 0.5 * (ImagePixels(0, i, j) - ImagePixels(0, i - Dx, j - Dy))
  195.             green = ImagePixels(1, i, j) + 0.5 * (ImagePixels(1, i, j) - ImagePixels(1, i - Dx, j - Dy))
  196.             blue = ImagePixels(2, i, j) + 0.5 * (ImagePixels(2, i, j) - ImagePixels(2, i - Dx, j - Dy))
  197.             If red > 255 Then red = 255
  198.             If red < 0 Then red = 0
  199.             If green > 255 Then green = 255
  200.             If green < 0 Then green = 0
  201.             If blue > 255 Then blue = 255
  202.             If blue < 0 Then blue = 0
  203.             Picture1.PSet (j, i), RGB(red, green, blue)
  204.         Next
  205.         Picture1.Refresh
  206.     Next
  207. End Sub
  208. Private Sub ProcessSmooth_Click()
  209. Dim i As Integer, j As Integer
  210. Dim red As Integer, green As Integer, blue As Integer
  211.     For i = 1 To Y - 2
  212.         For j = 1 To X - 2
  213.             red = ImagePixels(0, i - 1, j - 1) + ImagePixels(0, i - 1, j) + ImagePixels(0, i - 1, j + 1) + _
  214.             ImagePixels(0, i, j - 1) + ImagePixels(0, i, j) + ImagePixels(0, i, j + 1) + _
  215.             ImagePixels(0, i + 1, j - 1) + ImagePixels(0, i + 1, j) + ImagePixels(0, i + 1, j + 1)
  216.             
  217.             green = ImagePixels(1, i - 1, j - 1) + ImagePixels(1, i - 1, j) + ImagePixels(1, i - 1, j + 1) + _
  218.             ImagePixels(1, i, j - 1) + ImagePixels(1, i, j) + ImagePixels(1, i, j + 1) + _
  219.             ImagePixels(1, i + 1, j - 1) + ImagePixels(1, i + 1, j) + ImagePixels(1, i + 1, j + 1)
  220.             
  221.             blue = ImagePixels(2, i - 1, j - 1) + ImagePixels(2, i - 1, j) + ImagePixels(2, i - 1, j + 1) + _
  222.             ImagePixels(2, i, j - 1) + ImagePixels(2, i, j) + ImagePixels(2, i, j + 1) + _
  223.             ImagePixels(2, i + 1, j - 1) + ImagePixels(2, i + 1, j) + ImagePixels(2, i + 1, j + 1)
  224.             Picture1.PSet (j, i), RGB(red / 9, green / 9, blue / 9)
  225.         Next
  226.         Picture1.Refresh
  227.     Next
  228. End Sub
  229.