-
Jun 9th, 2011, 03:12 AM
#1
[RESOLVED] Draw semi transparent rectangle in picture box
hi experts,
How to draw a white or some colored semi transparent rectangle in a picture box?
kindly reply with some solutions,
thank u,
with regards,
Seenu...
-
Jun 9th, 2011, 03:37 AM
#2
Re: Draw semi transparent rectangle in picture box
vb Code:
Option Explicit '=========Gdi32 Api======== Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long Private Declare Function GdiAlphaBlend Lib "gdi32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long Private Declare Function CreatePen Lib "gdi32.dll" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long '=========user32 Api======== Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long '=========Oleaut32 Api======== Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByVal lColorRef As Long) As Long '=========Kernel32 Api======== Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Type UcsRgbQuad R As Byte G As Byte B As Byte a As Byte End Type Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Sub DrawAlphaSelection(hdc As Long, ByVal X As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal Color As OLE_COLOR) Dim BF As BLENDFUNCTION Dim hDCMemory As Long Dim hBmp As Long Dim hOldBmp As Long Dim DC As Long Dim lColor As Long Dim hPen As Long Dim hBrush As Long Dim lBF As Long BF.SourceConstantAlpha = 128 DC = GetDC(0) hDCMemory = CreateCompatibleDC(0) hBmp = CreateCompatibleBitmap(DC, Width, Height) hOldBmp = SelectObject(hDCMemory, hBmp) hPen = CreatePen(0, 1, Color) hBrush = CreateSolidBrush(pvAlphaBlend(Color, vbWhite, 120)) DeleteObject SelectObject(hDCMemory, hBrush) DeleteObject SelectObject(hDCMemory, hPen) Rectangle hDCMemory, 0, 0, Width, Height CopyMemory VarPtr(lBF), VarPtr(BF), 4 GdiAlphaBlend hdc, X, y, Width, Height, hDCMemory, 0, 0, Width, Height, lBF SelectObject hDCMemory, hOldBmp DeleteObject hBmp ReleaseDC 0&, DC DeleteDC hDCMemory DeleteObject hPen DeleteObject hBrush End Sub Private Function pvAlphaBlend(ByVal clrFirst As Long, ByVal clrSecond As Long, ByVal lAlpha As Long) As Long Dim clrFore As UcsRgbQuad Dim clrBack As UcsRgbQuad OleTranslateColor clrFirst, 0, VarPtr(clrFore) OleTranslateColor clrSecond, 0, VarPtr(clrBack) With clrFore .R = (.R * lAlpha + clrBack.R * (255 - lAlpha)) / 255 .G = (.G * lAlpha + clrBack.G * (255 - lAlpha)) / 255 .B = (.B * lAlpha + clrBack.B * (255 - lAlpha)) / 255 End With CopyMemory VarPtr(pvAlphaBlend), VarPtr(clrFore), 4 End Function Private Sub Form_Paint() Cls DrawAlphaSelection Me.hdc, 10, 50, 100, 200, vbRed DrawAlphaSelection Me.hdc, 50, 30, 200, 100, vbBlue DrawAlphaSelection Me.hdc, 200, 80, 100, 100, vbGreen DrawAlphaSelection Me.hdc, 80, 200, 200, 30, vbYellow DrawAlphaSelection Me.hdc, 130, 70, 50, 200, vbMagenta End Sub
Link
-
Jun 9th, 2011, 04:13 AM
#3
Re: Draw semi transparent rectangle in picture box
thats gr8 Leandro. thank u very much...
-
Jun 9th, 2011, 04:42 AM
#4
Re: Draw semi transparent rectangle in picture box
Leandro,
u hav any simple blurring sample code like this?
-
Jun 9th, 2011, 07:29 AM
#5
Re: Draw semi transparent rectangle in picture box
LeandroA
Impressive ..
Spoo
-
Jul 28th, 2011, 10:48 PM
#6
Re: Draw semi transparent rectangle in picture box
LeandroA, how to draw without the border rectange?
-
Jul 29th, 2011, 09:10 AM
#7
Re: Draw semi transparent rectangle in picture box
Originally Posted by seenu_1st
LeandroA, how to draw without the border rectange?
seenu_1st, one of two suggestions:
1) Use FillRect instead of Rectangle API. If so, no need to create a pen either
2) Instead of using "Color" for the CreatePen function, blend the color same as the CreateSolidBrush call does.
Last edited by LaVolpe; Jul 29th, 2011 at 09:17 AM.
-
Jul 29th, 2011, 08:21 PM
#8
Re: Draw semi transparent rectangle in picture box
thanks Lavolpe, can u pls change that code with any one of ur suggestion?
-
Jul 30th, 2011, 10:58 AM
#9
Re: Draw semi transparent rectangle in picture box
Originally Posted by seenu_1st
thanks Lavolpe, can u pls change that code with any one of ur suggestion?
Like this? Untested
Code:
hPen = CreatePen(0, 1, pvAlphaBlend(Color, vbWhite, 120)
-
Jul 30th, 2011, 11:11 AM
#10
Re: Draw semi transparent rectangle in picture box
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|