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??????? :confused: :ehh:
Printable View
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??????? :confused: :ehh:
Depending on what you mean by "Transparent". You can remove the black pixels to look like an empty picturebox. The easiest way being..
Or faster..VB 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 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
There is also the option of just transparent blitting, which is done like so..VB Code:
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...
...VB Code:
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
I tried your top code and it gave me this,
Compile error: User-defined type not defined
and then Highlights this,
VB Code:
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,
It says,VB Code:
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
Compile error:
Sub or Fuction not defined and then highlights???????????VB Code:
GetPixel
Replace this:
with this..VB Code:
ByVal oClr As OLE_COLOR
And the definition of getpixel is there, add it to your module.VB Code:
ByVal oClr As Long
What version of Visual Basic are you using? It should work fine..Quote:
Originally Posted by LawnNinja
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?Quote:
Originally Posted by LawnNinja
Yes thats because "GetPixel" and "SetPixelV" are both API's. To stop that error, place these at the top of that code..Quote:
Originally Posted by LawnNinja
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.VB 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
chem
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???????????????????????????????????????????????/
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.Quote:
Originally Posted by LawnNinja
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.Quote:
Originally Posted by LawnNinja
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
That would be appriciated.
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