home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Alpha-Blen179138992004.psc / AlphaBlendImage.cls < prev    next >
Text File  |  2004-08-25  |  5KB  |  131 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 = "AlphaBlendImage"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' Copyright 2004, Craig Bonathan
  15.  
  16. Option Explicit
  17.  
  18. Private Type BITMAPINFOHEADER
  19.     biSize As Long
  20.     biWidth As Long
  21.     biHeight As Long
  22.     biPlanes As Integer
  23.     biBitCount As Integer
  24.     biCompression As Long
  25.     biSizeImage As Long
  26.     biXPelsPerMeter As Long
  27.     biYPelsPerMeter As Long
  28.     biClrUsed As Long
  29.     biClrImportant As Long
  30. End Type
  31.  
  32. Private Type RGBQUAD
  33.     rgbBlue As Byte
  34.     rgbGreen As Byte
  35.     rgbRed As Byte
  36.     rgbReserved As Byte
  37. End Type
  38.  
  39. Private Type BITMAPINFO
  40.     bmiHeader As BITMAPINFOHEADER
  41.     bmiColors As RGBQUAD
  42. End Type
  43.  
  44. Private Type BLENDFUNCTION
  45.     BlendOp As Byte
  46.     BlendFlags As Byte
  47.     SourceConstantAlpha As Byte
  48.     AlphaFormat As Byte
  49. End Type
  50.  
  51. Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal BLENDFUNCT As Long) As Long
  52. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  53.  
  54. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  55. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  56. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  57. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  58. Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
  59. Private Declare Function CreateDIBitmap Lib "gdi32.dll" (ByVal hDC As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, ByVal lpInitBits As Long, lpInitInfo As BITMAPINFO, ByVal wUsage As Long) As Long
  60.  
  61. Private ImageDC As Long, ImageBitmap As Long, ImageOldBitmap As Long
  62. Private Width As Long, Height As Long
  63. Public ImageName As String
  64. Private BlendOptions As Long
  65. Private TempPic As IPictureDisp
  66. Private Init As Boolean
  67.  
  68. Public Sub LoadImage(FileName As String, ImageNum As Long, Optional Opacity As Byte = 255)
  69.     Dim ImageCount As Long
  70.     Dim FileNum As Long, DataPos As Long, DataSize As Long
  71.     Dim ImageData() As Byte
  72.     Dim BitmapDetails As BITMAPINFO
  73.     Dim Temp As BLENDFUNCTION
  74.     
  75.     FileNum = FreeFile
  76.     Open FileName For Binary Access Read As #FileNum
  77.     Get #FileNum, 1, ImageCount
  78.     Get #FileNum, 5, Width
  79.     Get #FileNum, 9, Height
  80.     DataSize = Width * Height * 4
  81.     DataPos = DataSize * ImageNum + 12
  82.     ReDim ImageData(DataSize - 1)
  83.     Get #FileNum, DataPos, ImageData()
  84.     Close #FileNum
  85.     
  86.     ImageDC = CreateCompatibleDC(0)
  87.     
  88.     BitmapDetails.bmiHeader.biSize = Len(BitmapDetails.bmiHeader)
  89.     BitmapDetails.bmiHeader.biWidth = Width
  90.     BitmapDetails.bmiHeader.biHeight = Height
  91.     BitmapDetails.bmiHeader.biPlanes = 1
  92.     BitmapDetails.bmiHeader.biBitCount = 32
  93.     BitmapDetails.bmiHeader.biCompression = 0
  94.     BitmapDetails.bmiHeader.biSizeImage = 0
  95.     BitmapDetails.bmiHeader.biXPelsPerMeter = 0
  96.     BitmapDetails.bmiHeader.biYPelsPerMeter = 0
  97.     BitmapDetails.bmiHeader.biClrImportant = 0
  98.     BitmapDetails.bmiHeader.biClrUsed = 0
  99.     
  100.     ImageBitmap = CreateDIBitmap(GetDC(0), BitmapDetails.bmiHeader, &H4, VarPtr(ImageData(0)), BitmapDetails, 0)
  101.     
  102.     If ImageBitmap = 0 Then MsgBox ("Error: Loading Alpha Blend Image")
  103.     ImageOldBitmap = SelectObject(ImageDC, ImageBitmap)
  104.     
  105.     Temp.BlendOp = 0
  106.     Temp.BlendFlags = 0
  107.     Temp.SourceConstantAlpha = Opacity
  108.     Temp.AlphaFormat = 1
  109.     
  110.     CopyMemory VarPtr(BlendOptions), VarPtr(Temp), 4
  111.     
  112.     Init = True
  113. End Sub
  114.  
  115. Public Sub UnloadImage()
  116.     If Init = True Then
  117.         SelectObject ImageDC, ImageOldBitmap
  118.         DeleteObject ImageBitmap
  119.         DeleteDC ImageDC
  120.         Init = False
  121.     End If
  122. End Sub
  123.  
  124. Public Sub DrawImage(hDC As Long, XPos As Long, YPos As Long)
  125.     AlphaBlend hDC, XPos, YPos, Width, Height, ImageDC, 0, 0, Width, Height, BlendOptions
  126. End Sub
  127.  
  128. Private Sub Class_Terminate()
  129.     UnloadImage
  130. End Sub
  131.