Hello everybody. I need to simulate the melting of a solid. In principle, I could do it using the PSet and Point methods, but they're deadly slow. I would need a couple APIs, and they ought to be at least 1000 times faster than that. Plus, I would need detailed directions about how to use them (I suck with APIs). Thank you.
In VB's help files on the index tab, type in SetPixel. (You will see two entries in the list, one with a lower case s (setPixel) and a second with an upper case s (SetPixel). You want the second one. Highlight it and when the dialog comes up, you want the bottom or second entry in the box (GDI:Platform SDK). Scroll to bottom of page and select Bitmap Functions. On this page you will find a list of API's that you can use google or yahoo to help you find examples on how to use the API's listed. Just type in the API name with vb6 as part of your keyword search. You should also be able to find some example here at this site also.
Okay, now these are just a beginning of the graphical API's that you can use. There are other libraries out there and you will undoubtly run across them in your searches. You also might want to check out DirectX.
GetDIBits() and SetDIBits(). GetDIBits allows you to put an image into a byte array, then you can manipulate the byte array and finally paint the image back.
This is really fast, GetPixel/SetPixel are almost useless...
In that case I assume you will be repeatedly making changes to the same picture, and show each stage. If that is so, DigiRev's suggestion of DIBs is what I would go for - because they are basically pictures converted to an array.
1. Click on the Tutorials link at top
2. Along left side, click on link: Basic Introduction to Graphics Programming
When done with that tutorial, try these too
3. Same page, near bottom: Using DCs, Using DDBs, Using DIBs
Insomnia is just a byproduct of, "It can't be done"
I'll give you the code I'm using. In order for you to use it, you'll need a form, with its Picture property set to a colored bitmap about half the width of your screen and the same height as the screen. You'll also need a commandbutton and a timer (Interval = 1). Here follows the code:
Code:
Option Explicit
Option Base 1
Private Type bitmap
bmtype As Long
bmwidth As Long
bmheight As Long
bmwidthbytes As Long
bmplanes As Integer
bmbitspixel As Integer
bmbits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hobject As Long, ByVal ncount As Long, lpobject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hbitmap As Long, ByVal dwcount As Long, ByRef lpbits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hbitmap As Long, ByVal dwcount As Long, ByRef lpbits As Any) As Long
Private Sub Command1_Click()
Timer1.Enabled=True
End Sub
Private Sub Form_Load()
Timer1.Enabled=False
End Sub
Private Sub Timer1_Timer()
Dim bm As bitmap, imagedata() As Byte, imagedatacopy() As Byte, x As Long, y As Long, freq As Single, phase As Single
Static i As Long
i=i+1
Randomize Timer
GetObject Picture.Handle, Len(bm), bm
ReDim imagedata(bm.bmbitspixel\8, bm.bmwidth, bm.bmheight)
GetBitmapBits Picture.Handle, bm.bmwidthbytes*bm.bmheight, imagedata(1,1,1)
imagedatacopy=imagedata
For y = 1 To bm.bmheight
freq = 10 * Rnd
phase = Rnd * bm.bmwidth
For x = 1 To bm.bmwidth
If y + 7 < bm.bmheight And x + 7 < bm.bmwidth And x - 7 > 0 Then
imagedata(3, x, y + CInt(1 * Abs(Sin(freq * x + phase)))) = imagedata(3, x, y)
imagedata(2, x, y + CInt(1 * Abs(Sin(freq * x + phase)))) = imagedata(2, x, y)
imagedata(1, x, y + CInt(1 * Abs(Sin(freq * x + phase)))) = imagedata(1, x, y)
imagedatacopy(3, x + CInt(7 * Sin(0.2 * y + i)), y) = imagedata(3, x, y)
imagedatacopy(2, x + CInt(7 * Sin(0.2 * y + i)), y) = imagedata(2, x, y)
imagedatacopy(1, x + CInt(7 * Sin(0.2 * y + i)), y) = imagedata(1, x, y)
End If
Next x
Next y
SetBitmapBits Picture.Handle, bm.bmwidthbytes * bm.bmheight, imagedatacopy(1, 1, 1)
Refresh
End Sub
The outcome is what I desire. However, it's slow. And the reason is not the APIs, but the calculations (I tried it without calculations and it works fast enough). Do you know how I can speed it up?
If it's just an animation you want try this code :
make a form with 1 timer - Save the project in the same folder as the attached pic. copy the code below into it and run.
Code:
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'=================================================================
'API Calls - Stretchblt is the key for warping use plgblt
'=================================================================
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim handles(0 To 3) As POINTAPI ' used to calculate morph
Dim Melt(0 To 3) As POINTAPI 'ending position corners of image to be morphed
Dim unMelt(0 To 3) As POINTAPI 'starting position corners of image to be morphed
Dim stdhdc As StdPicture '- image to be morphed
Dim Shdc As Long 'handle to be used by api
Dim Animation As Double
Const picHeight = 480 'image height
Const picWidth = 527 'image width
Const PHMinus1 = picHeight - 1 ' precalc to speed render up
Private Sub Form_Load()
Dim i As Integer
Set stdhdc = LoadPicture(App.Path & "\oscar.jpg")
Me.WindowState = vbMaximized
Shdc = CreateCompatibleDC(0) 'create a dc
SelectObject Shdc, stdhdc 'attach image to dc
Me.ScaleMode = vbPixels
Me.BackColor = vbWhite
Me.FillStyle = vbFSSolid
Me.FillColor = RGB(255, 0, 0)
Me.AutoRedraw = True
Me.Show
'set up image original shape - by centering it in the form
unMelt(0).X = (Me.ScaleWidth - picWidth) / 2: unMelt(0).Y = (Me.ScaleHeight - picHeight) / 2
unMelt(1).X = unMelt(i).X + picWidth: unMelt(1).Y = unMelt(0).Y
unMelt(2).X = unMelt(0).X: unMelt(2).Y = unMelt(0).Y + picHeight
unMelt(3).X = unMelt(1).X: unMelt(3).Y = unMelt(2).Y
'set up image final shape - by squashing it it in the form
Melt(0).X = Me.ScaleWidth / 2: Melt(0).Y = unMelt(2).Y - 5
Melt(1).X = Melt(0).X: Melt(1).Y = Melt(0).Y
Melt(2).X = Me.ScaleWidth * -3.5: Melt(2).Y = unMelt(2).Y
Melt(3).X = Me.ScaleWidth * 5: Melt(3).Y = unMelt(2).Y
Me.Refresh
Timer1.Interval = 15 ' animation timer initialize
Animation = 0 'tokenanimation
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteDC Shdc 'clean up memory before exiting
End Sub
Private Sub warp()
Dim i As Double, Y As Double
Dim nx As Double, ny As Double, nz As Double, iStep As Double
Dim Pt(0 To 1) As POINTAPI, iFrom As Integer, iTo As Integer
Me.Cls
For i = 0 To 1 Step (1 / picHeight) 'render image scanline by scanline
'set the coördinates of the warp
'scale between top and bottom width by using i as a percentage
'1= 100% 0 = 0% ,scale beginning and ennding coords and add together
Pt(0).X = handles(0).X * (1 - i) + handles(2).X * i
Pt(0).Y = handles(0).Y * (1 - i) + handles(2).Y * i
Pt(1).X = handles(1).X * (1 - i) + handles(3).X * i
Pt(1).Y = handles(1).Y * (1 - i) + handles(3).Y * i
'stretchblt warps each scanline to give an irregular shape
StretchBlt Me.hdc, Pt(0).X, Pt(0).Y, Pt(1).X - Pt(0).X + 1, 2, Shdc, 0, PHMinus1 * i, picWidth, 1, vbSrcCopy
Next
Me.Refresh
Me.MousePointer = 0
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
If Animation = -1 Then 'used for the pause between animation
Animation = 0 'loop
Timer1.Interval = 15
End If
'scale between starting and ending shape by using animation as a percentage
'1= 100% 0 = 0% ,scale starting and ending coords and add together
For i = 0 To 3
handles(i).X = unMelt(i).X * (1 - Animation) + Melt(i).X * Animation
handles(i).Y = unMelt(i).Y * (1 - Animation) + Melt(i).Y * Animation
Next
warp
Animation = Animation + (1 / 150) 'animate by increaing token fractionally
If Animation >= 1 Then 'check for end of morph then pause
Animation = -1
Timer1.Interval = 2000
End If
End Sub
Last edited by technorobbo; Aug 5th, 2009 at 08:24 AM.
The outcome is what I desire. However, it's slow. And the reason is not the APIs, but the calculations (I tried it without calculations and it works fast enough). Do you know how I can speed it up?
Your calculations are slow because you are repeating them unnecessarily: y + CInt(1 * Abs(Sin(freq * x + phase))) is done 3 times for every x, and CInt(7 * Sin(0.2 * y + i))) is done 3*x times for every y.
Your If statement has similar issues: y + 7 < bm.bmheight is checked x times for every y, which can be completely eliminated by simply changing the "to" number of the For y loop. The part x + 7 < bm.bmwidth And x - 7 > 0 can be eliminated too by doing similar to the For x loop.
Taking those into account (which should be noticeably faster, as there is less work being done, and fewer times) gives this:
Code:
Dim sx As Long, sy As Long
For y = 1 To bm.bmheight - 8 'eliminate check for: y + 7 < bm.bmheight
freq = 10 * Rnd
phase = Rnd * bm.bmwidth
sy = CInt(7 * Sin(0.2 * y + i))
For x = 8 To bm.bmwidth - 7 'eliminate checks for: x + 7 < bm.bmwidth And x - 7 > 0
sx = y + CInt(1 * Abs(Sin(freq * x + phase)))
imagedata(3, x, sx) = imagedata(3, x, y)
imagedata(2, x, sx) = imagedata(2, x, y)
imagedata(1, x, sx) = imagedata(1, x, y)
imagedatacopy(3, x + sy, y) = imagedata(3, x, y)
imagedatacopy(2, x + sy, y) = imagedata(2, x, y)
imagedatacopy(1, x + sy, y) = imagedata(1, x, y)
Next x
Next y
It would be slightly quicker to move the line Randomize Timer to Form_Load. That would also mean that you get numbers which are more technically random (running Randomize too often skews it somehow, I don't remember the details!).
If the picture doesn't get changed outside of the Timer, you could also move some of the following code (but I'm not entirely sure which part(s)) to Form_Load:
Something else that slows your code down is Option Base 1, it is much better to use the default (which is equivalent to Option Base 0) instead - but you will probably need to alter parts of your code to enable that.
Thanks. Would you please add comments to the code? It's totally obscure to me...
OK I reposted with comments - if you use plgblt you can warp the image into irregular shapes. Stretchblt makes it faster since were only squashing , pinching the top and stretching the bottom.
Plus, I think you inadvertently swapped width and height, so you had to make up for it by using weird correction factors. Here follows the code I would use. Please let me know if you disagree with the changes:
Code:
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
'=================================================================
'API Calls - Stretchblt is the key for warping use plgblt
'=================================================================
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim handles(0 To 3) As POINTAPI ' used to calculate morph
Dim Melt(0 To 3) As POINTAPI 'ending position corners of image to be morphed
Dim unMelt(0 To 3) As POINTAPI 'starting position corners of image to be morphed
Dim stdhdc As StdPicture '- image to be morphed
Dim Shdc As Long 'handle to be used by api
Dim Animation As Double
Const picHeight = 527 'image height
Const picWidth = 480 'image width
Const PHMinus1 = picHeight - 1 ' precalc to speed render up
Private Sub Form_Load()
Dim i As Integer
Set stdhdc = LoadPicture(App.Path & "\oscar.jpg")
Me.WindowState = vbMaximized
Shdc = CreateCompatibleDC(0) 'create a dc
SelectObject Shdc, stdhdc 'attach image to dc
Me.ScaleMode = vbPixels
Me.BackColor = vbWhite
Me.AutoRedraw = True
Me.Show
'set up image original shape - by centering it in the form
unMelt(0).X = (Me.ScaleWidth - picWidth) / 2: unMelt(0).Y = (Me.ScaleHeight - picHeight) / 2
unMelt(1).X = unMelt(0).X + picWidth: unMelt(1).Y = unMelt(0).Y
unMelt(2).X = unMelt(0).X: unMelt(2).Y = unMelt(0).Y + picHeight
unMelt(3).X = unMelt(1).X: unMelt(3).Y = unMelt(2).Y
'set up image final shape - by squashing it it in the form
Melt(0).X = Me.ScaleWidth / 2: Melt(0).Y = unMelt(2).Y - 5
Melt(1).X = Melt(0).X: Melt(1).Y = Melt(0).Y
Melt(2).X = -Me.ScaleWidth: Melt(2).Y = unMelt(2).Y
Melt(3).X = Me.ScaleWidth * 2: Melt(3).Y = unMelt(2).Y
Timer1.Interval = 15 ' animation timer initialize
Animation = 0 'tokenanimation
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteDC Shdc 'clean up memory before exiting
End Sub
Private Sub warp()
Dim i As Double
Dim Pt(0 To 1) As POINTAPI
Me.Cls
For i = 0 To 1 Step (1 / PHMinus1) 'render image scanline by scanline
'set the coördinates of the warp
'scale between top and bottom width by using i as a percentage
'1= 100% 0 = 0% ,scale beginning and ennding coords and add together
Pt(0).X = handles(0).X * (1 - i) + handles(2).X * i
Pt(0).Y = handles(0).Y * (1 - i) + handles(2).Y * i
Pt(1).X = handles(1).X * (1 - i) + handles(3).X * i
Pt(1).Y = handles(1).Y * (1 - i) + handles(3).Y * i
'stretchblt warps each scanline to give an irregular shape
StretchBlt Me.hdc, Pt(0).X, Pt(0).Y, Pt(1).X - Pt(0).X + 1, 2, Shdc, 0, PHMinus1 * i, picWidth, 1, vbSrcCopy
Next
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
If Animation = -1 Then 'used for the pause between animation
Animation = 0 'loop
Timer1.Interval = 15
End If
'scale between starting and ending shape by using animation as a percentage
'1= 100% 0 = 0% ,scale starting and ending coords and add together
For i = 0 To 3
handles(i).X = unMelt(i).X * (1 - Animation) + Melt(i).X * Animation
handles(i).Y = unMelt(i).Y * (1 - Animation) + Melt(i).Y * Animation
Next
warp
Animation = Animation + (1 / 150) 'animate by increaing token fractionally
If Animation >= 1 Then 'check for end of morph then pause
Animation = -1
Timer1.Interval = 2000
End If
End Sub
Wasn't a mistake I meant to stretch the bottom out (see post#14). That's what would happen when something melts. It would create an ever increasing pool of liquid. If you got something you could use out of my technique then awesome! Modify it and make it your own.
BTW I did flip h & w but flipping height and width would only rescale he image but not change the warp.
I'll post the plgblt method in the code bank. It turns the image into silly putty.
Last edited by technorobbo; Aug 6th, 2009 at 12:31 PM.
Reply With Quote
Originally Posted by technorobbo
