home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD3830362000.psc / Module1.bas < prev    next >
Encoding:
BASIC Source File  |  2000-01-31  |  3.1 KB  |  71 lines
  1. Attribute VB_Name = "Module1"
  2. Public Type POINTAPI
  3.     x As Long
  4.     y As Long
  5. End Type
  6.  
  7. Public Type BITMAP
  8.     bmType As Long
  9.     bmWidth As Long
  10.     bmHeight As Long
  11.     bmWidthBytes As Long
  12.     bmPlanes As Integer
  13.     bmBitsPixel As Integer
  14.     bmBits As Long
  15. End Type
  16.  
  17. Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  18. Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  19. Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  20. Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  21. Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  22. Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  23. Declare Function ReleaseDC Lib "user32" (ByVal HWnd, ByVal hdc)
  24. Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  25. Declare Function GetDC Lib "user32" (ByVal HWnd)
  26. Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  27. Global Const SRCPAINT = &HEE0086
  28.  
  29. Global Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
  30. Global Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  31. Global Const SRCINVERT = &H660046 ' (DWORD) dest = source XOR dest
  32. Global Const TRANSCOLOR = &H0&
  33. Global Const TRANSCOLOR2 = &HFFFFFF
  34.  
  35.  
  36. Function TransparentBlt(hDestDC As Long, nDestX, nDestY, nWidth, nHeight, hSourceDC As Long, nSourceX, nSourceY, TRANSCOLOR As Long)
  37.     Dim lOldColor As Long
  38.     Dim hMaskDC As Long
  39.     Dim hMaskBmp As Long
  40.     Dim hOldMaskBmp As Long
  41.     Dim hTempBmp As Long
  42.     Dim hTempDC As Long
  43.     Dim hOldTempBmp As Long
  44.     Dim hDummy As Long
  45.     lOldColor = SetBkColor&(hSourceDC, TRANSCOLOR)
  46.     lOldColor = SetBkColor&(hDestDC, TRANSCOLOR)
  47.     hMaskDC = CreateCompatibleDC(hDestDC)
  48.     hMaskBmp = CreateCompatibleBitmap(hDestDC, nWidth, nHeight)
  49.     hOldMaskBmp = SelectObject(hMaskDC, hMaskBmp)
  50.     hTempBmp = CreateBitmap(nWidth, nHeight, 1, 1, 0&)
  51.     hTempDC = CreateCompatibleDC(hDestDC)
  52.     hOldTempBmp = SelectObject(hTempDC, hTempBmp)
  53.     If BitBlt(hTempDC, 0, 0, nWidth, nHeight, hSourceDC, nSourceX, nSourceY, SRCCOPY) Then
  54.         hDummy = BitBlt(hMaskDC, 0, 0, nWidth, nHeight, hTempDC, 0, 0, SRCCOPY)
  55.     End If
  56.     hTempBmp = SelectObject(hTempDC, hOldTempBmp)
  57.     hDummy = DeleteObject(hTempBmp)
  58.     hDummy = DeleteDC(hTempDC)
  59.     If BitBlt(hDestDC, nDestX, nDestY, nWidth, nHeight, hSourceDC, nSourceX, nSourceY, SRCINVERT) Then
  60.       If BitBlt(hDestDC, nDestX, nDestY, nWidth, nHeight, hMaskDC, 0, 0, SRCAND) Then
  61.         If BitBlt(hDestDC, nDestX, nDestY, nWidth, nHeight, hSourceDC, nSourceX, nSourceY, SRCINVERT) Then
  62.            TransparentBlt = True
  63.         End If
  64.       End If
  65.     End If
  66.     hMaskBmp = SelectObject(hMaskDC, hOldMaskBmp)
  67.     hDummy = DeleteObject(hMaskBmp)
  68.     hDummy = DeleteDC(hMaskDC)
  69.   End Function
  70.  
  71.