home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frmPicMask
- BorderStyle = 1 'Fixed Single
- Caption = "Mask, transparency and raster operations"
- ClientHeight = 5595
- ClientLeft = 45
- ClientTop = 330
- ClientWidth = 6645
- Icon = "picmask.frx":0000
- LinkTopic = "Form1"
- LockControls = -1 'True
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 373
- ScaleMode = 3 'Pixel
- ScaleWidth = 443
- Begin VB.CommandButton cmdClear
- Caption = "Clear"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 3300
- TabIndex = 19
- ToolTipText = "Use only one API, via reverse masked foreground"
- Top = 4830
- Width = 1020
- End
- Begin VB.CommandButton cmdExit
- Caption = "Exit"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 4350
- TabIndex = 18
- Top = 4830
- Width = 1020
- End
- Begin VB.PictureBox picTransparent
- AutoRedraw = -1 'True
- Height = 1575
- Left = 4650
- ScaleHeight = 101
- ScaleMode = 3 'Pixel
- ScaleWidth = 102
- TabIndex = 17
- Top = 2910
- Width = 1590
- End
- Begin VB.PictureBox picFgd
- AutoRedraw = -1 'True
- Height = 1545
- Left = 2490
- Picture = "picmask.frx":030A
- ScaleHeight = 99
- ScaleMode = 3 'Pixel
- ScaleWidth = 102
- TabIndex = 16
- Top = 630
- Width = 1590
- End
- Begin VB.CommandButton cmdMethod2
- Caption = "Method 2"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 2250
- TabIndex = 14
- ToolTipText = "Involve many APIs and DCs, via transparent bitmap"
- Top = 4830
- Width = 1020
- End
- Begin VB.PictureBox picReverseMaskedFgd
- AutoRedraw = -1 'True
- Height = 1545
- Left = 4650
- ScaleHeight = 99
- ScaleMode = 3 'Pixel
- ScaleWidth = 104
- TabIndex = 5
- Top = 2910
- Width = 1620
- End
- Begin VB.CommandButton cmdMethod1
- Caption = "Method 1"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 375
- Left = 1200
- TabIndex = 4
- ToolTipText = "Use only one API, via reverse masked foreground"
- Top = 4830
- Width = 1020
- End
- Begin VB.PictureBox picProduct
- AutoRedraw = -1 'True
- Height = 1575
- Left = 4710
- ScaleHeight = 101
- ScaleMode = 3 'Pixel
- ScaleWidth = 102
- TabIndex = 3
- Top = 630
- Width = 1590
- End
- Begin VB.PictureBox picReversedMask
- AutoRedraw = -1 'True
- Height = 1515
- Left = 2520
- ScaleHeight = 97
- ScaleMode = 3 'Pixel
- ScaleWidth = 98
- TabIndex = 2
- Top = 2910
- Width = 1530
- End
- Begin VB.PictureBox picMask
- AutoRedraw = -1 'True
- Height = 1575
- Left = 270
- ScaleHeight = 101
- ScaleMode = 3 'Pixel
- ScaleWidth = 102
- TabIndex = 1
- Top = 2880
- Width = 1590
- End
- Begin VB.PictureBox picBackgd
- AutoRedraw = -1 'True
- AutoSize = -1 'True
- Height = 1650
- Left = 270
- Picture = "picmask.frx":7FFC
- ScaleHeight = 106
- ScaleMode = 3 'Pixel
- ScaleWidth = 102
- TabIndex = 0
- Top = 630
- Width = 1590
- End
- Begin VB.PictureBox picUnblockedFgd
- AutoRedraw = -1 'True
- Height = 1545
- Left = 2520
- ScaleHeight = 99
- ScaleMode = 3 'Pixel
- ScaleWidth = 99
- TabIndex = 15
- Top = 2910
- Width = 1545
- End
- Begin VB.Label lblEqual
- Caption = "="
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 13.5
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 315
- Left = 4290
- TabIndex = 13
- Top = 1170
- Width = 225
- End
- Begin VB.Label lblPlus
- Caption = "+"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 13.5
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 315
- Left = 2040
- TabIndex = 12
- Top = 1200
- Width = 225
- End
- Begin VB.Label lblEndResult
- Alignment = 2 'Center
- Caption = "Product"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 4860
- TabIndex = 11
- Top = 240
- Width = 1380
- End
- Begin VB.Label lblReversedMask
- Alignment = 2 'Center
- Caption = "Reversed mask"
- Height = 375
- Left = 2670
- TabIndex = 10
- Top = 2460
- Width = 1230
- End
- Begin VB.Label lblReverseMaskedFgd
- Alignment = 2 'Center
- Caption = "Reverse-masked foreground"
- Height = 405
- Left = 4800
- TabIndex = 9
- Top = 2460
- Width = 1350
- End
- Begin VB.Label lblBackGround
- Alignment = 2 'Center
- Caption = "Background"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 480
- TabIndex = 8
- Top = 240
- Width = 1020
- End
- Begin VB.Label lblMask
- Alignment = 2 'Center
- Caption = "Mask"
- Height = 285
- Left = 510
- TabIndex = 7
- Top = 2550
- Width = 1050
- End
- Begin VB.Label lblForeGround
- Alignment = 2 'Center
- Caption = "Foreground"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2790
- TabIndex = 6
- Top = 240
- Width = 1020
- End
- Attribute VB_Name = "frmPicMask"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- ' PicMask.frm
- ' By Herman Liu
- ' If you have problems in grasping the basics of mask and raster operations, or
- ' find it difficult to digest the materials you have tried hard to obtain, it
- ' is not yourself to blame. Most of the materials around on these topics are either
- ' too "dry" or only "half-baked" for non-professionals, some are even obsolete.
- ' This code attempts to knit together the essential points pertaining to the
- ' inter-relationship of mask, transparency and raster operations, in a live example.
- ' Hope it will be of help to you.
- ' The exercise is to overlay a given picture onto another; the latter being the
- ' background of the new picture. Two different approaches are presented; it is up
- ' to you to choose which one to follow (or both).
- Option Explicit
- 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
- '--------------------------------------------------------
- ' The following APIs are required only when Method 2 is opted
- '--------------------------------------------------------
- Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, _
- ByVal crColor As Long) As Long
- Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
- ByVal y As Long) As Long
- Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
- ByVal nWidth As Long, ByVal nHeight As Long) As Long
- Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
- Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
- ByVal hObject As Long) As Long
- Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
- 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
- Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
- Dim picW As Long
- Dim picH As Long
- Dim mresult
-
- Private Sub Form_Load()
- Me.Move 0, 0
- picBackgd.AutoRedraw = True
- picBackgd.AutoSize = True
- picFgd.AutoRedraw = True
- picFgd.AutoSize = False
- picMask.AutoRedraw = True
- picMask.AutoSize = False
- picProduct.AutoRedraw = True
- picProduct.AutoSize = True
- ' For use if Method 1 only
- picReverseMaskedFgd.AutoRedraw = True
- picReverseMaskedFgd.AutoSize = False
- picReversedMask.AutoRedraw = True
- picReversedMask.AutoSize = False
- ' For use if Method 2 only (Not shared, for clarity purposes)
- picUnblockedFgd.AutoRedraw = True
- picUnblockedFgd.AutoSize = False
- picTransparent.AutoRedraw = True
- picTransparent.AutoSize = False
- picBackgd.Width = picFgd.Width
- picBackgd.Height = picFgd.Height
- picMask.Width = picFgd.Width
- picMask.Height = picFgd.Height
- picProduct.Width = picFgd.Width
- picProduct.Height = picFgd.Height
- picReverseMaskedFgd.Height = picFgd.Height
- picReverseMaskedFgd.Width = picFgd.Width
- picReversedMask.Height = picFgd.Height
- picReversedMask.Width = picFgd.Width
- picUnblockedFgd.Width = picFgd.Width
- picUnblockedFgd.Height = picFgd.Height
- picTransparent.Width = picFgd.Width
- picTransparent.Height = picFgd.Height
- ' Align
- picFgd.Top = picBackgd.Top
- picProduct.Top = picBackgd.Top
- picUnblockedFgd.Top = picMask.Top
- picReverseMaskedFgd.Top = picMask.Top
- picTransparent.Top = picMask.Top
- picReversedMask.Top = picMask.Top
- picMask.Left = picBackgd.Left
- picUnblockedFgd.Left = picFgd.Left
- picReverseMaskedFgd.Left = picFgd.Left
- picTransparent.Left = picProduct.Left
- picReversedMask.Left = picProduct.Left
- ' For convenience
- picW = picBackgd.ScaleWidth
- picH = picBackgd.ScaleHeight
- ' Default these first. The following two labels
- ' are shared by Method 1 and 2.
- lblMask.Caption = ""
- lblReverseMaskedFgd.Caption = ""
- lblReversedMask.Caption = ""
- picUnblockedFgd.Visible = False
- picTransparent.Visible = False
- End Sub
- ' To blacken the non-white area
- Sub CreateImageMask(inPic As PictureBox, inColorToUse)
- On Error Resume Next
- Dim mTranspColor As Long
- Dim i, j
- mTranspColor = inPic.Point(1, 1)
- ' See if existing background is fully covered by
- ' some foreground color which is to serve as
- ' background visually. We are to use image of
- ' picBackgd as the background.
- If mTranspColor <> inColorToUse Then
- For j = 0 To picH + 1
- For i = 0 To picW + 1
- If inPic.Point(j, i) = mTranspColor Then
- inPic.PSet (j, i), vbWhite
- End If
- Next i
- DoEvents
- Next j
- End If
- For j = 0 To picH + 1
- For i = 0 To picW + 1
- If inPic.Point(j, i) <> vbWhite Then
- inPic.PSet (j, i), inColorToUse
- End If
- Next i
- DoEvents
- Next j
- End Sub
- Private Sub cmdMethod1_Click()
- On Error Resume Next
- Me.MousePointer = vbHourglass
- picMask.Cls
- picMask.Picture = LoadPicture()
- picReverseMaskedFgd.Cls
- picReverseMaskedFgd.Picture = LoadPicture()
- picReversedMask.Cls
- picReversedMask.Picture = LoadPicture()
- picProduct.Cls
- picProduct.Picture = LoadPicture()
- lblMask.Caption = "Mask"
- lblReverseMaskedFgd.Caption = "Reverse-masked foreground"
- picReverseMaskedFgd.Visible = True
- picTransparent.Visible = False
- lblReversedMask.Caption = "Reversed mask"
- picReversedMask.Visible = True
- picUnblockedFgd.Visible = False
- ' (For method 1, we will superimpose on picProduct the
- ' reverse masked foreground, not the picFgd itself, hence
- ' we don't have to call doUnBlockForeGround as we do in
- ' the case of method 2)
-
- ' Prepare picMask (get a replica of foregound image, then mask it)
- mresult = BitBlt(picMask.hdc, 0, 0, picW, picH, _
- picFgd.hdc, 0, 0, vbSrcCopy)
-
- ' Do masking
- CreateImageMask picMask, vbBlack
- picMask.Picture = picMask.Image
- ' Background picBackgd can readily be copied onto picProduct
- BitBlt picProduct.hdc, 0, 0, picW, picH, picBackgd.hdc, 0, 0, vbSrcCopy
- picProduct.Picture = picProduct.Image
- ' Copy the mask onto the picProduct using the vbMergePaint opcode
- ' to erase pixels corresponding to black parts of the mask.
- BitBlt picProduct.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbMergePaint
- picProduct.Picture = picProduct.Image
- CreateReverseMaskedFgd
- ' Copy the reverse masked Fgd image onto the masked background
- BitBlt picProduct.hdc, 0, 0, picW, picH, picReverseMaskedFgd.hdc, _
- 0, 0, vbSrcAnd
- picProduct.Picture = picProduct.Image
- Me.MousePointer = vbDefault
- End Sub
- ' For creating reverse-masked foreground as an intermediary
- Private Sub CreateReverseMaskedFgd()
- ' Make a reversed mask.
- BitBlt picReversedMask.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbNotSrcCopy
- picReversedMask.Picture = picReversedMask.Image
- ' Copy picFgd to picReverseMaskedFgd
- BitBlt picReverseMaskedFgd.hdc, 0, 0, picW, picH, picFgd.hdc, _
- 0, 0, vbSrcCopy
- picReverseMaskedFgd.Picture = picReverseMaskedFgd.Image
- ' Copy the earlier reversed mask onto the picRevserseMaskedFgd
- ' using vbMergePaint opcode to erase part of the foreground
- ' which corresponds to the black parts of that reversed mask.
- BitBlt picReverseMaskedFgd.hdc, 0, 0, picW, picH, picReversedMask.hdc, _
- 0, 0, vbMergePaint
- picReverseMaskedFgd.Picture = picReverseMaskedFgd.Image
- End Sub
- Private Sub cmdMethod2_Click()
- On Error Resume Next
- Me.MousePointer = vbHourglass
- picMask.Cls
- picMask.Picture = LoadPicture()
- picUnblockedFgd.Cls
- picUnblockedFgd.Picture = LoadPicture()
- picTransparent.Cls
- picTransparent.Picture = LoadPicture()
- picProduct.Cls
- picProduct.Picture = LoadPicture()
- lblMask.Caption = "Mask"
- lblReversedMask.Caption = "Unblocked foreground"
- picUnblockedFgd.Visible = True
- picReversedMask.Visible = False
- lblReverseMaskedFgd.Caption = "Transparent bitmap"
- picTransparent.Visible = True
- picReverseMaskedFgd.Visible = False
- ' For method 2, we have to check if entire foreground of picFgd
- ' is painted; if so change it, but reflect the change in
- ' picUnblockedFgd only (as after being made transparent it is
- ' this one to be superimposed on picProduct)
- '
- ' Make a copy of picFgd for picUnblockedFgd first
- mresult = BitBlt(picUnblockedFgd.hdc, 0, 0, picW, picH, _
- picFgd.hdc, 0, 0, vbSrcCopy)
- picUnblockedFgd.Picture = picUnblockedFgd.Image
-
- ' Unblock existing background as we are to use a
- ' specified background as per picBackgd.
- doUnBlockForeGround picFgd, picUnblockedFgd
- ' Use the unblocked foreground to prepare picMask (get a
- ' replica of foregound image, then mask it).
- ' Make a copy of picUnblockedFgd for its masking
- mresult = BitBlt(picMask.hdc, 0, 0, picW, picH, _
- picUnblockedFgd.hdc, 0, 0, vbSrcCopy)
- ' Do masking
- CreateImageMask picMask, vbBlack
- picMask.Picture = picMask.Image
- ' Background picBackgd can readily be copied onto picProduct
- BitBlt picProduct.hdc, 0, 0, picW, picH, picBackgd.hdc, _
- 0, 0, vbSrcCopy
- picProduct.Picture = picProduct.Image
- ' Copy the mask onto the picProduct using the vbMergePaint opcode
- ' to erase pixels corresponding to black parts of the mask.
- BitBlt picProduct.hdc, 0, 0, picW, picH, picMask.hdc, 0, 0, vbMergePaint
- picProduct.Picture = picProduct.Image
- ' Continue with other processes
- Dim mColorAsTransparentr As Long
- ' vbWhite as it is that part of area to become transparent in this case
- mColorAsTransparentr = vbWhite
- MakeTransparentPic picUnblockedFgd, picTransparent, _
- mColorAsTransparentr
-
- ' Put the transparent picFgd on picProduct
- BitBlt picProduct.hdc, 0, 0, picW, picH, picTransparent.hdc, _
- 0, 0, vbSrcAnd
- picProduct.Picture = picProduct.Image
- Me.MousePointer = vbDefault
- DoEvents
- End Sub
- ' For creating a transparent bitmap as an intermediary
- Sub MakeTransparentPic(inpicSrc As PictureBox, inpicDest As PictureBox, _
- inTransColor As Long)
- On Error Resume Next
- Dim mMaskDC As Long
- Dim mMaskBmp As Long
- Dim mTempMaskBMP As Long
- Dim mMonoBMP As Long
- Dim mMonoDC As Long
- Dim mTempMonoBMP As Long
- Dim mSrcHDC As Long, mDestHDC As Long
- Dim w As Long, h As Long
- w = inpicSrc.ScaleWidth
- h = inpicSrc.ScaleHeight
- mSrcHDC = inpicSrc.hdc
- mDestHDC = inpicDest.hdc
- ' Set back color of source pic and dest pic to
- ' the desired transparent color
- mresult = SetBkColor&(mSrcHDC, inTransColor)
- mresult = SetBkColor&(mDestHDC, inTransColor)
- ' Create a mask DC compatible with dest image
- mMaskDC = CreateCompatibleDC(mDestHDC)
- ' and a bitmap of its size
- mMaskBmp = CreateCompatibleBitmap(mDestHDC, w, h)
- ' Move that bitmap into mMaskDC
- mTempMaskBMP = SelectObject(mMaskDC, mMaskBmp)
- ' Meanwhile create another DC for mono bitmap by
- ' setting nPlane and nbitCount both to 1.
- mMonoDC = CreateCompatibleDC(mDestHDC)
- ' and its bitmap, a mono one.
- mMonoBMP = CreateBitmap(w, h, 1, 1, 0)
- mTempMonoBMP = SelectObject(mMonoDC, mMonoBMP)
- ' Copy source image to mMonoDC
- mresult = BitBlt(mMonoDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcCopy)
-
- ' Copy the mMonoDC into mMaskDC
- mresult = BitBlt(mMaskDC, 0, 0, w, h, mMonoDC, 0, 0, vbSrcCopy)
- 'We don't need mMonoBMP any longer
- mMonoBMP = SelectObject(mMonoDC, mTempMonoBMP)
- mresult = DeleteObject(mMonoBMP)
- mresult = DeleteDC(mMonoDC)
- 'Now copy source image to dest image with XOR
- mresult = BitBlt(mDestHDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcInvert)
- 'Copy the mMaskDC to dest image with AND
- mresult = BitBlt(mDestHDC, 0, 0, w, h, mMaskDC, 0, 0, vbSrcAnd)
- 'Copy source image to dest image with XOR
- BitBlt mDestHDC, 0, 0, w, h, mSrcHDC, 0, 0, vbSrcInvert
- 'Picture is there to stay
- inpicDest.Picture = inpicDest.Image
-
- ' We don't need mask DC and bitmap.
- mMaskBmp = SelectObject(mMaskDC, mTempMaskBMP)
- mresult = DeleteObject(mMaskBmp)
- mresult = DeleteDC(mMaskDC)
- End Sub
- ' Called only if Method 2 is deployed.
- Private Sub doUnBlockForeGround(inPic1 As PictureBox, inPic2 As PictureBox)
- Dim mTranspColor
- Dim i, j
- mTranspColor = inPic1.Point(1, 1)
- If mTranspColor <> vbWhite Then
- For j = 0 To picH + 1
- For i = 0 To picW + 1
- If inPic1.Point(j, i) = mTranspColor Then
- ' We keep inPic1 as it is, but change inPic2
- ' we are to use inPic2 if Method 2 is deployed.
- inPic2.PSet (j, i), vbWhite
- End If
- Next i
- Next j
- DoEvents ' See something going on
- End If
- End Sub
- Private Sub cmdClear_Click()
- picMask.Cls
- picMask.Picture = LoadPicture()
- picReverseMaskedFgd.Cls
- picReverseMaskedFgd.Picture = LoadPicture()
- picReversedMask.Cls
- picReversedMask.Picture = LoadPicture()
- picProduct.Cls
- picProduct.Picture = LoadPicture()
- picUnblockedFgd.Cls
- picUnblockedFgd.Picture = LoadPicture()
- picTransparent.Cls
- picTransparent.Picture = LoadPicture()
- lblMask.Caption = ""
- lblReverseMaskedFgd.Caption = ""
- picReverseMaskedFgd.Visible = True
- picTransparent.Visible = False
- lblReversedMask.Caption = ""
- picReversedMask.Visible = True
- picUnblockedFgd.Visible = False
- End Sub
- Private Sub cmdExit_Click()
- Unload Me
- End Sub
-