I want to blow up a picture. How can I do this in code, any ideas? VB 4 or 6
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
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
By using BitBlt, it sends per pixel, which you now can manipulate to create your exploding effect.
We're a friendly, industry-focused community of 1.18 million developers, IT pros, digital marketers, and technology enthusiasts learning and sharing knowledge.