bitblt circle?

[lcfc]

Hi,

I have used bitblt to draw a clear rectangle over a blured image. The application works well, but i would like to change the shape of the rectangle to a circle, is this possible? (see here:

http://ibs.derby.ac.uk/avru/test/bitblt.jpg

for a picture)Below is my code, can anybody help?

Private Declare Function GetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function IntersectClipRect 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 SelectClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetClipRgn Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "User32.dll" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Dim hRgn As Long

Private Declare Function ShowCursor Lib "User32" (ByVal bShow As Integer) As Integer
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const MERGEPAINT = vbWhite
Private Const SRCAND = &H8800C6
Private Const SRCCOPY = &HCC0020

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

' Variables for positioning the image.
Dim OldX As Single
Dim OldY As Single
Dim CurX As Single
Dim CurY As Single
Dim OffsetX As Single
Dim OffsetY As Single
Dim PicWid As Single
Dim PicHgt As Single
Dim Xmax As Single
Dim Ymax As Single

' Draw the picture at (CurX, CurY).
Private Sub DrawPicture()
    ' Fix the part of the image that was covered.
    BitBlt picCanvas.hdc, _
        OldX, OldY, PicWid, PicHgt, _
        picHidden.hdc, OldX, OldY, SRCCOPY
    OldX = CurX
    OldY = CurY

    ' Paint on the new image.
    BitBlt picCanvas.hdc, _
        CurX, CurY, Form2.Text1 + 2, Form2.Text1 + 2, _
        picXMask.hdc, 0, 0, MERGEPAINT
    BitBlt picCanvas.hdc, _
        CurX + 1, CurY + 1, Form2.Text1, Form2.Text1, _
        picX.hdc, CurX, CurY, SRCAND

    ' Update the display.
    picCanvas.Refresh
End Sub


' Save picCanvas's original bitmap bytes,
' initialize values, and draw the initial picture.
Private Sub Form_Load()
    ' Make the form fit the picture.
    
       
    Width = (Width - ScaleWidth) + picCanvas.Width
    Height = (Height - ScaleHeight) + picCanvas.Height

    PicWid = picX.ScaleWidth
    PicHgt = picX.ScaleHeight
    Xmax = picCanvas.ScaleWidth - PicWid
    Ymax = picCanvas.ScaleHeight - PicHgt
    OldX = 30
    OldY = 30
    CurX = 30
    CurY = 30
    
    DrawPicture

End Sub

Private Sub picCanvas_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Unload Me
ShowCursor (1)
End Sub

Private Sub picCanvas_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    'ShowCursor (0)

    CurX = x - Form2.Text1 / 2
    CurY = y - Form2.Text1 / 2
   
    DrawPicture
End Sub

Public Sub UnloadAllForms()
Dim Form As Form
   For Each Form In Forms
      Unload Form
      Set Form = Nothing
   Next Form
End Sub

Private Sub Form_unload(Cancel As Integer)
ShowCursor (1)
UnloadAllForms
DeleteObject hRgn
End Sub

Private Sub Form_Click()
    'unload the form when the user clicks on it
    Unload Me
End Sub

Private Sub Form_Paint()
    Form_Resize
End Sub
Private Sub Form_Resize()
    Dim Ret As Long
    SnapMouse (picCanvas.hWnd)
    'destroy the previous region
    DeleteObject hRgn
    'create an elliptic region
    hRgn = CreateEllipticRgn(0, 0, picCanvas.ScaleWidth, picCanvas.ScaleHeight)
    'select this elliptic region into the form's device context
    SelectClipRgn Me.hdc, hRgn
    'move the clipping region
    OffsetClipRgn Me.hdc, 0, 0
    'generate a new clipping region
    IntersectClipRect Me.hdc, 0, 0, picCanvas.ScaleWidth, picCanvas.ScaleHeight
    'clear the form
    Me.Cls
    'create a temporary region
    Ret = CreateEllipticRgn(0, 0, 0, 0)
    'copy the current clipping region into the temporary region
    GetClipRgn Me.hdc, Ret
    'set the new window region
    SetWindowRgn Me.hWnd, Ret, True
End Sub

Public Sub SnapMouse(ByVal hWnd As Long)
     
    Dim lpRect As RECT
     
    GetWindowRect hWnd, lpRect
  
    SetCursorPos lpRect.Left + (lpRect.Right - lpRect.Left) \ 2, _
        lpRect.Top + (lpRect.Bottom - lpRect.Top) \ 2

End Sub

 

[LPlates]

Search

http://www.planetsourcecode.com

and enter 'robert rayment' hes a graphics wizz