Exploding Pictures

[Bob Jacobs]

Hi
I want to blow up a picture. How can I do this in code, any ideas? VB 4 or 6

[AndreRet]

Bob, the closest I can get to your question is something done a while ago. You will need the BitBlt API. This only copies a piece of a picture and paste it into another picturebox. I'm sure if you play with this you can create an exploding effect. I am not that cluded up on picture rendering as I use to be. Try it out and let me know...

On a module add the following -

Option Explicit

Public 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

Public Const SRCCOPY = &HCC0020

On a form add 1 Command Button and 2 Pic boxes with its ScaleMode set to 3 - Pixels

Option Explicit

Dim minX As Single
Dim maxX As Single
Dim minY As Single
Dim maxY As Single
Dim isRectExist As Boolean
  
Private Sub Command1_Click()
'clear Picture2
     Picture2.Cls
     
'assure that maxX will hold the maxium X value and minX the minimum X value.
     If maxX < minX Then
        temp = minX
        minX = maxX
        maxX = temp
     End If
     
'assure that maxY will hold the maxium Y value and minY the minimum Y value.
     If maxY < minY Then
        temp = minY
        minY = maxY
        maxY = temp
     End If
    
'will draw the rectangle area to Picture2. It will start drawing it from Picture2
'upper left corner. If you want to change the place of drawing, replace the
' "0,0" below with the starting point
     Result& = BitBlt(Picture2.hDC, 0, 0, maxX - minX, maxY - minY, Picture1.hDC, _
     minX, minY, SRCCOPY)
End Sub

Sub Form_Load()
    
    isBoxExist = False
    'initialize the rectangle
    minX = -10
    maxX = 10
    minY = -10
    maxY = 10
End Sub


Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    If Button = 1 Then
'if a rectangle is already drawn, delete it
        If isRectExist Then
            Picture1.Cls
            isBoxExist = False
        End If
        minX = X
        maxY = Y
        maxX = X
        maxY = Y
    End If
  End Sub

  Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    'Drawing the rectangle
    If Button = 1 Then
        Picture1.DrawMode = 10
        Picture1.Line (minX, maxY)-(maxX, minY), , B
        maxX = X
        minY = Y
        Picture1.Line (minX, maxY)-(maxX, minY), , B
        Picture1.DrawMode = 13
    End If
  End Sub


Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'update the isRectExist variable, so the next time the user will start drawing the rectangle,
'we will know that a rectangle is already exist, and we will delete the old rectangle
    isRectExist = True
End Sub

[Bob Jacobs]

Thanks, I will certainly try it when I can get my head around the code. Am I right in assuming that this effectively sends a stream of pixels from one picture box to another, or larger chunks

[AndreRet]

By using BitBlt, it sends per pixel, which you now can manipulate to create your exploding effect.