I neeeeeeed to print this faster

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 


---

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

---

Agreed, there are also a couple of extras..

Don't use Integer - use Long instead (it's a bit quicker as it is the computer's own internal size of numbers).

Reduce Logical checks - you have two checks on the same value, there is no need to check it twice.

VB Code:

'This bit goes in the "general declarations" part of the form/module
Private Declare Function LockWindowUpdate Lib "user32" _ 
    (ByVal hwndLock As Long) As Long
 
Dim i as Long, j as Long, z as Long
Dim i10 as Long, j10 as Long
Dim j20 as Long, i20 as Long
form1.Cls
LockWindowUpdate Form1.hDC
    For i = 1 To W
        For j = 1 To H
            j10=j*10
            i10=i*10
            j20=j10+10
            i20=i10+10
 
            'inside
            If cells(i, j).isin = True Then
                For z = 0 To 10
                    Line (i10 + z, j10)-(i10 + z, j20), vbRed
                Next
 
            Else
'Here we already know:  cells(i, j).isin <> True
'so we can ignore the AND in the IF statement
'(NB: this also means that this check isnt done if  cells(i, j).isin = True
              If cells(i, j).wasin = True Then
                  For z = 0 To 10
                      Line (i10 + z, j10)-(i10 + z, j20), vbBlue
                  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
 
        Next
    Next
LockWindowUpdate False

and just spotted something else...

The variables i10 and i20 don't change with j, so they can be moved outside the J loop, ie:

VB Code:

...
    For i = 1 To W
        i10=i*10
        i20=i10+10
        For j = 1 To H
            j10=j*10
            j20=j10+10
...

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

Next
Next

Here are some graphics api's. Look at Rectangle.

Code:

---

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

---

Quote:

---

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:

VB Code:

If cells(i, j).isin = True Then
  Line (i10, j10)-(i20, j20), vbRed, BF
Else
  If cells(i, j).wasin = True Then
    Line (i10, j10)-(i20, j20), vbBlue, BF
  End If
End If

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...

Quote:

---

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

What kind of machine do you have....CPU type etc.....

Quote:

---

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

and compiled the SpeedTest....

ok, I get:

Integer test now running...
Data type = Integer
Test time = 23314 ms
Result = 0.388566666666667 ms

Long test now running...
Data type = Long
Test time = 16574 ms
Result = 0.276233333333333 ms

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!