Picturebox Transparency???

[LawnNinja]

I have a checkbox and I want it so when you click it all the perfectly black colours become completly transparent???????
Can this be done???????

[chemicalNova]

Depending on what you mean by "Transparent". You can remove the black pixels to look like an empty picturebox. The easiest way being..

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" _
    (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, _
    pccolorref As Long) As Long
Private Const CLR_INVALID = -1
 
Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function
 
Private Sub Command1_Click()
Dim x As Long
Dim y As Long
Dim pixelColour As Long
 
For x = 0 To Picture1.ScaleWidth
    For y = 0 To Picture1.ScaleHeight
        pixelColour = GetPixel(Picture1.hdc, x, y)
        If (pixelColour = RGB(0, 0, 0)) Then
            SetPixelV Picture1.hdc, x, y, TranslateColor(vbButtonFace)
        End If
    Next y
    Picture1.Refresh
Next x
End Sub

Or faster..

Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage 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 GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
 
Private Type BITMAP
  bmType        As Long
  bmWidth       As Long
  bmHeight      As Long
  bmWidthBytes  As Long
  bmPlanes      As Integer
  bmBitsPixel   As Integer
  bmBits        As Long
End Type
 
Private Type BITMAPINFOHEADER
   biSize           As Long
   biWidth          As Long
   biHeight         As Long
   biPlanes         As Integer
   biBitCount       As Integer
   biCompression    As Long
   biSizeImage      As Long
   biXPelsPerMeter  As Long
   biYPelsPerMeter  As Long
   biClrUsed        As Long
   biClrImportant   As Long
End Type
 
Private Type RGBQUAD
   rgbBlue      As Byte
   rgbGreen     As Byte
   rgbRed       As Byte
   rgbReserved  As Byte
End Type
 
Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type
 
Private PicInfo         As BITMAP
Private DIBInfo         As BITMAPINFO
 
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" _
    (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, _
    pccolorref As Long) As Long
Private Const CLR_INVALID = -1
 
Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long
    If OleTranslateColor(oClr, hPal, TranslateColor) Then
        TranslateColor = CLR_INVALID
    End If
End Function
 
' I know these look yuck. Leave them alone...
 
Private Function GetBlue(ByVal Color As Long) As Byte
    Dim blue As Long
    Dim green As Long
    
    blue = Int(Color / 65536)
    green = Int((Color - (blue * 65536)) / 256)
    GetBlue = Int(Color - (blue * 65536) - (green * 256))
End Function
 
Private Function GetGreen(ByVal Color As Long) As Byte
    Dim blue As Long
    
    blue = Int(Color / 65536)
    GetGreen = Int((Color - (blue * 65536)) / 256)
End Function
 
Private Function GetRed(ByVal Color As Long) As Byte
    GetRed = Int(Color \ 65536)
End Function
 
Private Function RemoveBlackStuff(Pic As Long) As Long
Dim hdcNew          As Long
Dim oldhand         As Long
Dim ret             As Long
Dim DIB_RGB_COLORS  As Long
 
'On Error GoTo Err:
Call GetObject(Pic, Len(PicInfo), PicInfo)
hdcNew = CreateCompatibleDC(0&)
oldhand = SelectObject(hdcNew, Pic)
 
With DIBInfo.bmiHeader
    .biSize = 40
    .biWidth = PicInfo.bmWidth
    .biHeight = -PicInfo.bmHeight
    .biPlanes = 1
    .biBitCount = 32
End With
 
ReDim ImgData(1 To 4, 1 To PicInfo.bmWidth, 1 To PicInfo.bmHeight) As Byte
 
Dim i As Long, j As Long
Dim r As Byte, g As Byte, b As Byte
 
