Printable View
Just run the program to see what it does...
Is there any legitimate way of making it run faster?
On this machine, a resolution of 75 is optimum for speed, but detail sucks.
Is it the evil DoEvents that I've been hearing about? If so, how can I fix it?
EDIT: Double click on the form to restart the program. Nice little touch that the :afrog: inspired me to do.
If you notice your doing this calcuation over and over in your loop:Quote:
Originally Posted by timeshifter
lines(0) = lines(0) + (1 / res)
move that to a variable outside your loop so you can just say:
lines(0) = lines(0) + DivAnswer
next thing I noticed is that your using this compare in your nest of if statements: And lines(0) < maxline
instead of doing it like that say:
if lines(counter) < maxline then
- Nested If statements here -
end if
None of that is what is really slowing this down though. Your largest problem is use of pset and of course floating point numbers. You may want to change your useage of pset to line instead.
Replacing Pset with SetPixel API should speed it up a lot.
But, here is the way to make it somewhat the fastest possible VB way:
- make a 8-bit DIB with a palette (0 = black, 1 = blue, 2 = red, etc. etc.)
- then paint to a byte buffer, logic is like: Buffer(Y * Width + X) = 1
- copy byte buffer to the DIB
- paint the DIB to the screen using BitBlt
Sounds too simple?
Uh... A little too complicated for my VBNoob status...
Care to show me some code so I can better understand what I'm looking at?
Here it goes, even though this might be a bit longer post (I'm a bit tired and I'm pasting a lot of old code not perfectly suited for this situatation). I didn't kind of expect you to be curious enough for this (I hope you didn't mean SetPixel API :D).
First, about the 8-bit backbuffer. It is where you draw stuff. You can use it like this:
There we have it initialized. After that, you can do drawing to the buffer:Code:Dim Buffer() As Byte, bWidth As Long, bHeight As Long
bWidth = ScaleWidth
bHeight = ScaleHeight
ReDim Buffer(bHeight * bWidth - 1) 'index starts at 0, so to prevent an extra byte we must do -1
Code:'just an example... sets each pixel in the backbuffer to use second palette color
For Y = 0 To bHeight - 1
For X = 0 To bWidth - 1
'you could optimize speed of Y * bWidth by doing it outside this loop
Buffer(Y * bWidth + X) = 1
Next X
Next Y
'believe it or not, after compiling the program this thing executes faster than you can blink your eye
Now you should know how to draw stuff in there. Then there is three things left: palette, handling DIB and setting the buffer into the DIB. Since I'm lazy, I just post some code I did some time ago (untested, but should work):
You need a picturebox with the following settings:Code:'in a module
Option Explicit
Public Const BI_RGB = 0&
Public Const CBM_CREATEDIB = &H2
Public Const CBM_INIT = &H4
Public Const DIB_RGB_COLORS = 0
Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type BITMAPINFO_256
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As RGBQUAD
End Type
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function CreateDIBitmap Lib "gdi32" (ByVal hDC As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_256, ByVal wUsage As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public 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
Public Sub GreyscalePalette(ByRef Palette() As Byte)
Dim A As Long, B As Long
For A = 0 To 255
B = A + A + A + A
Palette(B) = A
Palette(B + 1) = A
Palette(B + 2) = A
Palette(B + 3) = 0
Next A
End Sub
AutoRedraw = True
ScaleMode = vbPixels
Code:'in a form
Private Sub Draw8bit(ByVal gWidth As Long, ByVal gHeight As Long, ByRef GraphicsData() As Byte)
Dim BMP_INFO As BITMAPINFO_256, BMP_DATA() As Byte, hDIB As Long
Dim Screen_hDC As Long, A As Long, B As Long
Dim Compat_DC As Long, MainPalette(1023) As Byte
'On Error GoTo ErrorHandler
If gWidth Mod 4 Then
'count new width
B = gWidth + 4 - gWidth Mod 4
'resize graphics array
ReDim BMP_DATA(B * gHeight - 1)
'copy graphics data row by row
For A = 0 To gHeight - 1
RtlMoveMemory ByVal VarPtr(BMP_DATA(A * B)), ByVal VarPtr(GraphicsData(A * gWidth)), gWidth
Next A
Else
'resize graphics array
ReDim BMP_DATA(gWidth * gHeight - 1)
'copy graphics data
RtlMoveMemory ByVal VarPtr(BMP_DATA(0)), ByVal VarPtr(GraphicsData(0)), gWidth * gHeight
End If
'generate greyscale palette
GreyscalePalette MainPalette
'copy palette data
RtlMoveMemory ByVal VarPtr(BMP_INFO.bmiColors(0)), ByVal VarPtr(MainPalette(0)), 1024
'set DIB header
With BMP_INFO.bmiHeader
.biSize = Len(BMP_INFO.bmiHeader)
.biWidth = SpriteInfo(Index).Width ' width in pixels
.biHeight = SpriteInfo(Index).Height ' height in pixels
.biPlanes = 1 ' 1 color plane
.biBitCount = 8 ' 8 bits per pixel
.biCompression = BI_RGB ' no compression
.biSizeImage = 0 ' unrequired with no compression
.biXPelsPerMeter = 0 ' unrequired
.biYPelsPerMeter = 0 ' unrequired
.biClrUsed = 256 ' number colors in color table that are used by the image (0 means all)
.biClrImportant = 256 ' number important colors (0 means all)
End With
'get the screen's device context
Screen_hDC = GetDC(0)
'create the DIB
hDIB = CreateDIBitmap(Screen_hDC, BMP_INFO.bmiHeader, CBM_INIT Or CBM_CREATEDIB, BMP_DATA(0), BMP_INFO, DIB_RGB_COLORS)
'create a compatible device context
Compat_DC = CreateCompatibleDC(hDC)
'select the DIB into the compatible DC
SelectObject Compat_DC, hDIB
Picture1.BackColor = Picture1.BackColor
'copy the compatible DC's image to the target
StretchBlt Picture1.hDC, (Picture1.ScaleHeight - gWidth) \ 2, (Picture1.ScaleHeight - gHeight) \ 2, gWidth, gHeight, Compat_DC, 0, gHeight - 1, gWidth, -gHeight, vbSrcCopy
Picture1.Refresh
ErrorHandler:
'free up memory
ReleaseDC 0, Screen_hDC
DeleteDC Compat_DC
DeleteObject hDIB
Erase BMP_DATA
End Sub
It was for someone who wanted to display byte array contents in a graphical form easily. Hope you can learn something out of all this, even though especially the latter code can be confusion as there is a lot of things to learn :)
Edit RtlMoveMemory is the same as CopyMemory API, just rename all to CopyMemory and include CopyMemory there (lazy to look for it now).
:eek2:
You have no idea how much I wish we had vbcode tags right now...
Dude, I got it! Direct Memory Addressing! It's a hell of a lot faster than drawing pixels using DIB's. Here's the URL to my program:
http://www.planet-source-code.com/vb...55262&lngWId=1
Next, make a look up table to where no math is done during the rendering loop because the computer will already know what to do then.