home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD142681292001.psc / clsBitmap.cls next >
Encoding:
Visual Basic class definition  |  2000-11-17  |  7.2 KB  |  226 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 = "clsBitmap"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15.  
  16. Private Const CLR_INVALID = &HFFFF ' used to test results of color
  17. ' API calls
  18.  
  19. Private iImageDC As Long        ' DC to the Image bitmap
  20. Private iInvertImageDC As Long  ' DC to the Inverted Image bitmap
  21. Private iMaskDC As Long         ' The DC to the Mask bitmap
  22. Private iWidth As Long          ' Size of Bitmap - X
  23. Private iHeight As Long         ' Size of Bitmap - Y
  24.  
  25. ' for this object class, 5 properties are exposed (read only) and one
  26. ' function
  27.  
  28. ' Get ImageDC           - returns a DC that contains the original
  29. '                         image
  30. ' Get InvertImageDC     - returns a DC that contains an invert of the
  31. '                         image's background
  32. ' Get MaskDC            - returns a DC that contains an invert of the
  33. '                         original image
  34. ' Fnc SetBitmap         - returns TRUE/FALSE when attempting to load
  35. '                         image into bitmap object
  36.  
  37. Property Get ImageDC() As Long
  38.     ImageDC = iImageDC              ' return the DC that contains the
  39.     ' regular image
  40. End Property
  41.  
  42. Property Get InvertImageDC() As Long
  43.     InvertImageDC = iInvertImageDC  ' return the DC that contains the
  44.     ' inverted image
  45. End Property
  46.  
  47. Property Get MaskDC() As Long
  48.     MaskDC = iMaskDC                ' return the DC that contains the
  49.     ' mask image
  50. End Property
  51.  
  52. Property Get Width() As Long
  53.     Width = iWidth                  ' return the width of the bitmap
  54. End Property
  55.  
  56. Property Get Height() As Long
  57.     Height = iHeight                ' return the height of the bitmap
  58. End Property
  59.  
  60. Public Function SetBitmap(NewBitmap As Long) As Boolean
  61.  
  62.     ' The NewBitmap argument is a handle to a bitmap, this is used to
  63.     ' grab the bitmap info, place the data into a bitmap structure, and
  64.     ' use the structure to build a bitmap/mask grab the bitmap
  65.     ' information
  66.  
  67.     Dim lResult As Long         ' lResults of our API calls
  68.     Dim iInvertImage As Long    ' temp bitmap used in creating the
  69.     ' invert image
  70.     Dim iMask As Long           ' temp bitmap used in creating mask
  71.     Dim BitmapData As BITMAP    ' data on the incoming bitmap
  72.     
  73.     BitmapData.bmPlanes = 255
  74.     lResult = GetObject(NewBitmap, Len(BitmapData), BitmapData)
  75.  
  76.     ' verify the bitmap data
  77.     If (lResult = 0) Then
  78.         SetBitmap = False
  79.     End If
  80.  
  81.     ' persist the height/width of the bitmap image
  82.  
  83.     iWidth = BitmapData.bmWidth     ' determine the bitmaps width
  84.     iHeight = BitmapData.bmHeight    ' determine the bitmaps height
  85.  
  86.     ' Three Device Contexts (DC) are created. One is temporary (for
  87.     ' the incoming bitmap which will be copied. The second is for the
  88.     ' bitmap image that will be contained with this bitmap object class,
  89.     ' and the third is for the image mask that will also be contained
  90.     ' within this bitmap object class.
  91.  
  92.     iImageDC = CreateCompatibleDC(0)
  93.     iInvertImageDC = CreateCompatibleDC(0)
  94.     iMaskDC = CreateCompatibleDC(0)
  95.  
  96.     ' make sure there are three new DC's to use in this bitmap object
  97.     If (iImageDC = 0) Or (iInvertImageDC = 0) Or (iMaskDC = 0) Then
  98.         SetBitmap = False
  99.     End If
  100.  
  101.     ' save the actual bitmap within this bitmap object
  102.     lResult = SelectObject(iImageDC, NewBitmap)
  103.  
  104.     ' make sure the object is selected
  105.     If (lResult = 0) Then
  106.         SetBitmap = False
  107.     End If
  108.  
  109.     ' create the bitmap to hold the inverted image, and connect it to
  110.     ' a DC
  111.     'iInvertImage = CreateCompatibleBitmap(iImageDC, iWidth, iHeight)
  112.     iInvertImage = CreateCompatibleBitmap(GetDC(0&), iWidth, iHeight)
  113.     ' make sure a bitmap can be created
  114.     If (iMask = 0) Then
  115.         SetBitmap = False
  116.     End If
  117.  
  118.     ' copy the image into the bitmap just created
  119.     lResult = SelectObject(iInvertImageDC, iInvertImage)
  120.  
  121.     ' make sure the object is selected
  122.     If (lResult = 0) Then
  123.         SetBitmap = False
  124.     End If
  125.  
  126.     ' create the bitmap to hold the mask, and connect it to a DC
  127.     'iMask = CreateCompatibleBitmap(iMaskDC, iWidth, iHeight)
  128.     iMask = CreateCompatibleBitmap(GetDC(0&), iWidth, iHeight)
  129.  
  130.     ' make sure a bitmap can be created
  131.     If (iMask = 0) Then
  132.         SetBitmap = False
  133.     End If
  134.  
  135.     ' the bitmap is now in memory, attach it to the DC created for the
  136.     'Mask
  137.     lResult = SelectObject(iMaskDC, iMask)
  138.  
  139.     ' make sure the object is selected
  140.     If (lResult = 0) Then
  141.         SetBitmap = False
  142.     End If
  143.  
  144.     ' blit the incoming image into the ImageDC created, now there is a
  145.     ' permanent copy of the original image
  146.     lResult = BitBlt(iInvertImageDC, 0, 0, iWidth, iHeight, iImageDC, 0, 0, SRCCOPY)
  147.  
  148.     ' if the first blit fails, SetBitmap = False
  149.     If (lResult = 0) Then
  150.         SetBitmap = False
  151.     End If
  152.  
  153.     ' create the Mask image first
  154.     lResult = BitBlt(iMaskDC, 0, 0, iWidth, iHeight, iImageDC, 0, 0, SRCCOPY)
  155.  
  156.     ' if the first blit fails, SetBitmap = False
  157.     If (lResult = 0) Then
  158.         SetBitmap = False
  159.     End If
  160.  
  161.     ' next change the background of the real bitmap, this is done to
  162.     ' create
  163.     ' the Mask image.
  164.     lResult = SetBkColor(iInvertImageDC, vbBlack)
  165.  
  166.     ' Make sure the background color is set successfully
  167.     If (lResult = CLR_INVALID) Then
  168.         SetBitmap = False
  169.     End If
  170.  
  171.     ' Change the textcolor of the real bitmap. This is done to create
  172.     ' the mask image
  173.     lResult = SetTextColor(iInvertImageDC, vbWhite)
  174.  
  175.     ' make sure the text color is set successfully
  176.     If (lResult = CLR_INVALID) Then
  177.         SetBitmap = False
  178.     End If
  179.  
  180.     ' invert the white background to black on the real bitmap, by
  181.     ' blitting
  182.     ' the Mask created over the slightly modified original bitmap.
  183.     ' This will result in the background color becoming black -
  184.     ' perfect for transparent blitting.
  185.     lResult = BitBlt(iInvertImageDC, 0, 0, iWidth, iHeight, iMaskDC, 0, 0, SRCAND)
  186.  
  187.     ' make sure the blit succeeded
  188.     If (lResult = 0) Then
  189.         SetBitmap = False
  190.     End If
  191.  
  192.     ' destroy the temporary bitmap created to hold the Inverted Image
  193.     lResult = DeleteObject(iInvertImage)
  194.  
  195.     ' make sure our temporary bitmap is deleted
  196.     If (lResult = 0) Then
  197.         SetBitmap = False
  198.     End If
  199.  
  200.     ' destroy the temporary bitmap created to hold the Mask Image
  201.     lResult = DeleteObject(iMask)
  202.  
  203.     ' make sure the temporary bitmap is deleted
  204.     If (lResult = 0) Then
  205.         SetBitmap = False
  206.     End If
  207.  
  208.     ' the bitmap image has been loaded into the bitmap object,
  209.     ' return a successful attempt
  210.     SetBitmap = True
  211.  
  212. End Function
  213.  
  214. Private Sub Class_Terminate()
  215.  
  216.     ' when this object is destroyed, destroy the Device Contexts that
  217.     ' are being used.
  218.  
  219.     Call DeleteDC(iImageDC)         ' delete the image DC
  220.     Call DeleteDC(iInvertImageDC)   ' delete the inverted image DC
  221.     Call DeleteDC(iMaskDC)          ' delete the mask DC
  222.  
  223. End Sub
  224.  
  225.  
  226.