home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / trans / transpar.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-29  |  5.4 KB  |  126 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   4800
  5.    ClientLeft      =   3885
  6.    ClientTop       =   2085
  7.    ClientWidth     =   2730
  8.    Height          =   5205
  9.    Left            =   3825
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   320
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   182
  14.    Top             =   1740
  15.    Width           =   2850
  16.    Begin VB.CommandButton Command1 
  17.       Caption         =   "TransparentBlt"
  18.       Height          =   375
  19.       Left            =   360
  20.       TabIndex        =   1
  21.       Top             =   1920
  22.       Width           =   1935
  23.    End
  24.    Begin VB.PictureBox Picture1 
  25.       AutoSize        =   -1  'True
  26.       Height          =   960
  27.       Left            =   360
  28.       Picture         =   "Transparent sample.frx":0000
  29.       ScaleHeight     =   60
  30.       ScaleMode       =   3  'Pixel
  31.       ScaleWidth      =   120
  32.       TabIndex        =   0
  33.       Top             =   2400
  34.       Width           =   1860
  35.    End
  36. Attribute VB_Name = "Form1"
  37. Attribute VB_Creatable = False
  38. Attribute VB_Exposed = False
  39. Option Explicit
  40. Private Type RECT
  41.   Left As Long
  42.   Top As Long
  43.   Right As Long
  44.   Bottom As Long
  45. End Type
  46. Private 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
  47. Private 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
  48. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  49. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  50. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  51. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  52. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  53. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  54. Private Sub Command1_Click()
  55.   Dim R As RECT
  56.   With R
  57.     R.Left = 20
  58.     R.Top = 20
  59.     R.Right = Picture1.ScaleWidth - 20
  60.     R.Bottom = Picture1.ScaleHeight - 20
  61.   End With
  62.   TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, R, 40, 40, vbWhite
  63. End Sub
  64. Private Sub TransparentBlt(OutDstDC, DstDC, SrcDC, SrcRect As RECT, DstX, DstY, TransColor As Long)
  65.   'DstDC=Device context into which image must be drawn transparently
  66.   'OutDstDC=Device context into image is actually drawn, even though it is made transparent in terms of DstDC
  67.   'Src=Device context of source to be made transparent in color TransColor
  68.   'SrcRect=rectangular region within SrcDC to be made transparent in terms of DstDC, and drawn to OutDstDC
  69.   'DstX, DstY =coordinates in OutDstDC (and DstDC) where tranparent bitmap must go
  70.   Rem In most cases, OutDstDC and DstDC will be the same
  71.   Dim nRet As Long, W As Integer, H As Integer
  72.   Dim MonoMaskDC As Long, hMonoMask As Long
  73.   Dim MonoInvDC As Long, hMonoInv As Long
  74.   Dim ResultDstDC As Long, hResultDst As Long
  75.   Dim ResultSrcDC As Long, hResultSrc As Long
  76.   Dim hPrevMask As Long, hPrevInv As Long, hPrevSrc As Long, hPrevDst As Long
  77.   W = SrcRect.Right - SrcRect.Left + 1
  78.   H = SrcRect.Bottom - SrcRect.Top + 1
  79.   'create monochrome mask and inverse masks
  80.   MonoMaskDC = CreateCompatibleDC(DstDC)
  81.   MonoInvDC = CreateCompatibleDC(DstDC)
  82.   hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
  83.   hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
  84.   hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  85.   hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  86.   'create keeper DCs and bitmaps
  87.   ResultDstDC = CreateCompatibleDC(DstDC)
  88.   ResultSrcDC = CreateCompatibleDC(DstDC)
  89.   hResultDst = CreateCompatibleBitmap(DstDC, W, H)
  90.   hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
  91.   hPrevDst = SelectObject(ResultDstDC, hResultDst)
  92.   hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  93.   'copy src to monochrome mask
  94.   Dim OldBC As Long
  95.   OldBC = SetBkColor(SrcDC, TransColor)
  96.   nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
  97.   TransColor = SetBkColor(SrcDC, OldBC)
  98.   'create inverse of mask
  99.   nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
  100.   'get background
  101.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
  102.   'AND with Monochrome mask
  103.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
  104.   'get overlapper
  105.   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
  106.   'AND with inverse monochrome mask
  107.   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
  108.   'XOR these two
  109.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
  110.   'output results
  111.   nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
  112.   'clean up
  113.   hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  114.   DeleteObject hMonoMask
  115.   hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  116.   DeleteObject hMonoInv
  117.   hResultDst = SelectObject(ResultDstDC, hPrevDst)
  118.   DeleteObject hResultDst
  119.   hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  120.   DeleteObject hResultSrc
  121.   DeleteDC MonoMaskDC
  122.   DeleteDC MonoInvDC
  123.   DeleteDC ResultDstDC
  124.   DeleteDC ResultSrcDC
  125. End Sub
  126.