home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Bezier_ART2176843112010.psc / clsFX.cls < prev    next >
Text File  |  2010-03-11  |  5KB  |  183 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 = "clsFX"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16.  
  17. Private Type Bitmap
  18.     bmType        As Long
  19.     bmWidth   As Long
  20.     bmHeight  As Long
  21.     bmWidthBytes As Long
  22.     bmPlanes  As Integer
  23.     bmBitsPixel As Integer
  24.     bmBits    As Long
  25. End Type
  26.  
  27. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
  28. Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
  29. Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, ByRef lpBits As Any) As Long
  30.  
  31. Private TargetBits() As Byte
  32. Private SourceBits() As Byte
  33. Private SINGLEb() As Single
  34.  
  35.  
  36. Private hBmp  As Bitmap
  37.  
  38. Private iRET  As Long
  39.  
  40.  
  41. Public Sub InitTarget(pBoxPicturehandle As Long)
  42.  
  43.     iRET = GetObject(pBoxPicturehandle, Len(hBmp), hBmp)
  44.  
  45.     ReDim TargetBits(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Byte
  46.  
  47. End Sub
  48. Public Sub GetBits(pBoxPicturehandle As Long)
  49. Dim iRET      As Long
  50.     'Get the bitmap header
  51.     iRET = GetObject(pBoxPicturehandle, Len(hBmp), hBmp)
  52.     'Resize to hold image data
  53.  
  54.  
  55.     ReDim SourceBits(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Byte
  56.     'Get the image data and store into SOURCEbits array
  57.     iRET = GetBitmapBits(pBoxPicturehandle, hBmp.bmWidthBytes * hBmp.bmHeight, SourceBits(0, 0, 0))
  58.  
  59.     '    ReDim TargetBits(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Byte
  60.     'Get the image data and store into TargetBits array
  61.     '  iRet = GetBitmapBits(pBoxPicturehandle, hBmp.bmWidthBytes * hBmp.bmHeight, TargetBits(0, 0, 0))
  62.  
  63.  
  64.     ReDim SINGLEb(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Single
  65.  
  66. End Sub
  67.  
  68. Public Sub SetBits(pBoxPicturehandle As Long)
  69. Dim iRET      As Long
  70.     'Set the new image data back onto pBox
  71.     iRET = SetBitmapBits(pBoxPicturehandle, hBmp.bmWidthBytes * hBmp.bmHeight, TargetBits(0, 0, 0))
  72.     'Erase TargetBits because we finished with it now
  73.     'Erase TargetBits
  74. End Sub
  75.  
  76.  
  77.  
  78. Public Function SetBezierBits(X, Y, ByVal R As Single, ByVal G As Single, ByVal B As Single)
  79. Dim R2
  80. Dim G2
  81. Dim B2
  82. Dim X2        As Integer
  83. Dim Y2        As Integer
  84.  
  85.     R = R * 0.05
  86.     G = G * 0.05
  87.     B = B * 0.05
  88.  
  89.  
  90.     R2 = R * 0.7
  91.     G2 = G * 0.7
  92.     B2 = B * 0.7
  93.  
  94.  
  95.     SINGLEb(2, X, Y) = SINGLEb(2, X, Y) + R
  96.     SINGLEb(1, X, Y) = SINGLEb(1, X, Y) + G
  97.     SINGLEb(0, X, Y) = SINGLEb(0, X, Y) + B
  98.  
  99.  
  100.  
  101.     X2 = X - 1
  102.     Y2 = Y
  103.     SINGLEb(2, X2, Y2) = SINGLEb(2, X2, Y2) + R2
  104.     SINGLEb(1, X2, Y2) = SINGLEb(1, X2, Y2) + G2
  105.     SINGLEb(0, X2, Y2) = SINGLEb(0, X2, Y2) + B2
  106.     X2 = X + 1
  107.     Y2 = Y
  108.     SINGLEb(2, X2, Y2) = SINGLEb(2, X2, Y2) + R2
  109.     SINGLEb(1, X2, Y2) = SINGLEb(1, X2, Y2) + G2
  110.     SINGLEb(0, X2, Y2) = SINGLEb(0, X2, Y2) + B2
  111.     X2 = X
  112.     Y2 = Y - 1
  113.     SINGLEb(2, X2, Y2) = SINGLEb(2, X2, Y2) + R2
  114.     SINGLEb(1, X2, Y2) = SINGLEb(1, X2, Y2) + G2
  115.     SINGLEb(0, X2, Y2) = SINGLEb(0, X2, Y2) + B2
  116.     X2 = X
  117.     Y2 = Y + 1
  118.     SINGLEb(2, X2, Y2) = SINGLEb(2, X2, Y2) + R2
  119.     SINGLEb(1, X2, Y2) = SINGLEb(1, X2, Y2) + G2
  120.     SINGLEb(0, X2, Y2) = SINGLEb(0, X2, Y2) + B2
  121.  
  122. skip:
  123.  
  124. End Function
  125.  
  126.  
  127. Public Sub PaintBezierImage()
  128. Dim R
  129. Dim G
  130. Dim B
  131. Dim bR        As Byte
  132. Dim bG        As Byte
  133. Dim bB        As Byte
  134. Dim X         As Long
  135. Dim Y         As Long
  136.  
  137.  
  138.     For X = 0 To hBmp.bmWidth - 1
  139.         For Y = 0 To hBmp.bmHeight - 1
  140.             SINGLEb(2, X, Y) = SINGLEb(2, X, Y) * 0.999    '0.9987
  141.             SINGLEb(1, X, Y) = SINGLEb(1, X, Y) * 0.999    '0.9987
  142.             SINGLEb(0, X, Y) = SINGLEb(0, X, Y) * 0.999    '0.9987
  143.  
  144.             'If SINGLEb(2, X, Y) > 255 Then SINGLEb(2, X, Y) = 255
  145.             'If SINGLEb(1, X, Y) > 255 Then SINGLEb(1, X, Y) = 255
  146.             'If SINGLEb(0, X, Y) > 255 Then SINGLEb(0, X, Y) = 255
  147.  
  148.             If SINGLEb(2, X, Y) < 255 Then
  149.                 bR = CByte(SINGLEb(2, X, Y))
  150.             Else
  151.                 bR = 255
  152.             End If
  153.  
  154.             If SINGLEb(1, X, Y) < 255 Then
  155.                 bG = CByte(SINGLEb(1, X, Y))
  156.             Else
  157.                 bG = 255
  158.             End If
  159.  
  160.             If SINGLEb(0, X, Y) < 255 Then
  161.                 bB = CByte(SINGLEb(0, X, Y))
  162.             Else
  163.                 bB = 255
  164.             End If
  165.  
  166.  
  167.             TargetBits(2, X, Y) = Not (bR)
  168.             TargetBits(1, X, Y) = Not (bG)
  169.             TargetBits(0, X, Y) = Not (bB)
  170.         Next
  171.     Next
  172.  
  173.  
  174.  
  175. End Sub
  176.  
  177. Public Sub ClearBezierBits()
  178. 'ReDim SINGLEb(0 To (hBmp.bmBitsPixel \ 8) - 1, 0 To hBmp.bmWidth - 1, 0 To hBmp.bmHeight - 1) As Single
  179.  
  180.  
  181. End Sub
  182.  
  183.