I made a maze program and it works very fast without printing but I am very weak in graphic so can you help me a bit?
the code is:
PHP Code:
form1.Cls
For i = 1 To W
For j = 1 To H
'inside
If cells(i, j).isin = True Then
For z = 0 To 10
Line (i * 10 + z, j * 10)-(i * 10 + z, j * 10 + 10), vbRed
Next
End If
If cells(i, j).wasin = True And cells(i, j).isin <> True Then
For z = 0 To 10
Line (i * 10 + z, j * 10)-(i * 10 + z, j * 10 + 10), vbBlue
Next
End If
'borders
If cells(i, j).wall(0) = False Then Line (i * 10, j * 10)-(i * 10 + 10, j * 10), vbWhite
If cells(i, j).wall(1) = False Then Line (i * 10, j * 10 + 10)-(i * 10 + 10, j * 10 + 10), vbWhite
If cells(i, j).wall(2) = False Then Line (i * 10 + 10, j * 10)-(i * 10 + 10, j * 10 + 10), vbWhite
If cells(i, j).wall(3) = False Then Line (i * 10, j * 10)-(i * 10, j * 10 + 10), vbWhite
Next
Next
Last edited by KingArthur; Nov 6th, 2002 at 01:21 PM.
Getting rid of the redundant arithmetic operations speeds things up and then locking the window update also speeds things up because it forces the window to draw everything just once.
Try something like this;
Code:
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Dim i as integer, j as integer, z as integer
Dim i10 as integer, j10 as integer
Dim j20 as integer, i20 as integer
form1.Cls
LockWindowUpdate Form1.hDC
For i = 1 To W
For j = 1 To H
'inside
If cells(i, j).isin = True Then
j10=j*10
i10=i*10
j20=j10+10
i20=i10+10
For z = 0 To 10
Line (i10 + z, j10)-(i10 + z, j20), vbRed
Next
End If
If cells(i, j).wasin = True And cells(i, j).isin <> True Then
For z = 0 To 10
Line (i10 + z, j10)-(i10 + z, j20), vbBlue
Next
End If
'borders
If cells(i, j).wall(0) = False Then Line (i10, j10)-(i20, j10), vbWhite
If cells(i, j).wall(1) = False Then Line (i10, j20)-(i20, j20), vbWhite
If cells(i, j).wall(2) = False Then Line (i20, j10)-(i20, j20), vbWhite
If cells(i, j).wall(3) = False Then Line (i10, j10)-(i10, j20), vbWhite
Next
Next
LockWindowUpdate False
I have to arrest you a little bit there "si_the_geek". It's not 100% true that long are faster then integers. It depends on what you are doing. Most often integers are faster. But the time diff of those two variables are so small, so you wouldn't notice the difference. So why not always use long instead of integers...I do....
wow it became about 10 times faster thanks to you all I was stupid not to think about the algorithim I just wanted to us other graphic functions to speed it up(knowlageDB.addrecordset new_knowlage )
just one more Q. is there a function that draws a rect at once 'cos I use the line function 10 times to create one
now the code looks like this:
form1.Cls
LockWindowUpdate form1.hDC
For i = 1 To W
i10 = i * 10
i20 = i10 + 10
For j = 1 To H
j10 = j * 10
j20 = j10 + 10
'inside
If cells(i, j).isin = True Then
For z = 0 To 10
Line (i10 + z, j10)-(i10 + z, j20), vbRed 'this is a rect
Next
Else
If cells(i, j).wasin = True Then
For z = 0 To 10
Line (i10 + z, j10)-(i10 + z, j20), vbBlue 'this is another rect
Next
End If
End If
'borders
If cells(i, j).wall(0) = False Then Line (i10, j10)-(i20, j10), vbWhite
If cells(i, j).wall(1) = False Then Line (i10, j20)-(i20, j20), vbWhite
If cells(i, j).wall(2) = False Then Line (i20, j10)-(i20, j20), vbWhite
If cells(i, j).wall(3) = False Then Line (i10, j10)-(i10, j20), vbWhite
Const PS_DOT = 2
Const PS_SOLID = 0
Const RGN_AND = 1
Const RGN_COPY = 5
Const RGN_OR = 2
Const RGN_XOR = 3
Const RGN_DIFF = 4
Const HS_DIAGCROSS = 5
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
Private Type LOGPEN
lopnStyle As Long
lopnWidth As POINTAPI
lopnColor As Long
End Type
Private Declare Function CreateHatchBrush Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreatePenIndirect Lib "gdi32" (lpLogPen As LOGPEN) As Long
Private Declare Function CreateRectRgnIndirect Lib "gdi32" (lpRect As RECT) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function InvertRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long) As Long
Private Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function Pie Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Me.ScaleMode = vbPixels
End Sub
Private Sub Form_Paint()
Dim hHBr As Long, R As RECT, hFRgn As Long, hRRgn As Long, hRPen As Long, LP As LOGPEN
Dim hFFBrush As Long, mIcon As Long, Cnt As Long
'Clear the form
Me.Cls
'Set the rectangle's values
SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight
'Create a new brush
hHBr = CreateHatchBrush(HS_DIAGCROSS, vbRed)
'Draw a frame
FrameRect Me.hdc, R, hHBr
'Draw a rounded rectangle
hFRgn = CreateRoundRectRgn(0, 0, Me.ScaleWidth, Me.ScaleHeight, (Me.ScaleWidth / 3) * 2, (Me.ScaleHeight / 3) * 5)
'Draw a frame
FrameRgn Me.hdc, hFRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Invert a region
InvertRgn Me.hdc, hFRgn
'Move our region
OffsetRgn hFRgn, 10, 10
'Create a new region
hRRgn = CreateRectRgnIndirect(R)
'Combine our two regions
CombineRgn hRRgn, hFRgn, hRRgn, RGN_XOR
'Draw a frame
FrameRgn Me.hdc, hRRgn, hHBr, Me.ScaleWidth, Me.ScaleHeight
'Crete a new pen
hRPen = CreatePen(PS_SOLID, 5, vbBlue)
'Select our pen into the form's device context and delete the old pen
DeleteObject SelectObject(Me.hdc, hRPen)
'Draw a rectangle
Rectangle Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25
'Delete our pen
DeleteObject hRPen
LP.lopnStyle = PS_DOT
LP.lopnColor = vbGreen
'Create a new pen
hRPen = CreatePenIndirect(LP)
'Select our pen into the form's device context
SelectObject Me.hdc, hRPen
'Draw a rounded rectangle
RoundRect Me.hdc, Me.ScaleWidth / 2 - 25, Me.ScaleHeight / 2 - 25, Me.ScaleWidth / 2 + 25, Me.ScaleHeight / 2 + 25, 50, 50
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbYellow)
'Select this brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Floodfill our form
FloodFill Me.hdc, Me.ScaleWidth / 2, Me.ScaleHeight / 2, vbBlue
'Delete our brush
DeleteObject hFFBrush
'Create a new solid brush
hFFBrush = CreateSolidBrush(vbMagenta)
'Select our solid brush into our form's device context
SelectObject Me.hdc, hFFBrush
'Draw a Pie
Pie Me.hdc, Me.ScaleWidth / 2 - 15, Me.ScaleHeight / 2 - 15, Me.ScaleWidth / 2 + 15, Me.ScaleHeight / 2 + 15, 20, 20, 20, 20
'Extract icons from 'shell32.dll' and draw them on the form
For Cnt = 0 To Me.ScaleWidth / 32
ExtractIconEx "shell32.dll", Cnt, mIcon, ByVal 0&, 1
DrawIcon Me.hdc, 32 * Cnt, 0, mIcon
DestroyIcon mIcon
Next Cnt
'Clean up
DeleteObject hFFBrush
DeleteObject hRPen
DeleteObject hRRgn
DeleteObject hFRgn
DeleteObject hHBr
End Sub
Private Sub Form_Resize()
Form_Paint
End Sub
Originally posted by NoteMe Most often integers are faster.
Are you sure about that? I know the difference may not be huge (or even noticeable), but I was under the impression from my own experiments (and several on this forum and VB as well as VB optimisation sites) that longs were almostnever slower, usually faster.
KingArthur - the code posted by jim mcnamara is what you want. Just as a note, I didn't realise till after i'd posted the code that the line function has a couple of extra parameters (see VB help for more info) - B (box), and BF (box filled), so you could have done:
To si_the_geek: I have made my own example that tests some math using long VS. integer. And Integer usually comes out faster. But of course it depends on more then the code you are using. The machine and what other tings happening have something to say too...
Originally posted by NoteMe To si_the_geek: I have made my own example that tests some math using long VS. integer. And Integer usually comes out faster. But of course it depends on more then the code you are using. The machine and what other tings happening have something to say too...
ok, how many iterations did you do? how did you time it? which functions did you use?
OK, I have made a little sample of what I did...check it out, and tell me your results. On my computer in nearly 2 out of 3 tests the integers are faster...
Ok, good test. GetTickcount is the best way of timing, and there are several iterations. Not much work with the numbers.
Here are my results, each run 3 times (on each run they were roughly the same). As expected the difference wasn't huge, but Longs were faster.
LocalMaxCount = 10000
GlobalMaxCount = 5000
Long test now running...
Data type = Long
Test time = 6970 ms
Result = 1.394 ms
Integer test now running...
Data type = Integer
Test time = 7521 ms
Result = 1.5042 ms
LocalMaxCount = 30000
GlobalMaxCount = 5000
Long test now running...
Data type = Long
Test time = 20910 ms
Result = 4.182 ms
Integer test now running...
Data type = Integer
Test time = 22562 ms
Result = 4.5124 ms
LocalMaxCount = 30000
GlobalMaxCount = 10000
Long test now running...
Data type = Long
Test time = 41821 ms
Result = 4.1821 ms
Integer test now running...
Data type = Integer
Test time = 45114 ms
Result = 4.5114 ms
And changing the workload (from "n = n+1" to "n = (n + 1) * 1")
LocalMaxCount = 10000
GlobalMaxCount = 5000
Long test now running...
Data type = Long
Test time = 10836 ms
Result = 2.1672 ms
Integer test now running...
Data type = Integer
Test time = 12568 ms
Result = 2.5136 ms
And changing the workload (from "n = n+1" to "n = ((n + 1) /10) * 10")
Long test now running...
Data type = Long
Test time = 18537 ms
Result = 3.7074 ms
Integer test now running...
Data type = Integer
Test time = 22743 ms
Result = 4.5486 ms
Originally posted by NoteMe What kind of machine do you have....CPU type etc.....
P3-550, 256MB Ram
I think you'll find that this sort of difference between longs & int's is standard, as processors work in 32bit (same as Long), so Integers (16 bit) need to be padded with zeros before they are used.
si_the_geek: Could you do me a favor. I just switched the order of the two tests, and I did completely new result. When I did this the integer used nearly twice the time of the Long. Could you check that out on your PC....?
By the way, I used:
Const LocalMaxCount As Long = 30000
Const GlobalMaxCount As Long = 60000
This is the weirdest test I have ever done....I have no idea why the integer test takes twice the time if you switched the order of the two tests....but I'm not sure if I want to use more time to it....EVERYONE USE LONG....
Haha, cool kit guys. But I suggest you use QueryPerformanceCounter as an alternative to GetTickCount, on machines where available (NT/2K/XP). So, here's a class that incorporates this:
VB Code:
'******* sTime.cls *******
'PROPERTY:
Private in_RetTime As Double
'VARIABLES:
Private tFreq As Currency
Private tStart As Currency
Private tStop As Currency
Private gTC As Boolean
'DECLARATIONS:
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Property Get RetTime() As Double
RetTime = in_RetTime 'Returns Seconds
End Property
Public Sub Init()
QueryPerformanceFrequency tFreq
If tFreq = 1000 Then
gTC = True
Else
gTC = False
End If
End Sub
Public Sub StopTime()
If gTC Then
tStop = CCur(GetTickCount)
Else
QueryPerformanceCounter tStop
End If
in_RetTime = (tStop - tStart) / tFreq
End Sub
Public Sub StartTime()
If gTC Then
tStart = CCur(GetTickCount)
Else
QueryPerformanceCounter tStart
End If
End Sub
'******* Form Code *******
Private Sub Form_Load()
Dim J As Long
Dim I As Long
Dim N As Long
Dim Q As New sTime
Q.Init
Q.StartTime
For I = 0 To 30000
N = 0
For J = 0 To 300
N = N * CLng((N - 1) + N ^ 2)
Next J
Next I
Q.StopTime
MsgBox Q.RetTime
End Sub
Tell me what you think!
All contents of the above post that aren't somebody elses are mine, not the property of some media corporation.
(Just a heads-up)
Reply With Quote
)
