I don't want 100% transparent on the whole thing..
Just want it to not show a certain color, if you know what I mean.
Like, here is my example..
RRRRRRRRRPP
RRRRRRRPPPP
RRRRRPPPPPP
RRRPPPPPPPP
RRPPPPPPPPP
R = Red
P = Pink
I want it to take out all the Pink pixels, so it just look like this:
RRRRRRRRR
RRRRRRR
RRRRR
RRR
RR
So that way, it shows w/e background I have behind it in place of the pink pixels.
Anyone know how to do this?
Posts: 2,742
Threads: 115
Joined: Jun 2006
Reputation:
0
search picturebox masking in PSC?
I actually have this for my game for the in-game menus. I believe it used an API that was win 98+, so that's something you might want to take into consideration. If you're still interested let me know and i'll post the code. 
Of course I am interested. ^_^
I appreciate this Obsi. Been awhile since I touched MS, but I figured I don't have much to do, so I would pick my game back up. ^_^
I'd prefer not to use blitting. Which is why I'd like to have the API code he's talking about.
Misunderstood
Unregistered
BitBlt is an API, but its bltting 
Well, I know that. But I hate blitting, and working with it too. Lol. It's easier on me to just use the API he's talking about. If he ever gets around to posting the code. ^_^
Sorry i just formatted my PC i'm reinstalling VB right now and i'll post it.
[Edit]
Okay so i add this to the form load, for instance.
Code: ' Load the image
Set pic(1) = Picture1.Image
Picture1.picture = pic(1)
' Scan the image
Call rgnBasic.ScanPicture(pic(1))
' Offset the Shape to allow for the form header.
Call rgnBasic.OffsetHeader(Me)
Me.picture = pic(1) ' Set the Form Background
Call rgnBasic.ApplyRgn(Me.hWnd) ' Set the Form Shape
CurrentRgn = rgnBasic.hndRegion ' Set the Current Shape
These are declared at the top (globals... NOT inside the sub...)
Code: Dim rgnBasic As New Region
Dim rgnExtended As New Region
Dim CurrentRgn As Long
Dim pic(0 To 1) As New StdPicture
Then this was a class file (apparently, i didn't use an API...)
Code: Option Explicit
Public hndRegion As Long
Private DIB As New cDIBSection
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub Class_Terminate()
If hndRegion 0 Then Call DeleteObject(hndRegion)
End Sub
Public Sub ApplyRgn(ByVal hWnd As Long)
'
' When the setWinowRgn function gets a handle to a region it applies and
' deletes the region. Therefore you cannot call the function twice with
' the handle to the same region. Therefore I make a copy of the region
' for windows to apply and delete.
'
Dim hndRegionCopy As Long
hndRegionCopy = CreateRectRgn(0, 0, 0, 0) ' Create a blank region
Call CombineRgn(hndRegionCopy, hndRegion, hndRegionCopy, RGN_OR) ' Copy the region
Call SetWindowRgn(hWnd, hndRegionCopy, True)
End Sub
Public Sub ScanPicture(ByVal picture As StdPicture, Optional transColor As Long = vbNull)
On Error Resume Next
Dim Rgn2 As Long
hndRegion = CreateRectRgn(0, 0, 0, 0)
Dim x As Long, y As Long
Dim SPos As Long, EPos As Long
Dim Wid As Long, Hgt As Long
Dim bDib() As Byte
Dim tSA As SAFEARRAY2D
'get the picture size of the form
Call DIB.CreateFromPicture(picture)
Wid = DIB.Width
Hgt = DIB.Height
' have the local matrix point to bitmap pixels
With tSA
.cbElements = 1
.cDims = 2
.Bounds(0).lLbound = 0
.Bounds(0).cElements = DIB.Height
.Bounds(1).lLbound = 0
.Bounds(1).cElements = DIB.BytesPerScanLine
.pvData = DIB.DIBSectionBitsPtr
End With
Call CopyMemory(ByVal VarPtrArray(bDib), VarPtr(tSA), 4)
' if there is no transColor specified, use the first pixel as the transparent color
If transColor = vbNull Then transColor = RGB(bDib(0, 0), bDib(1, 0), bDib(2, 0))
For y = 0 To DIB.Height - 1 'line scan
x = -3
Do
Rgn2 = 0
x = x + 3
While RGB(bDib(x, y), bDib(x + 1, y), bDib(x + 2, y)) = transColor And (x < DIB.Width * 3 - 3)
x = x + 3 'skip the transparent point
Wend
SPos = x / 3
While RGB(bDib(x, y), bDib(x + 1, y), bDib(x + 2, y)) transColor And (x < DIB.Width * 3 - 3)
x = x + 3 'skip the nontransparent point
Wend
EPos = x / 3
'combine the region
If SPos = DIB.Width * 3 - 3
Next y
Call CopyMemory(ByVal VarPtrArray(bDib), 0&, 4)
End Sub
Public Sub OffsetHeader(ByRef tmpForm As Form)
With tmpForm
If .BorderStyle 0 Then
Dim xoff As Long, yoff As Long
.ScaleMode = vbPixels
xoff = (.ScaleX(.Width, vbTwips, vbPixels) - .ScaleWidth) / 2
yoff = .ScaleY(.Height, vbTwips, vbPixels) - .ScaleHeight - xoff
Call OffsetRgn(hndRegion, xoff, yoff)
End If
End With
End Sub
That'll work... the color that is transparent is whatever the pixel at 0,0 is (i believe...), then basically you just create a picture box (i just left it as picture1), hide it off of the form, then it just loads the transparent stuff and puts it as the background of my form afterwards... it's hard to explain but you'll see... it works pretty well, but i'm sure there are much faster/nicer ways of doing it.
This is for the box that displays my current stats. I don't want this to be added to the background of the form. It's displayed over picScreen.
That's why I want it to not display the pink part of the image.
*Sigh*
then change picture1.W/E to the picture that you're using... then it doesn't remove it for the form background...
I get a "User-defined type not defined" error on these lines:
Code: Dim rgnBasic As New Region
Dim rgnExtended As New Region
Private DIB As New cDIBSection
"Region" was the name of my class, so if you named it clsRegion or whatever, just make sure you dim it as clsRegion rather than Region.
Okay, that fixes that problem. But how about this one?
I get the same error with this line:
Code: Private DIB As New cDIBSection
My fault, there is another class module called cDibSection (which you can of course, rename)
here's the code for it:
Code: Option Explicit
Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER '40 bytes
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 BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
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 Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateDIBSection Lib "gdi32" _
(ByVal hdc As Long, _
pBitmapInfo As BITMAPINFO, _
ByVal un As Long, _
lplpVoid As Long, _
ByVal handle As Long, _
ByVal dw As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 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
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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private m_hDIb As Long
Private m_hBmpOld As Long
Private m_hDC As Long
Private m_lPtr As Long
Private m_tBI As BITMAPINFO
Public Function CreateDIB( _
ByVal lHDC As Long, _
ByVal lWidth As Long, _
ByVal lHeight As Long, _
ByRef hDib As Long _
) As Boolean
With m_tBI.bmiHeader
.biSize = Len(m_tBI.bmiHeader)
.biWidth = lWidth
.biHeight = lHeight
.biPlanes = 1
.biBitCount = 24
.biCompression = BI_RGB
.biSizeImage = BytesPerScanLine * .biHeight
End With
hDib = CreateDIBSection( _
lHDC, _
m_tBI, _
DIB_RGB_COLORS, _
m_lPtr, _
0, 0)
CreateDIB = (hDib 0)
End Function
Public Function CreateFromPicture( _
ByRef picThis As StdPicture _
)
Dim lHDC As Long
Dim lhDCDesktop As Long
Dim lhBmpOld As Long
Dim tBMP As BITMAP
GetObjectAPI picThis.handle, Len(tBMP), tBMP
If (Create(tBMP.bmWidth, tBMP.bmHeight)) Then
lhDCDesktop = GetDC(GetDesktopWindow())
If (lhDCDesktop 0) Then
lHDC = CreateCompatibleDC(lhDCDesktop)
DeleteDC lhDCDesktop
If (lHDC 0) Then
lhBmpOld = SelectObject(lHDC, picThis.handle)
LoadPictureBlt lHDC
SelectObject lHDC, lhBmpOld
DeleteObject lHDC
End If
End If
End If
End Function
Public Function Create( _
ByVal lWidth As Long, _
ByVal lHeight As Long _
) As Boolean
ClearUp
m_hDC = CreateCompatibleDC(0)
If (m_hDC 0) Then
If (CreateDIB(m_hDC, lWidth, lHeight, m_hDIb)) Then
m_hBmpOld = SelectObject(m_hDC, m_hDIb)
Create = True
Else
DeleteObject m_hDC
m_hDC = 0
End If
End If
End Function
Public Property Get BytesPerScanLine() As Long
' Scans must align on dword boundaries:
BytesPerScanLine = (m_tBI.bmiHeader.biWidth * 3 + 3) And &HFFFFFFFC
End Property
Public Property Get Width() As Long
Width = m_tBI.bmiHeader.biWidth
End Property
Public Property Get Height() As Long
Height = m_tBI.bmiHeader.biHeight
End Property
Public Sub LoadPictureBlt( _
ByVal lHDC As Long, _
Optional ByVal lSrcLeft As Long = 0, _
Optional ByVal lSrcTop As Long = 0, _
Optional ByVal lSrcWidth As Long = -1, _
Optional ByVal lSrcHeight As Long = -1, _
Optional ByVal eRop As RasterOpConstants = vbSrcCopy _
)
If lSrcWidth < 0 Then lSrcWidth = m_tBI.bmiHeader.biWidth
If lSrcHeight < 0 Then lSrcHeight = m_tBI.bmiHeader.biHeight
BitBlt m_hDC, 0, 0, lSrcWidth, lSrcHeight, lHDC, lSrcLeft, lSrcTop, eRop
End Sub
Public Property Get DIBSectionBitsPtr() As Long
DIBSectionBitsPtr = m_lPtr
End Property
Public Sub ClearUp()
If (m_hDC 0) Then
If (m_hDIb 0) Then
SelectObject m_hDC, m_hBmpOld
DeleteObject m_hDIb
End If
DeleteObject m_hDC
End If
m_hDC = 0: m_hDIb = 0: m_hBmpOld = 0: m_lPtr = 0
End Sub
Private Sub Class_Terminate()
ClearUp
End Sub
Okay, I found one working method, problem is, I can't seem to get it to work with more than one picture box.
I'm going to post the code, with a semi tut on how to implement it to get it working, but mind you, it's very simple. But also, don't forget, it only works with a single picture box at the moment.
Code:
Add this code to any form:
Code: Private Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (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 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 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 '14 bytes
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 '40 bytes
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 Const DIB_RGB_COLORS = 0&
Private Const BI_RGB = 0&
Private Const pixR As Integer = 3
Private Const pixG As Integer = 2
Private Const pixB As Integer = 1
Private Sub UnRGB(ByRef color As Long, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)
r = color And &HFF&
g = (color And &HFF00&) \ &H100&
b = (color And &HFF0000) \ &H10000
End Sub
' Restrict the form to its "transparent" pixels.
Private Sub TrimPicture(ByVal pic As PictureBox, ByVal transparent_color As Long)
Const RGN_OR = 2
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim bytes_per_scanLine As Integer
Dim pad_per_scanLine As Integer
Dim transparent_r As Byte
Dim transparent_g As Byte
Dim transparent_b As Byte
Dim wid As Integer
Dim hgt As Integer
Dim X As Integer
Dim Y As Integer
Dim start_x As Integer
Dim stop_x As Integer
Dim combined_rgn As Long
Dim new_rgn As Long
' Prepare the bitmap description.
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = picTest.ScaleWidth
' Use negative height to scan top-down.
.biHeight = -picTest.ScaleHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
bytes_per_scanLine = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)
pad_per_scanLine = bytes_per_scanLine - (((.biWidth * .biBitCount) + 7) \ 8)
.biSizeImage = bytes_per_scanLine * Abs(.biHeight)
End With
' Load the bitmap's data.
wid = picTest.ScaleWidth
hgt = picTest.ScaleHeight
ReDim pixels(1 To 4, 0 To wid - 1, 0 To hgt - 1)
GetDIBits picTest.hdc, picTest.Image, _
0, picTest.ScaleHeight, pixels(1, 0, 0), _
bitmap_info, DIB_RGB_COLORS
' Break the transparent color into its components.
UnRGB transparent_color, transparent_r, transparent_g, transparent_b
' Create the PictureBox's regions.
For Y = 0 To hgt - 1
' Create a region for this row.
X = 1
Do While X < wid
start_x = 0
stop_x = 0
' Find the next non-transparent column.
Do While X < wid
If pixels(pixR, X, Y) transparent_r Or _
pixels(pixG, X, Y) transparent_g Or _
pixels(pixB, X, Y) transparent_b _
Then
Exit Do
End If
X = X + 1
Loop
start_x = X
' Find the next transparent column.
Do While X < wid
If pixels(pixR, X, Y) = transparent_r And _
pixels(pixG, X, Y) = transparent_g And _
pixels(pixB, X, Y) = transparent_b _
Then
Exit Do
End If
X = X + 1
Loop
stop_x = X
' Make a region from start_x to stop_x.
If start_x < wid Then
If stop_x >= wid Then stop_x = wid - 1
' Create the region.
new_rgn = CreateRectRgn( _
start_x, Y, stop_x, Y + 1)
' Add it to what we have so far.
If combined_rgn = 0 Then
combined_rgn = new_rgn
Else
CombineRgn combined_rgn, _
combined_rgn, new_rgn, RGN_OR
DeleteObject new_rgn
End If
End If
Loop
Next Y
' Restrict the PictureBox to the region.
SetWindowRgn pic.hWnd, combined_rgn, True
DeleteObject combined_rgn
End Sub
Private Sub pictest_Click()
Unload Me
End Sub
Private Sub Form_Load()
' Center the form.
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
' Move the picture on top of the other controls.
picTest.ZOrder
picTest.ScaleMode = vbPixels
picTest.AutoRedraw = True
picTest.Picture = picTest.Image
' Trim the picture.
TrimPicture picTest, &HFF00FF
End Sub
Create a picture box and name it picTest.
Then make sure you have an image that has something that can be transparent on it. Either change the &HFF00FF to the hex of your color, or us the RGB 255,0,255 as the color to make transparent.
Run the project, should work.
Now, what I am asking is, can someone help me get this to work with more than one picture box?
Can you not just do...
Code: Private Sub Form_Load()
' Center the form.
Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
' Move the picture on top of the other controls.
picTest.ZOrder
picTest.ScaleMode = vbPixels
picTest.AutoRedraw = True
picTest.Picture = picTest.Image
' Trim the picture.
TrimPicture picTest, &HFF00FF
' Move the picture on top of the other controls.
picTest2.ZOrder
picTest2.ScaleMode = vbPixels
picTest2.AutoRedraw = True
picTest2.Picture = picTest2.Image
TrimPicture picTest2, &HFF00FF
End Sub
?
No, because if you look into it more, there is alot of other things that need to be changed and specified to the other pic boxes, otherwise, it will just set pictest2 to the exact same shape/size as pictest. I tried it.
Hey man still dont know how to do it with more than 1 picbox? If not get at me on aim or something I got it working with more than 1.
i didn't realize you were trying to do it with In-Game picBoxes... you definately should use BitBlt for that... i used this code for my Forms, not in-game stuff.
|
