home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Fingerprin2066955222007.psc / Filters.bas < prev    next >
BASIC Source File  |  2007-05-22  |  15KB  |  406 lines
  1. Attribute VB_Name = "Module10"
  2. Option Explicit
  3.  
  4. Dim i As Integer, j As Integer
  5. Dim red As Integer, green As Integer, blue As Integer
  6. Dim fi As Integer, fj As Integer
  7. Dim RedSum As Integer, GreenSum As Integer, BlueSum As Integer
  8. Dim weight As Single
  9. Dim offset As Integer
  10. Dim x As Integer
  11. Dim y As Integer
  12. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  13. Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  14. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  15. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  16. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  17. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  18. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  19.  
  20. Dim ImagePixels(0 To 2, 0 To 600, 0 To 600) As Integer
  21.  
  22. Dim m As Integer
  23. Dim mi As Integer
  24. Dim mj As Integer
  25. Dim temp As Integer
  26. Dim pixel As Long
  27. Dim reda(0 To 8) As Integer
  28. Dim greena(0 To 8) As Integer
  29. Dim bluea(0 To 8) As Integer
  30. Dim sum(0 To 1, 0 To 8) As Integer
  31. Public Sub readit(ByRef Picture1 As PictureBox)
  32. x = Picture1.ScaleWidth
  33. y = Picture1.ScaleHeight
  34.     For i = 0 To y - 1
  35.         For j = 0 To x - 1
  36.             pixel = GetPixel(Picture1.hdc, j, i)
  37.             red = pixel Mod 256
  38.             green = ((pixel And &HFF00) / 256&) Mod 256&
  39.             blue = (pixel And &HFF0000) / 65536
  40.             ImagePixels(0, i, j) = red
  41.             ImagePixels(1, i, j) = green
  42.             ImagePixels(2, i, j) = blue
  43.         Next
  44.         DoEvents
  45.     Next
  46. End Sub
  47. Public Sub ProcessCustom3(ByRef Picture1 As PictureBox, ByRef customfilter() As Integer, filternorm As Integer, filterbias As Integer, takeabs As Boolean)
  48.     
  49.     readit Picture1
  50.     
  51.     offset = 1
  52.     For i = offset To y - offset - 1
  53.         For j = offset To x - offset - 1
  54.             RedSum = 0: GreenSum = 0: BlueSum = 0
  55.             For fi = -offset To offset
  56.                 For fj = -offset To offset
  57.                     weight = customfilter(fi + 1, fj + 1)
  58.                     RedSum = RedSum + ImagePixels(0, i + fi, j + fj) * weight
  59.                     GreenSum = GreenSum + ImagePixels(1, i + fi, j + fj) * weight
  60.                     BlueSum = BlueSum + ImagePixels(2, i + fi, j + fj) * weight
  61.                 Next
  62.             Next
  63.             If takeabs = True Then
  64.             red = Abs(RedSum / filternorm + filterbias)
  65.             green = Abs(GreenSum / filternorm + filterbias)
  66.             blue = Abs(BlueSum / filternorm + filterbias)
  67.             Else
  68.             red = (RedSum / filternorm + filterbias)
  69.             green = (GreenSum / filternorm + filterbias)
  70.             blue = (BlueSum / filternorm + filterbias)
  71.             If red > 255 Then
  72.             red = 255
  73.             Else
  74.             If red < 0 Then red = 0
  75.             End If
  76.             If green > 255 Then
  77.             green = 255
  78.             Else
  79.             If green < 0 Then green = 0
  80.             End If
  81.             If blue > 255 Then
  82.             blue = 255
  83.             Else
  84.             If blue < 0 Then blue = 0
  85.             End If
  86.             End If
  87.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  88.         Next
  89. DoEvents
  90.     Next
  91.  
  92. End Sub
  93. Public Sub ProcessCustom5(ByRef Picture1 As PictureBox, ByRef customfilter() As Integer, filternorm As Integer, filterbias As Integer, takeabs As Boolean)
  94.     
  95.     readit Picture1
  96.     
  97.     offset = 2
  98.     For i = offset To y - offset - 1
  99.         For j = offset To x - offset - 1
  100.             RedSum = 0: GreenSum = 0: BlueSum = 0
  101.             For fi = -offset To offset
  102.                 For fj = -offset To offset
  103.                     weight = customfilter(fi + 2, fj + 2)
  104.                     RedSum = RedSum + ImagePixels(0, i + fi, j + fj) * weight
  105.                     GreenSum = GreenSum + ImagePixels(1, i + fi, j + fj) * weight
  106.                     BlueSum = BlueSum + ImagePixels(2, i + fi, j + fj) * weight
  107.                 Next
  108.             Next
  109.             If takeabs = True Then
  110.             red = Abs(RedSum / filternorm + filterbias)
  111.             green = Abs(GreenSum / filternorm + filterbias)
  112.             blue = Abs(BlueSum / filternorm + filterbias)
  113.             Else
  114.             red = (RedSum / filternorm + filterbias)
  115.             green = (GreenSum / filternorm + filterbias)
  116.             blue = (BlueSum / filternorm + filterbias)
  117.             If red > 255 Then
  118.             red = 255
  119.             Else
  120.             If red < 0 Then red = 0
  121.             End If
  122.             If green > 255 Then
  123.             green = 255
  124.             Else
  125.             If green < 0 Then green = 0
  126.             End If
  127.             If blue > 255 Then
  128.             blue = 255
  129.             Else
  130.             If blue < 0 Then blue = 0
  131.             End If
  132.             End If
  133.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  134.         Next
  135. DoEvents
  136.     Next
  137.  
  138. End Sub
  139. Public Sub processmedian(ByRef Picture1 As PictureBox, ByVal filterbias As Integer, ByVal takeabs As Boolean)
  140.     readit Picture1
  141.     
  142.     offset = 1
  143.     For i = offset To y - offset - 1
  144.         For j = offset To x - offset - 1
  145.             m = 0
  146.             For fi = -offset To offset
  147.                 For fj = -offset To offset
  148.                     reda(fi + fj + 2 + m) = ImagePixels(0, i + fi, j + fj)
  149.                     greena(fi + fj + 2 + m) = ImagePixels(1, i + fi, j + fj)
  150.                     bluea(fi + fj + 2 + m) = ImagePixels(2, i + fi, j + fj)
  151.                 Next
  152.                 m = m + 2
  153.             Next
  154.             For mi = 0 To 8
  155.                 For mj = mi To 7
  156.                     If reda(mj) > reda(mj + 1) Then
  157.                     temp = reda(mj)
  158.                     reda(mj) = reda(mj + 1)
  159.                     reda(mj + 1) = reda(mj)
  160.                     End If
  161.                     If greena(mj) > greena(mj + 1) Then
  162.                     temp = greena(mj)
  163.                     greena(mj) = greena(mj + 1)
  164.                     greena(mj + 1) = greena(mj)
  165.                     End If
  166.                     If bluea(mj) > bluea(mj + 1) Then
  167.                     temp = bluea(mj)
  168.                     bluea(mj) = bluea(mj + 1)
  169.                     bluea(mj + 1) = bluea(mj)
  170.                     End If
  171.                  Next
  172.             Next
  173.             If takeabs = True Then
  174.             red = Abs(reda(4) + filterbias)
  175.             green = Abs(greena(4) + filterbias)
  176.             blue = Abs(bluea(4) + filterbias)
  177.             Else
  178.             red = (reda(4) + filterbias)
  179.             green = (greena(4) + filterbias)
  180.             blue = (bluea(4) + filterbias)
  181.             If red > 255 Then
  182.             red = 255
  183.             Else
  184.             If red < 0 Then red = 0
  185.             End If
  186.             If green > 255 Then
  187.             green = 255
  188.             Else
  189.             If green < 0 Then green = 0
  190.             End If
  191.             If blue > 255 Then
  192.             blue = 255
  193.             Else
  194.             If blue < 0 Then blue = 0
  195.             End If
  196.             End If
  197.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  198.         Next
  199. DoEvents
  200.     Next
  201.  
  202. End Sub
  203. Public Sub processmediankc(ByRef Picture1 As PictureBox, ByVal filterbias As Integer, ByVal takeabs As Boolean)
  204.     readit Picture1
  205.     
  206.     offset = 1
  207.     For i = offset To y - offset - 1
  208.         For j = offset To x - offset - 1
  209.             m = 0
  210.             For fi = -offset To offset
  211.                 For fj = -offset To offset
  212.                     reda(fi + fj + 2 + m) = ImagePixels(0, i + fi, j + fj)
  213.                     greena(fi + fj + 2 + m) = ImagePixels(1, i + fi, j + fj)
  214.                     bluea(fi + fj + 2 + m) = ImagePixels(2, i + fi, j + fj)
  215.                 Next
  216.                 m = m + 2
  217.             Next
  218.             For mi = 0 To 8
  219.                 sum(0, mi) = reda(mi) + greena(mi) + bluea(mi)
  220.                 sum(1, mi) = mi
  221.             Next
  222.             For mi = 0 To 8
  223.                 For mj = mi To 7
  224.                     If sum(0, mj) > sum(0, mj + 1) Then
  225.                     temp = sum(0, mj)
  226.                     sum(0, mj) = sum(0, mj + 1)
  227.                     sum(0, mj + 1) = sum(0, mj)
  228.                     temp = sum(1, mj)
  229.                     sum(1, mj) = sum(1, mj + 1)
  230.                     sum(1, mj + 1) = sum(1, mj)
  231.                     End If
  232.                  Next
  233.             Next
  234.             If takeabs = True Then
  235.             red = Abs(reda(sum(1, 4)) + filterbias)
  236.             green = Abs(greena(sum(1, 4)) + filterbias)
  237.             blue = Abs(bluea(sum(1, 4)) + filterbias)
  238.             Else
  239.             red = (reda(sum(1, 4)) + filterbias)
  240.             green = (greena(sum(1, 4)) + filterbias)
  241.             blue = (bluea(sum(1, 4)) + filterbias)
  242.             If red > 255 Then
  243.             red = 255
  244.             Else
  245.             If red < 0 Then red = 0
  246.             End If
  247.             If green > 255 Then
  248.             green = 255
  249.             Else
  250.             If green < 0 Then green = 0
  251.             End If
  252.             If blue > 255 Then
  253.             blue = 255
  254.             Else
  255.             If blue < 0 Then blue = 0
  256.             End If
  257.             End If
  258.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  259.         Next
  260.     DoEvents
  261. Next
  262.  
  263. End Sub
  264. Public Sub ProcessDiffuse(ByRef Picture1 As PictureBox, ByVal rndinto As Integer, ByVal rndminus As Integer)
  265.  
  266. Dim Rx As Integer, Ry As Integer
  267.    
  268.     readit Picture1
  269.     For i = 2 To y - 3
  270.         For j = 2 To x - 3
  271.             Rx = Rnd * rndinto - rndminus '4 - 2
  272.             Ry = Rnd * rndinto - rndminus '4 - 2
  273.             red = ImagePixels(0, i + Rx, j + Ry)
  274.             green = ImagePixels(1, i + Rx, j + Ry)
  275.             blue = ImagePixels(2, i + Rx, j + Ry)
  276.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  277.         Next
  278.         DoEvents
  279.     Next
  280.  
  281. End Sub
  282.  
  283. Public Sub ProcessEmboss(ByRef Picture1 As PictureBox, ByVal filterbias As Integer)
  284.  
  285. Dim Dx As Integer, Dy As Integer
  286.     readit Picture1
  287.  
  288.     Dx = 1
  289.     Dy = 1
  290.     
  291.     
  292.     'T1 = Timer
  293.     For i = 1 To y - 2
  294.         For j = 1 To x - 2
  295.             red = Abs(ImagePixels(0, i, j) - ImagePixels(0, i + Dx, j + Dy) + filterbias) '128)
  296.             green = Abs(ImagePixels(1, i, j) - ImagePixels(1, i + Dx, j + Dy) + filterbias) '128)
  297.             blue = Abs(ImagePixels(2, i, j) - ImagePixels(2, i + Dx, j + Dy) + filterbias) '128)
  298.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  299.         Next
  300.         DoEvents
  301.     Next
  302.     
  303. End Sub
  304.  
  305. Public Sub ProcessPixelize(ByRef Picture1 As PictureBox, ByVal rndplus As Integer, ByVal rndminus As Integer, ByVal intoradius As Integer, ByVal minradius As Integer)
  306.  
  307. Dim Ypixel As Integer, Xpixel As Integer
  308. Dim r As Integer
  309.     readit Picture1
  310.  
  311.     'T1 = Timer
  312.     Picture1.FillStyle = vbSolid
  313.     For i = 1 To y / 3
  314.         For j = 1 To x / 3
  315.             Ypixel = Rnd * x + rndplus - rndminus ' 4 - 2
  316.             Xpixel = Rnd * y + rndplus - rndminus '4 - 2
  317.             r = Int(Rnd() * intoradius) + minradius '3'2
  318.             red = ImagePixels(0, Xpixel, Ypixel)
  319.             green = ImagePixels(1, Xpixel, Ypixel)
  320.             blue = ImagePixels(2, Xpixel, Ypixel)
  321.             Picture1.FillColor = RGB(red, green, blue)
  322.             Picture1.Circle (Ypixel, Xpixel), r, RGB(red, green, blue)
  323.         Next
  324.         DoEvents
  325.         Picture1.Refresh
  326.     Next
  327.     Picture1.FillStyle = vbTransparent
  328.  
  329. End Sub
  330.  
  331. Public Sub ProcessSharpen(ByRef Picture1 As PictureBox)
  332. Dim Dx As Integer, Dy As Integer
  333.     
  334.     readit Picture1
  335.  
  336.     Dx = 1: Dy = 1
  337.     
  338.     For i = 1 To y - 2
  339.         For j = 1 To x - 2
  340.             red = ImagePixels(0, i, j) + 0.5 * (ImagePixels(0, i, j) - ImagePixels(0, i - Dx, j - Dy))
  341.             green = ImagePixels(1, i, j) + 0.5 * (ImagePixels(1, i, j) - ImagePixels(1, i - Dx, j - Dy))
  342.             blue = ImagePixels(2, i, j) + 0.5 * (ImagePixels(2, i, j) - ImagePixels(2, i - Dx, j - Dy))
  343.             If red > 255 Then red = 255
  344.             If red < 0 Then red = 0
  345.             If green > 255 Then green = 255
  346.             If green < 0 Then green = 0
  347.             If blue > 255 Then blue = 255
  348.             If blue < 0 Then blue = 0
  349.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  350.         Next
  351.         DoEvents
  352.     Next
  353.  
  354. End Sub
  355.  
  356.  
  357.  
  358. Public Sub ProcessSmooth(ByRef Picture1 As PictureBox)
  359.     
  360.     readit Picture1
  361.  
  362.     For i = 1 To y - 2
  363.         For j = 1 To x - 2
  364.             red = ImagePixels(0, i - 1, j - 1) + ImagePixels(0, i - 1, j) + ImagePixels(0, i - 1, j + 1) + _
  365.             ImagePixels(0, i, j - 1) + ImagePixels(0, i, j) + ImagePixels(0, i, j + 1) + _
  366.             ImagePixels(0, i + 1, j - 1) + ImagePixels(0, i + 1, j) + ImagePixels(0, i + 1, j + 1)
  367.             
  368.             green = ImagePixels(1, i - 1, j - 1) + ImagePixels(1, i - 1, j) + ImagePixels(1, i - 1, j + 1) + _
  369.             ImagePixels(1, i, j - 1) + ImagePixels(1, i, j) + ImagePixels(1, i, j + 1) + _
  370.             ImagePixels(1, i + 1, j - 1) + ImagePixels(1, i + 1, j) + ImagePixels(1, i + 1, j + 1)
  371.             
  372.             blue = ImagePixels(2, i - 1, j - 1) + ImagePixels(2, i - 1, j) + ImagePixels(2, i - 1, j + 1) + _
  373.             ImagePixels(2, i, j - 1) + ImagePixels(2, i, j) + ImagePixels(2, i, j + 1) + _
  374.             ImagePixels(2, i + 1, j - 1) + ImagePixels(2, i + 1, j) + ImagePixels(2, i + 1, j + 1)
  375.             
  376.             SetPixelV Picture1.hdc, j, i, RGB(red / 9, green / 9, blue / 9)
  377.         Next
  378.         DoEvents
  379.     Next
  380.  
  381. End Sub
  382.  
  383. Public Sub ProcessSolarize(ByRef Picture1 As PictureBox, ByVal ll As Integer, ByVal ul As Integer)
  384.     readit Picture1
  385.     For i = 1 To y - 2
  386.         For j = 1 To x - 2
  387.             red = ImagePixels(0, i, j)
  388.             green = ImagePixels(1, i, j)
  389.             blue = ImagePixels(2, i, j)
  390.             If ((red < ll) Or (red > ul)) Then red = 255 - red
  391.             If ((green < ll) Or (green > ul)) Then green = 255 - green
  392.             If ((blue < ll) Or (blue > ul)) Then blue = 255 - blue
  393.             SetPixelV Picture1.hdc, j, i, RGB(red, green, blue)
  394.         Next
  395.         DoEvents
  396.     Next
  397.  
  398. End Sub
  399.  
  400.  
  401.  
  402.  
  403.  
  404.  
  405.  
  406.