home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / VIDEO_TO_C2172701122010.psc / BilateralEffects.cls < prev    next >
Text File  |  2010-01-13  |  15KB  |  566 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "BilateralEffect"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'Author :Roberto Mior
  15. '     reexre@gmail.com
  16. '
  17. 'If you use source code or part of it please cite the author
  18. 'You can use this code however you like providing the above credits remain intact
  19. '
  20. '
  21. '
  22. '
  23. '--------------------------------------------------------------------------------
  24. Option Explicit
  25.  
  26.  
  27. Private Type tHSP
  28.     H As Single
  29.     S As Single
  30.     P As Single
  31. End Type
  32.  
  33. Private Type tVector
  34.     x As Single
  35.     Y As Single
  36.     L As Single
  37.     
  38. End Type
  39.  
  40. Private Type Bitmap
  41.     bmType As Long
  42.     bmWidth As Long
  43.     bmHeight As Long
  44.     bmWidthBytes As Long
  45.     bmPlanes As Integer
  46.     bmBitsPixel As Integer
  47.     bmBits As Long
  48. End Type
  49.  
  50. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
  51. Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
  52. Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
  53.  
  54. Private Sbyte() As Byte
  55. Private Sbyte2() As Byte
  56.  
  57. Private BlurByte() As Byte
  58.  
  59. Private SepaByte() As Byte
  60.  
  61. 'Private PGMByte() As Byte
  62. 'Private PGM_C_Byte() As Byte
  63.  
  64. Private BILAByte() As Byte
  65. Private ContByte() As Byte
  66. Private ContByte2() As Byte
  67.  
  68. Private hBmp As Bitmap
  69.  
  70. Private pW As Integer
  71. Private PH As Integer
  72. Private PB As Integer
  73.  
  74.  
  75. Private FastExp() As Single
  76.  
  77. Private FastDIF() As Single
  78.  
  79. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _
  80.         source As Any, ByVal bytes As Long)
  81.  
  82.  
  83. Private Sub ZInitFastExp(SigS)
  84.     
  85.     Dim V As Single
  86.     Dim V2 As Single
  87.     
  88.     ReDim FastExp(255)
  89.     
  90.     For V = 0 To 255
  91.         FastExp(V) = Exp(-((V / 255) / (SigS)))
  92.     Next
  93.     
  94.     ReDim FastDIF(0 To 255, 0 To 255)
  95.     For V = 0 To 255
  96.     For V2 = 0 To 255
  97.     FastDIF(V, V2) = FastExp(Abs(V - V2))
  98.     Next
  99.     Next
  100.     
  101. End Sub
  102.  
  103.  
  104. Public Sub SetSource(pboxImageHandle As Long)
  105.     'Public Sub GetBits(pBoxPicHand As Long)
  106.     Dim iRet As Long
  107.     'Get the bitmap header
  108.     iRet = GetObject(pboxImageHandle, Len(hBmp), hBmp)
  109.     '   iRet = GetObject(pBoxPicHand, Len(hBmp), hBmp)
  110.     
  111.     'Resize to hold image data
  112.     ReDim Sbyte(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Byte
  113.     'Get the image data and store into Sbyte array
  114.     'iRet = GetBitmapBits(pBox.Picture.Handle, hBmp.bmWidthBytes * hBmp.bmHeight, Sbyte(0, 0, 0))
  115.     iRet = GetBitmapBits(pboxImageHandle, hBmp.bmWidthBytes * hBmp.bmHeight, Sbyte(0, 0, 0))
  116.     
  117.     
  118.     pW = hBmp.bmWidth - 1
  119.     PH = hBmp.bmHeight - 1
  120.     PB = (hBmp.bmBitsPixel \ 8) - 1
  121.     
  122.     
  123.     
  124.     'ReDim PGMByte(0 To PB, 0 To pW, 0 To PH)
  125.     
  126.     
  127. End Sub
  128.  
  129.  
  130.  
  131. Public Sub zEFF_CONTOUR2(Enhanced As Integer)
  132.     Dim x As Long
  133.     Dim Y As Long
  134.     
  135.     Dim iX As Long
  136.     Dim iY As Long
  137.     
  138.     Dim X2 As Long
  139.     Dim Y2 As Long
  140.     
  141.     Dim vMinR As Integer
  142.     Dim vMinG As Integer
  143.     Dim vMinB As Integer
  144.     
  145.     Dim vR As Integer
  146.     Dim vG As Integer
  147.     Dim vB As Integer
  148.     
  149.     Dim R As Integer
  150.     Dim G As Integer
  151.     Dim B As Integer
  152.     
  153.     Dim Xp3 As Long
  154.     Dim Xm3 As Long
  155.     Dim Xp2 As Long
  156.     Dim Xm2 As Long
  157.     Dim yp3 As Long
  158.     Dim ym3 As Long
  159.     Dim yp2 As Long
  160.     Dim ym2 As Long
  161.     
  162.     ReDim ContByte(0 To PB, 0 To pW, 0 To PH)
  163.     ReDim ContByte2(0 To PB, 0 To pW, 0 To PH)
  164.     
  165.     For Y = 1 To PH - 1
  166.         For x = 1 To pW - 1
  167.             ContByte2(0, x, Y) = Sbyte(0, x, Y)
  168.             ContByte2(1, x, Y) = Sbyte(1, x, Y)
  169.             ContByte2(2, x, Y) = Sbyte(2, x, Y)
  170.         Next
  171.     Next
  172.     
  173.     
  174.     If Enhanced > 0 Then ReDim ContByte2(0 To PB, 0 To pW, 0 To PH) 'As Long
  175.     
  176.     
  177.     For Y = 1 To PH - 1
  178.         For x = 1 To pW - 1
  179.             
  180.             
  181.             ' contbyte2(0, x, y) = Sbyte(0, x, y)
  182.             ' contbyte2(1, x, y) = Sbyte(1, x, y)
  183.             ' contbyte2(2, x, y) = Sbyte(2, x, y)
  184.             
  185.             
  186.             vMinR = 255
  187.             vMinG = 255
  188.             vMinB = 255
  189.             
  190.             For iX = -1 To 1
  191.                 X2 = x + iX
  192.                 For iY = -1 To 1
  193.                     
  194.                     'If IX <> 0 And IY <> 0 Then
  195.                     vR = Sbyte(0, X2, Y + iY)
  196.                     If vR < vMinR Then vMinR = vR
  197.                     
  198.                     vG = Sbyte(1, X2, Y + iY)
  199.                     If vG < vMinG Then vMinG = vG
  200.                     
  201.                     vB = Sbyte(2, X2, Y + iY)
  202.                     If vB < vMinB Then vMinB = vB
  203.                     'End If
  204.                     
  205.                 Next iY
  206.             Next iX
  207.             
  208.             
  209.             R = Sbyte(0, x, Y)
  210.             G = Sbyte(1, x, Y)
  211.             B = Sbyte(2, x, Y)
  212.             
  213.             R = (R - vMinR)
  214.             G = (G - vMinG)
  215.             B = (B - vMinB)
  216.             
  217.             If R < 10 Then R = 0
  218.             If G < 10 Then G = 0
  219.             If B < 10 Then B = 0
  220.             
  221.             
  222.             '*************
  223.             '        r = r * 4 '10 ' 12 '10
  224.             '        G = G * 4 '10 '12
  225.             '        B = B * 4 '10 '12
  226.             '*************
  227.             
  228.             If R > 255 Then R = 255
  229.             If G > 255 Then G = 255
  230.             If B > 255 Then B = 255
  231.             
  232.             ContByte2(0, x, Y) = R '255 - r
  233.             ContByte2(1, x, Y) = G '255 - G
  234.             ContByte2(2, x, Y) = B '255 - B
  235.             
  236.             
  237.         Next x
  238.     Next Y
  239.     
  240.     
  241.     'Blurring contour
  242.     
  243.     For Y = 1 To PH - 1
  244.         For x = 1 To pW - 1
  245.             
  246.             R = 0
  247.             G = 0
  248.             B = 0
  249.             
  250.             
  251.             For iX = -1 To 1
  252.                 X2 = x + iX
  253.                 For iY = -1 To 1
  254.                     Y2 = Y + iY
  255.                     R = R + ContByte2(0, X2, Y2)
  256.                     G = G + ContByte2(1, X2, Y2)
  257.                     B = B + ContByte2(2, X2, Y2)
  258.                 Next iY
  259.             Next iX
  260.             
  261.             'r = FastAVG(r + G + b) \ 9
  262.             R = (R + G + B) \ 27
  263.             
  264.             
  265.             ContByte(0, x, Y) = R
  266.             ContByte(1, x, Y) = R
  267.             ContByte(2, x, Y) = R
  268.             
  269.             
  270.         Next x
  271.     Next Y
  272.     
  273.     
  274.     
  275.     
  276.     
  277.     
  278.     '****************************************************************************
  279.     
  280.     If Enhanced > 0 Then
  281.         For Y = 0 To PH - 1
  282.             For x = 0 To pW - 1
  283.                 ContByte2(0, x, Y) = ContByte(0, x, Y)
  284.             Next x
  285.         Next Y
  286.         
  287.         
  288.         For Y = 4 To PH - 5
  289.             
  290.             ym3 = Y - 3
  291.             yp3 = Y + 3
  292.             ym2 = Y - 2
  293.             yp2 = Y + 2
  294.             
  295.             For x = 4 To pW - 5
  296.                 
  297.                 Xm3 = x - 3
  298.                 Xp3 = x + 3
  299.                 Xm2 = x - 2
  300.                 Xp2 = x + 2
  301.                 
  302.                 If ContByte2(0, Xm3, Y) + ContByte2(0, Xm2, ym2) + _
  303.                         ContByte2(0, x, ym3) + ContByte2(0, Xp2, ym2) + _
  304.                         ContByte2(0, Xp3, Y) + ContByte2(0, Xp2, yp2) + _
  305.                         ContByte2(0, x, yp3) + ContByte2(0, Xm2, yp2) < _
  306.                         Enhanced Then
  307.                 ContByte(0, x, Y) = 255
  308.                 ContByte(1, x, Y) = 255
  309.                 ContByte(2, x, Y) = 255
  310.                 
  311.             End If
  312.             
  313.             
  314.             
  315.         Next x
  316.     Next Y
  317. End If
  318.  
  319. '****************************************************************************
  320.  
  321.  
  322.  
  323. End Sub
  324.  
  325. Private Sub Class_Terminate()
  326.     'Stop
  327.     
  328.     Erase Sbyte
  329.     Erase Sbyte2
  330.     Erase ContByte
  331.     Erase BlurByte
  332.     Erase SepaByte
  333.     
  334.     'Erase PGMByte
  335.     'Erase PGM_C_Byte
  336.     
  337. End Sub
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344. Public Function zNotMin0(V) As Byte
  345.     If V < 0 Then zNotMin0 = 0 Else: zNotMin0 = V
  346. End Function
  347. Public Function zNotMax255(V As Single) As Byte
  348.     If V > 255 Then zNotMax255 = 255 Else: zNotMax255 = CByte(V)
  349. End Function
  350.  
  351. Public Sub zEFF_Contour_Apply()
  352. Dim x As Long
  353. Dim Y As Long
  354.  
  355.     For x = 0 + 1 To pW - 1
  356.         For Y = 0 + 1 To PH - 1
  357.             'BILAByte(0, X, Y) = zNotMin0(BILAByte(0, X, Y) \ 1 - 2 * (ContByte(0, X, Y) \ 1))
  358.             'BILAByte(1, X, Y) = zNotMin0(BILAByte(1, X, Y) \ 1 - 2 * (ContByte(0, X, Y) \ 1))
  359.             'BILAByte(2, X, Y) = zNotMin0(BILAByte(2, X, Y) \ 1 - 2 * (ContByte(0, X, Y) \ 1))
  360.             '    Stop
  361.             If ContByte(0, x, Y) > 0 Then
  362.                 
  363.                 BILAByte(0, x, Y) = zNotMin0(BILAByte(0, x, Y) \ 1 - (ContByte(0, x, Y) \ 1))
  364.                 BILAByte(1, x, Y) = zNotMin0(BILAByte(1, x, Y) \ 1 - (ContByte(0, x, Y) \ 1))
  365.                 BILAByte(2, x, Y) = zNotMin0(BILAByte(2, x, Y) \ 1 - (ContByte(0, x, Y) \ 1))
  366.                 
  367.             End If
  368.             'BILAByte(0, X, Y) = zNotMin0(1 * (ContByte(0, X, Y) \ 1))
  369.             'BILAByte(1, X, Y) = zNotMin0(1 * (ContByte(0, X, Y) \ 1))
  370.             'BILAByte(2, X, Y) = zNotMin0(1 * (ContByte(0, X, Y) \ 1))
  371.             
  372.         Next
  373.     Next
  374.     
  375. End Sub
  376. Public Sub zEFF_BilateralFilter(n As Long, Sigma As Single, Iterations As Long)
  377.     'Author :Roberto Mior
  378.     '     reexre@gmail.com
  379.     '
  380.     'If you use source code or part of it please cite the author
  381.     'You can use this code however you like providing the above credits remain intact
  382.     '
  383.     '
  384.     '
  385.     '
  386.     Dim I As Long
  387.     
  388.     Dim x As Long
  389.     Dim Y As Long
  390.     Dim B As Long
  391.     
  392.     Dim Xp As Long
  393.     Dim Yp As Long
  394.     Dim XmN As Long
  395.     Dim XpN As Long
  396.     Dim YmN As Long
  397.     Dim YpN As Long
  398.     
  399.     
  400.     Dim dR As Single
  401.     Dim dG As Single
  402.     Dim dB As Single
  403.     Dim TR As Long
  404.     Dim TG As Long
  405.     Dim TB As Long
  406.     
  407.     Dim RDiv As Single
  408.     Dim GDiv As Single
  409.     Dim BDiv As Single
  410.     
  411.     
  412.     ZInitFastExp 2 * Sigma * Sigma
  413.     
  414.     
  415.     
  416.     
  417.     ReDim BILAByte(0 To PB, 0 To pW, 0 To PH)
  418.     
  419.     For I = 1 To Iterations
  420.         
  421.         For x = 0 + n To pW - n
  422.             XmN = x - n
  423.             XpN = x + n
  424.             For Y = 0 + n To PH - n
  425.                 
  426.                 TR = 0
  427.                 TG = 0
  428.                 TB = 0
  429.                 RDiv = 0
  430.                 GDiv = 0
  431.                 BDiv = 0
  432.                 
  433.                 YmN = Y - n
  434.                 YpN = Y + n
  435.                 
  436.                 
  437.                 For Xp = XmN To XpN
  438.                     For Yp = YmN To YpN
  439.                         
  440.                         'How to Speed up
  441.                         'Everything inside these For Loops ?
  442.                         
  443.                         
  444.                         '***** wich is FASTER?????
  445.                         'dR = abs(Sbyte(2, Xp, Yp) \ 1 - Sbyte(2, X, Y) \ 1)
  446.                         'dG = abs(Sbyte(1, Xp, Yp) \ 1 - Sbyte(1, X, Y) \ 1)
  447.                         'dB = abs(Sbyte(0, Xp, Yp) \ 1 - Sbyte(0, X, Y) \ 1)
  448.                         
  449.                         dR = FastDIF(Sbyte(2, Xp, Yp), Sbyte(2, x, Y))
  450.                         dG = FastDIF(Sbyte(1, Xp, Yp), Sbyte(1, x, Y))
  451.                         dB = FastDIF(Sbyte(0, Xp, Yp), Sbyte(0, x, Y))
  452.                         '***************
  453.                         
  454.                         'Pixels that are very different in intensity from the central pixel are weighted less
  455.                         'dR = FastExp(dR)
  456.                         'dG = FastExp(dG)
  457.                         'dB = FastExp(dB)
  458.                         
  459.                         
  460.                         TR = TR + CSng(Sbyte(2, Xp, Yp)) * dR
  461.                         TG = TG + CSng(Sbyte(1, Xp, Yp)) * dG
  462.                         TB = TB + CSng(Sbyte(0, Xp, Yp)) * dB
  463.                         
  464.                         RDiv = RDiv + dR
  465.                         GDiv = GDiv + dG
  466.                         BDiv = BDiv + dB
  467.                         
  468.                     Next
  469.                 Next
  470.                 
  471.                 
  472.                 BILAByte(2, x, Y) = zNotMax255(TR / RDiv)
  473.                 BILAByte(1, x, Y) = zNotMax255(TG / GDiv)
  474.                 BILAByte(0, x, Y) = zNotMax255(TB / BDiv)
  475.                 
  476.                 'PIC2.PSet (X, Y), RGB(COut(X, Y).R, COut(X, Y).G, COut(X, Y).B)
  477.                 
  478.             Next
  479.             DoEvents
  480.         Next
  481.         
  482.         
  483.         'For B = 0 To PB
  484.         'For X = 0 To pW
  485.         'For Y = 0 To PH
  486.         'Sbyte(B, X, Y) = BILAByte(B, X, Y)
  487.         'Next
  488.         'Next
  489.         'Next
  490.         CopyMemory ByVal VarPtr(Sbyte(0, 0, 0)), ByVal VarPtr(BILAByte(0, 0, 0)), CLng(PB + 1) * CLng(pW + 1) * CLng(PH + 1)
  491.         
  492.     Next
  493.     
  494. End Sub
  495.  
  496. Public Sub zGet_Effect(pboxImageHandle As Long)
  497.     Dim iRet As Long
  498.     
  499.     iRet = SetBitmapBits(pboxImageHandle, hBmp.bmWidthBytes * hBmp.bmHeight, BILAByte(0, 0, 0))
  500.     
  501.     Erase BILAByte
  502. End Sub
  503.  
  504. Public Sub zGet_Contour(pboxImageHandle As Long)
  505.     Dim iRet As Long
  506.     iRet = SetBitmapBits(pboxImageHandle, hBmp.bmWidthBytes * hBmp.bmHeight, ContByte(0, 0, 0))
  507.     
  508.     Erase ContByte
  509. End Sub
  510.  
  511. Public Sub zEFF_Contour(Contour_0_100 As Single)
  512.     Dim x As Long
  513.     Dim Y As Long
  514.     
  515.     Dim ContAmount As Single
  516.     
  517.     'Contour_0_100 = 25
  518.     ContAmount = 0.00004 * Contour_0_100
  519.     
  520.         
  521.     ReDim ContByte(0 To PB, 0 To pW, 0 To PH)
  522.     ReDim ContByte2(0 To PB, 0 To pW, 0 To PH)
  523.     
  524.     Dim HSP() As tHSP
  525.     Dim Vec() As tVector
  526.     
  527.     ReDim HSP(0 To pW, 0 To PH)
  528.     ReDim Vec(0 To pW, 0 To PH)
  529.     
  530. '    frmMAIN.PIC2.Cls
  531.     
  532.     For x = 0 To pW
  533.     For Y = 0 To PH
  534.     With HSP(x, Y)
  535.     RGBtoHSP BILAByte(2, x, Y), BILAByte(1, x, Y), BILAByte(0, x, Y), .H, .S, .P
  536.     End With
  537.     Next
  538.     Next
  539.  
  540.     
  541.     For x = 1 To pW - 1
  542.     For Y = 1 To PH - 1
  543.     
  544.     With Vec(x, Y)
  545.     .Y = -(-HSP(x - 1, Y - 1).P - 2 * HSP(x - 1, Y).P - HSP(x - 1, Y + 1).P + HSP(x + 1, Y - 1).P + 2 * HSP(x + 1, Y).P + HSP(x + 1, Y + 1).P)
  546.     .x = (-HSP(x - 1, Y - 1).P - 2 * HSP(x, Y - 1).P - HSP(x + 1, Y - 1).P + HSP(x - 1, Y + 1).P + 2 * HSP(x, Y + 1).P + HSP(x + 1, Y + 1).P)
  547.     .L = (.x * .x + .Y * .Y)
  548.     '.L = .L * 0.001
  549.     .L = .L * ContAmount
  550.     
  551.     'frmMAIN.PIC2.PSet (X, Y), RGB(.L, .L, .L)
  552.     ContByte(0, x, Y) = zNotMax255(.L)
  553.     
  554.     DoEvents
  555.     
  556.     End With
  557.     
  558.     Next
  559.     Next
  560.     
  561.         
  562. End Sub
  563.  
  564.  
  565.  
  566.