I'm using BitBlt to draw colored balls on a Picturebox. Also using BitBlt I can randomly move these balls around the Picturebox using the mouse pointer.
The problem I have is that the ball images get erased if I move another object like a Form or something or I move this Form off screen and then move it back.
I have tried setting Picture1 to AutoRedraw = True but that doesn't seem to work and it messes up the movement of the balls.
How do I get around this problem?
Below is the code I am using
The problem I have is that the ball images get erased if I move another object like a Form or something or I move this Form off screen and then move it back.
I have tried setting Picture1 to AutoRedraw = True but that doesn't seem to work and it messes up the movement of the balls.
How do I get around this problem?
Below is the code I am using
Code:
Dim Previous_X As Integer
Dim Previous_Y As Integer
Dim AlreadyShot As Integer
Dim FirstTimeMouseDown As Boolean
Dim X_Diff As Single
Dim Y_Diff As Single
Dim UL_X_Ball As Single
Dim UL_Y_Ball As Single
Dim StartX As Single
Dim StartY As Single
Dim PrevImageIndex As Integer
Dim MoveSelectedBall As Boolean
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As PointAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Const SRCCOPY = &HCC0020
Private Const SRCPAINT = &HEE0086
Private Const SRCAND = &H8800C6
Private Const SRCINVERT = &H660046
Private Const SRCMERGECOPY = &HC000CA
Private Const SRCMERGEPAINT = &HBB0226
Private Type PointAPI
X As Long
Y As Long
End Type
Dim pt As PointAPI
Dim ScreenDC As Long
Dim BoardDC As Long
Dim SelectedBall As Integer
Dim nX As Single
Dim nY As Single
Dim BallX As Integer
Dim BallY As Integer
Dim Images As Integer
Private Sub cmdDrawBallOnSquare_Click()
Dim RC As Long
Images = Images + 1
Load imgBall(Images)
imgBall(Images).ZOrder 0
imgBall(Images).Visible = True
imgBall(Images).Move 0, 0
'-----------------------------------------------------------------------
'Save whatever is there before we draw the ball
picSaveForm.AutoRedraw = True
picSaveFormMouseDown.AutoRedraw = True
RC = BitBlt%(picSaveForm.hDC, 0, 0, picSaveForm.ScaleWidth, picSaveForm.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY)
RC = BitBlt%(picSaveFormMouseDown.hDC, 0, 0, picSaveFormMouseDown.ScaleWidth, picSaveFormMouseDown.ScaleHeight, Picture1.hDC, 0, 0, SRCCOPY)
picSaveForm.Refresh
picSaveFormMouseDown.Refresh
'------------------------------------------------------------------------
RC = BitBlt%(Picture1.hDC, 0, 0, 30, 30, picBallMask.hDC, 0, 0, SRCAND)
RC = BitBlt%(Picture1.hDC, 0, 0, 30, 30, picBall(SelectedBall).hDC, 0, 0, SRCPAINT)
End Sub
Private Sub cmdClearSquare_Click()
Picture1.Cls
End Sub
Private Sub Form_Load()
SelectedBall = 1
End Sub
Private Sub imgBall_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim RC As Long
If Button = vbRightButton Then
MsgBox "You clicked on Ball(" & Index & ")"
Else
nX = X / Screen.TwipsPerPixelX
nY = Y / Screen.TwipsPerPixelY
BallX = imgBall(Index).Left
BallY = imgBall(Index).Top
X = BallX + nX
Y = BallY + nY
If FirstTimeMouseDown = True Then Exit Sub
ScreenDC = GetDC(0)
BoardDC = Picture1.hwnd
MoveSelectedBall = True
PrevImageIndex = -1
picBallTarget.Picture = picBall(SelectedBall).Picture
pt.X = 0
pt.Y = 0
X_Diff = X - imgBall(Index).Left
Y_Diff = Y - imgBall(Index).Top
UL_X_Ball = imgBall(Index).Left
UL_Y_Ball = imgBall(Index).Top
StartX = UL_X_Ball
StartY = UL_Y_Ball
Previous_X = X
Previous_Y = Y
End If
End Sub
Private Sub imgBall_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim RC As Long
If Button = vbLeftButton Then
X = (X / Screen.TwipsPerPixelX)
X = X + BallX
Y = Y / Screen.TwipsPerPixelY
Y = Y + BallY
ScreenDC = GetDC(0)
BoardDC = Picture1.hwnd
pt.X = 0
pt.Y = 0
RC = ClientToScreen(BoardDC, pt)
If FirstTimeMouseDown = False Then
'
' One time only on first entry
'
FirstTimeMouseDown = True
RC = BitBlt%(ScreenDC, pt.X + imgBall(Index).Left, pt.Y + imgBall(Index).Top, picSaveForm.ScaleWidth, picSaveForm.ScaleHeight, picSaveForm.hDC, 0, 0, SRCCOPY)
End If
pt.X = 0
pt.Y = 0
RC = ClientToScreen(BoardDC, pt)
UL_X_Ball = (X - X_Diff) + UL_X_Ball
UL_Y_Ball = (Y - Y_Diff) + UL_Y_Ball
If AlreadyShot <> 0 Then
'
' Replace the previous area before we continue on
'
RC = BitBlt%(ScreenDC, pt.X + (Previous_X - X_Diff), pt.Y + (Previous_Y - Y_Diff), picSaveForm.ScaleWidth, picSaveForm.ScaleHeight, picSaveForm.hDC, 0, 0, SRCCOPY)
End If
'
' Below moves the ball
'
RC = BitBlt%(picSaveForm.hDC, 0, 0, picSaveForm.ScaleWidth, picSaveForm.ScaleHeight, ScreenDC, pt.X + (X - X_Diff), pt.Y + (Y - Y_Diff), SRCCOPY)
'
' Position the ball
'
RC = BitBlt%(ScreenDC, (pt.X) + (X - X_Diff), (pt.Y) + (Y - Y_Diff), 30, 30, picBallMask.hDC, 0, 0, SRCAND)
RC = BitBlt%(ScreenDC, (pt.X) + (X - X_Diff), (pt.Y) + (Y - Y_Diff), 30, 30, picBallTarget.hDC, 0, 0, SRCPAINT)
Previous_X = X
Previous_Y = Y
AlreadyShot = 1
End If
End Sub
Private Sub imgBall_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
X = (X / Screen.TwipsPerPixelX)
X = X + BallX
Y = Y / Screen.TwipsPerPixelY
Y = Y + BallY
If MoveSelectedBall = False Then Exit Sub
imgBall(Index).Move X - nX, Y - nY
RC = BitBlt%(Picture1.hDC, imgBall(Index).Left, imgBall(Index).Top, 30, 30, picBallMask.hDC, 0, 0, SRCAND)
RC = BitBlt%(Picture1.hDC, imgBall(Index).Left, imgBall(Index).Top, 30, 30, picBall(SelectedBall).hDC, 0, 0, SRCPAINT)
AlreadyShot = 0
FirstTimeMouseDown = False
End Sub
Private Sub Option1_Click(Index As Integer)
SelectedBall = Index
End Sub