AboutRobert Nunemaker Expertise String manipulation, Database access and usage, Class creation, and
encapsulation are my strong suits. Active X Controls and DLL`s also.
Although I don`t deal with Crystal - frankly because I don`t like it; I
prefer to do things manually.
Experience Employment history: Programmed with the Air Force for 15 years, and have continued in the private sector for the past 1 year. Used VB (all versions) for the past 8 years.
Question -------------------------
Followup To
Question -
Hello there,
I'm just wondering how I can overlap the contents of two picture boxes, but with the top picture having a transparent colour...for example picturebox1 has the letter A with a white background and picturebox2 has the letter B with a blue background...how can I make the blue background in picturebox2 transparent so the A can still be seen behind the B?
Thanking you enormously,
Tom.
Answer -
If you are using VB.NET, it's fairly easy. If VB6, it's fairly difficult. For VB6, there are 2 techniques. 1 is to use API's to accomplish it and is fairly involved. The other is to use a Picture editing program of some kind to set the blue color as the Transparency color. This will allow the effect you are looking for.
-------------->
I'm using VB6, if you'd rather not go into it, just the API would be handy and I'll work it out from there. Thanks.
Answer It's rather involved to explain, so here's some code for you to load into a test project. I can't really take all the credit for it. I've had it for some time that I got from a friend and have tweaked it from time to time. You'll have to set the Picture property of the picBackgd control and the picFgd control to your desired pictures (BMP's preferred). Then, try running it. You may have to play a little bit with it, but it's pretty neat.
Hope this helps. Good Luck!
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
' 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
' 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
' [Note there is a better alternative: Let Windows to translate a color
' bitmap into a monochrome bitmap when it is copied in memory device
' context. All the nonwhite pixels will come out black.]
Sub CreateMask(inPic As PictureBox, inColorToUse)
On Error Resume Next
Dim mTranspColor As Long
Dim i, j
mTranspColor = inPic.Point(0, 0)
' 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
' (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)
' 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
' 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 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
' 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
CreateMask picMask, vbBlack
' 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
CreateTransparent 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 CreateTransparent(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 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)
' If existing background is fully covered by
' some foreground color which only serves as
' background visually. We have to change that
' since we are to use image of picBackgd as the
' background
Dim mTranspColor, mBackColor
Dim i, j
mTranspColor = inPic1.Point(0, 0)
mBackColor = inPic2.BackColor
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.
' (Thought we may simply replace (j,i) with
' vbWhite here in this program, to be effective
' in other cases, we use pic2's BackColor)
inPic2.PSet (j, i), mBackColor
End If
Next i
Next j
End If
End Sub