ret = GetDIBits(hdcNew, Pic, 0, PicInfo.bmHeight, ImgData(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
For i = 1 To PicInfo.bmWidth
    For j = 1 To PicInfo.bmHeight
        r = ImgData(1, i, j)
        g = ImgData(2, i, j)
        b = ImgData(3, i, j)
 
        If (r = 0) Then r = GetRed(TranslateColor(vbButtonFace))
        If (g = 0) Then g = GetGreen(TranslateColor(vbButtonFace))
        If (b = 0) Then b = GetBlue(TranslateColor(vbButtonFace))
        
        ImgData(1, i, j) = r
        ImgData(2, i, j) = g
        ImgData(3, i, j) = b
    Next j
Next i
ret = SetDIBits(hdcNew, Pic, 0, PicInfo.bmHeight, ImgData(1, 1, 1), DIBInfo, DIB_RGB_COLORS)
End Function
 
' NOTE: Ripped straight from our MiniShop (Photoshop clone) project we discontinued a while back...

There is also the option of just transparent blitting, which is done like so..

Private Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" Alias "CreateBitmap" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" Alias "SelectObject" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" Alias "SetBkColor" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (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
Private Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
 
Sub TransparentBlt(dsthDC As Long, srchDC As Long, X As Integer, _
                   Y As Integer, Width As Integer, _
                   Height As Integer, TransColor As Long)
    Dim maskDC As Long      'DC for the mask
    Dim tempDC As Long      'DC for temporary data
    Dim hMaskBmp As Long    'Bitmap for mask
    Dim hTempBmp As Long    'Bitmap for temporary data
 
    'First, create some DC's. These are our gateways to associated
    'bitmaps in RAM
    maskDC = CreateCompatibleDC(dsthDC)
    tempDC = CreateCompatibleDC(dsthDC)
 
    'Then, we need the bitmaps. Note that we create a monochrome
    'bitmap here!
    'This is a trick we use for creating a mask fast enough.
    hMaskBmp = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
    hTempBmp = CreateCompatibleBitmap(dsthDC, Width, Height)
 
    'Then we can assign the bitmaps to the DCs
    hMaskBmp = SelectObject(maskDC, hMaskBmp)
    hTempBmp = SelectObject(tempDC, hTempBmp)
 
    'Now we can create a mask. First, we set the background color
    'to the transparent color; then we copy the image into the
    'monochrome bitmap.
    'When we are done, we reset the background color of the
    'original source.
    TransColor = SetBkColor(srchDC, TransColor)
    BitBlt maskDC, 0, 0, Width, Height, srchDC, 0, 0, vbSrcCopy
    TransColor = SetBkColor(srchDC, TransColor)
 
    'The first we do with the mask is to MergePaint it into the
    'destination.
    'This will punch a WHITE hole in the background exactly were
    'we want the graphics to be painted in.
    BitBlt tempDC, 0, 0, Width, Height, maskDC, 0, 0, vbSrcCopy
    BitBlt dsthDC, X, Y, Width, Height, tempDC, 0, 0, vbMergePaint
 
    'Now we delete the transparent part of our source image. To do
    'this, we must invert the mask and MergePaint it into the
    'source image. The transparent area will now appear as WHITE.
    BitBlt maskDC, 0, 0, Width, Height, maskDC, 0, 0, vbNotSrcCopy
    BitBlt tempDC, 0, 0, Width, Height, srchDC, 0, 0, vbSrcCopy
    BitBlt tempDC, 0, 0, Width, Height, maskDC, 0, 0, vbMergePaint
 
    'Both target and source are clean. All we have to do is to AND
    'them together!
    BitBlt dsthDC, X, Y, Width, Height, tempDC, 0, 0, vbSrcAnd
 
    'Now all we have to do is to clean up after us and free system
    'resources..
    DeleteObject (hMaskBmp)
    DeleteObject (hTempBmp)
    DeleteDC (maskDC)
    DeleteDC (tempDC)
End Sub

...

Either way, Pictureboxes don't have true transparency, only imageboxes do. To simulate it with ImageBoxes, you could make it switch between images, one with transparency, and one without.

Imageboxes are yucky though, so stick with the PictureBox method.

chem

[LawnNinja]

I tried your top code and it gave me this,
Compile error: User-defined type not defined

and then Highlights this,

Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long

On your second code it says the same thing?

On the final code it doesn't say anything. But Nothing happens.
And when I add in the code from the top one,

Dim x As Long
Dim y As Long
Dim pixelColour As Long
 
For x = 0 To Picture1.ScaleWidth
    For y = 0 To Picture1.ScaleHeight
        pixelColour = GetPixel(Picture1.hdc, x, y)
        If (pixelColour = RGB(0, 0, 0)) Then
            SetPixelV Picture1.hdc, x, y, TranslateColor(vbButtonFace)
        End If
    Next y
    Picture1.Refresh
Next x

It says,
Compile error:
Sub or Fuction not defined and then highlights

GetPixel

???????????

[jcis]

Replace this:

ByVal oClr As OLE_COLOR

with this..

ByVal oClr As Long

And the definition of getpixel is there, add it to your module.

[chemicalNova]

I tried your top code and it gave me this,
Compile error: User-defined type not defined

and then Highlights this,

Private Function TranslateColor(ByVal oClr As OLE_COLOR, _
                        Optional hPal As Long = 0) As Long

What version of Visual Basic are you using? It should work fine..

On your second code it says the same thing?

Again...this must be the version of Visual Basic you are using. You're not using the VB Editor within a Microsoft Office application are you?

On the final code it doesn't say anything. But Nothing happens.
And when I add in the code from the top one,

Dim x As Long
Dim y As Long
Dim pixelColour As Long
 
For x = 0 To Picture1.ScaleWidth
    For y = 0 To Picture1.ScaleHeight
        pixelColour = GetPixel(Picture1.hdc, x, y)
        If (pixelColour = RGB(0, 0, 0)) Then
            SetPixelV Picture1.hdc, x, y, TranslateColor(vbButtonFace)
        End If
    Next y
    Picture1.Refresh
Next x

It says,
Compile error:
Sub or Fuction not defined and then highlights

GetPixel

???????????

Yes thats because "GetPixel" and "SetPixelV" are both API's. To stop that error, place these at the top of that code..

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

If you copy the code exactly (and not just pick what looks good), it will work. Make sure your picturebox has its ScaleMode property set to Pixels (PictureBox.ScaleMode = vbPixels), and that its AutoRedraw property is set to true. Also, obviously, make sure you have the correct object names...and if in my code you see "Private Sub Command1_Click()", you should probably add a commandbutton aswell...since thats what is used in my example.

chem

[LawnNinja]

I have Visual Basic 6.0 Enterprise Edition,
I added in those 2 api's and know it is saying,
Compile error:
Sub or Function not defined
Do I need more api's??????
-------------------------------------------------------------------------------
I tried what you said jcis, and I apperas to work until you press my command button then a line apears and slowly moves across my picture box, And for some reason it doesn't show up in printscreen???????????????????????????????????????????????/

[chemicalNova]

I have Visual Basic 6.0 Enterprise Edition,
I added in those 2 api's and know it is saying,
Compile error:
Sub or Function not defined
Do I need more api's??????

Yes. Depending on what peice of code you used, you need the different API's. Read over what I said above, carefully, and you should get it.

-------------------------------------------------------------------------------
I tried what you said jcis, and I apperas to work until you press my command button then a line apears and slowly moves across my picture box, And for some reason it doesn't show up in printscreen???????????????????????????????????????????????/

That means that one is working properly. It should change all the black to the default grey seen on forms and the back of pictureboxes...thats as good as you'll get, unless you Blit directly to the Forms Device Context... The first two pieces of code I gave you above, just change the black to grey. The last one, can be used to draw the image again, without the colour you want (black). If you want it to actually look transparent though, that is when you make it go to the forms DC.

If you still don't understand, tell me, I can type you up a quick program if you want, and attach it here for you to look over.

chem

[LawnNinja]

That would be appriciated.

[chemicalNova]

Ok here it is. It utilizes all the code I've explained above. I tried to make it a bit easier to read for you, by moving the two main big pieces of code into their own modules. The smaller one is in the main forms code.

Usage:

Button 1 will use Method 1 - GetPixel/SetPixel (Slow)
Button 2 will use Method 2 - GetDIBits/SetDIBits (Medium/Fast...from my calculations)
Button 3 will use Method 3 - TransparentBlt/Masks (Fast)

Button 4 will blit the image onto the form, and change the backcolor of the form each time, just to show you that the image does appear to be there, with the black bits transparent.

Hope this helps...if not, transparency might be a bit advanced for you :/

chem