JackOfPH
asked on
How to make this looping faster
Hi! Is there anyway to make this loop faster?
for ctr1 = 1 to NumOfChar
for ctr2 = 1 to NumOfChar
for ctr3 = 1 to NumOfChar
for ctr4 = 1 to NumOfChar
for ctr5 = 1 to NumOfChar
******my statement********
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
for ctr1 = 1 to NumOfChar
for ctr2 = 1 to NumOfChar
for ctr3 = 1 to NumOfChar
for ctr4 = 1 to NumOfChar
for ctr5 = 1 to NumOfChar
******my statement********
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
If you are working with strings, with some actions, it is millions% faster to convert them to byte arrays first.
But we need to see or know what your are trying to achieve
But we need to see or know what your are trying to achieve
hehe, sounds like a comp sci homework question :) (i know that because I've had to answer similar questions
before, and it looks strangely like one of those questions)... if it *is*, you *should* be doing your hmwk yourself...
but technically speaking, yes, to make it loop faster since you have "NumOfChar" as the range each time from 1, the loop
you described is technically equivalent to NumOfChar^5
so
for ctr1 = 1 to (NumOfChar ^ 5)
******my statement********
next ctr1
is technically equivalent to what you wrote, but "faster", because you have less actual "machine" code instructions
being executed each time. It is a very marginal difference (unless you are using a stack each time for the loop, in
which case it is a big difference), but bottomline, the loop above is faster than what you have.
before, and it looks strangely like one of those questions)... if it *is*, you *should* be doing your hmwk yourself...
but technically speaking, yes, to make it loop faster since you have "NumOfChar" as the range each time from 1, the loop
you described is technically equivalent to NumOfChar^5
so
for ctr1 = 1 to (NumOfChar ^ 5)
******my statement********
next ctr1
is technically equivalent to what you wrote, but "faster", because you have less actual "machine" code instructions
being executed each time. It is a very marginal difference (unless you are using a stack each time for the loop, in
which case it is a big difference), but bottomline, the loop above is faster than what you have.
ASKER
to cool12399
This is not a homework... I graduated 2 years ago... I am asking this because I dealing of permutations... in my program... I need to make the program faster.
to others, Angel and inthedark here is the statement...
for ctr1 = 1 to NumOfChar
for ctr2 = 1 to NumOfChar
for ctr3 = 1 to NumOfChar
for ctr4 = 1 to NumOfChar
for ctr5 = 1 to NumOfChar
list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
please help?
This is not a homework... I graduated 2 years ago... I am asking this because I dealing of permutations... in my program... I need to make the program faster.
to others, Angel and inthedark here is the statement...
for ctr1 = 1 to NumOfChar
for ctr2 = 1 to NumOfChar
for ctr3 = 1 to NumOfChar
for ctr4 = 1 to NumOfChar
for ctr5 = 1 to NumOfChar
list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
please help?
ASKER
whats the string builder class? can anyone explain?
ASKER
I am just using vb 6.0? Does string builder comes from vb.net, c#?
>>list1.additem myArray(ctr1) + myArray(ctr2) + myArray(ctr3) + myArray(ctr4) + myArray(ctr5)
string builder will not help you.
If you use listbox, you better change to use listview instead.
string builder will not help you.
If you use listbox, you better change to use listview instead.
It looks like you are basically "counting" using the elements of the "myArray".
What is in "myArray"?
Just to get your creative juices flowing, here is a different approach to a "counting" system:
https://www.experts-exchange.com/questions/21857955/Routine-to-Create-a-New-Revision.html
In the above PAQ, you can specify the characters to use in the counting sequence...
What is in "myArray"?
Just to get your creative juices flowing, here is a different approach to a "counting" system:
https://www.experts-exchange.com/questions/21857955/Routine-to-Create-a-New-Revision.html
In the above PAQ, you can specify the characters to use in the counting sequence...
One way of making loops faster is by not using the variable name with the Next clause. So you Next clauses will look like this:
next
next
next
next
next
Instead of:
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
next
next
next
next
next
Instead of:
next ctr5
next ctr4
next ctr3
next ctr2
next ctr1
ASKER
my array holds characters alphbet letters.
What I have mentioned in an optimization tip for any loop and it will work in your case too.
ASKER
Ok trying all your suggestions... will be back in minutes... thanks
hi jack...
if you are trying to enumerate (and create) *all* different possibilities, then there are not really any loop optimizations.
if all you want to do is get the possible #, do something like:
http://www.devx.com/vb2themax/Tip/19017
------->
' number of permutations of N objects in groups of M
'
' Note: requires the FACTORIAL routine
Function Permutations(ByVal Objects As Long, ByVal GroupSize As Long) As Double
Permutations = Factorial(Objects) / Factorial(Objects - GroupSize)
End Function
if you are trying to enumerate (and create) *all* different possibilities, then there are not really any loop optimizations.
if all you want to do is get the possible #, do something like:
http://www.devx.com/vb2themax/Tip/19017
------->
' number of permutations of N objects in groups of M
'
' Note: requires the FACTORIAL routine
Function Permutations(ByVal Objects As Long, ByVal GroupSize As Long) As Double
Permutations = Factorial(Objects) / Factorial(Objects - GroupSize)
End Function
one of many stringbuilder classes for vb6:
http://www.15seconds.com/howto/pg000929.htm
but as said, this will probably not help here
>my array holds characters alphbet letters.
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?
http://www.15seconds.com/howto/pg000929.htm
but as said, this will probably not help here
>my array holds characters alphbet letters.
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?
ASKER
>my array holds characters alphbet letters.
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?
my array holds the characters in the alphabet
for example
myArray(1) holds the value "a" and myArray(2) holds the value "2"
what kind of combinations? are they in order or what?
what is the max value of NumOfChar?
my array holds the characters in the alphabet
for example
myArray(1) holds the value "a" and myArray(2) holds the value "2"
ASKER
Idle mind I tried your comments... and the sample code in the link... but it gave me no speed... is there anyway?
The looping is not the issue here, you could make your code instant. But this will take a bit of time.
But for a quick fix try this.....it will make the code run way much faster
1) Qucik solution
Before the loop
FreezeSet Me
for ctr1 = 1 to NumOfChar
For ctrl2
etc.....
Next
Next
' After all loops are complete
FreezeClear
See next post for an instant solution......
' change private to public if you want to put code in a module.
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Sub FreezeSet(FormToFreeze As Object)
' lock as form so that windows will not update display
' to increase speed or make whole screen appear as if by magic
'Example: FreezSet Me
LockWindowUpdate FormToFreeze.Hwnd
End Sub
Private Sub FreezeClear()
' release a locked screen
' Example: FreezeClear
LockWindowUpdate 0&
End Sub
But for a quick fix try this.....it will make the code run way much faster
1) Qucik solution
Before the loop
FreezeSet Me
for ctr1 = 1 to NumOfChar
For ctrl2
etc.....
Next
Next
' After all loops are complete
FreezeClear
See next post for an instant solution......
' change private to public if you want to put code in a module.
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Sub FreezeSet(FormToFreeze As Object)
' lock as form so that windows will not update display
' to increase speed or make whole screen appear as if by magic
'Example: FreezSet Me
LockWindowUpdate FormToFreeze.Hwnd
End Sub
Private Sub FreezeClear()
' release a locked screen
' Example: FreezeClear
LockWindowUpdate 0&
End Sub
I tried some combinations, but with NumOfChar=9, it takes already 2 seconds.
what value of NumOfChar do you use?
what value of NumOfChar do you use?
inthedark, fyi, the LockWindowUpdate did not change anything in my case...
ASKER
No, change...
Here is a handy permutations class I created for generating permutations for either alpha or numeric values.
It loops like a recordset, for simplicity and will return either a key value or an array of numeric values.
See examples in the declarations...
----------Class: zPermutations.cls
Option Explicit
' Class: zPermutations
' Author: Nick Young nyoung@vipintersoft.com
' Copyright (c) 2003 Nick Young
' You may use & distribute freely but provided that the author and copyright are acknowledged.
' WARNING: Read The Notes for the item property
'EXAMPLES OF USAGE:
'' example 1 using numeric keys
'Dim Px As zPermutations
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.MoveFirst
'Do While Not Px.EOF
' Debug.Print Px.CurrentKey
' Px.MoveNext
'Loop
'Stop
'
'' example 2 using aplha keys
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey "A"
'Px.AddKey "B"
'Px.AddKey "C"
'Px.Numeric = False
'Px.MoveFirst
'Do While Not Px.EOF
' Debug.Print Px.CurrentKey
' Px.MoveNext
'Loop
'Stop
'
'' Example 3 using array of values
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
' Px.LoadCurrentLongArray CurrentKey()
' For lc = LBound(CurrentKey) To UBound(CurrentKey)
' Debug.Print CStr(CurrentKey(lc)); " ";
' Next lc
' Debug.Print
' Px.MoveNext
'Loop
'Stop
Dim mlElements As Long
Dim B() As Boolean
Dim Sequence() As Long
Dim mbComplete As Boolean
Dim mlCurrent As Long
Public ElementsFound As Long
Public Numeric As Boolean
Dim mlKeyCount
Dim mvKeys() As Variant
Dim mlArrayBase As Long
Public Function AddKey(Key)
' adds a key value for the next element
mlKeyCount = mlKeyCount + 1
ReDim Preserve mvKeys(mlKeyCount - 1)
mvKeys(mlKeyCount - 1) = Key
End Function
Public Property Let ArrayBase(plNewValue As Long)
mlArrayBase = plNewValue
End Property
Public Function Char(Item) As String
' converts a binary value into a letter
' so zero is A, 1 is B etc.
Char = Chr(Item + 65)
End Function
Public Function CurrentKey() As String
' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
If Numeric Then
Dim sKey As String
Dim lc As Long
sKey = Space(mlElements + 1)
For lc = 0 To mlElements
Mid(sKey, lc + 1, 1) = Chr(48 + mvKeys(Sequence(lc)))
Next lc
CurrentKey = sKey
Else
sKey = ""
For lc = 0 To mlElements
sKey = sKey & mvKeys(Sequence(lc))
Next lc
CurrentKey = sKey
End If
End Function
Public Sub LoadCurrentLongArray(rLong Array() As Long)
' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
Static bDone As Boolean
If Not bDone Then
bDone = True
ReDim rLongArray(mlArrayBase To mlArrayBase + mlElements)
End If
Dim sKey As String
Dim lc As Long
sKey = ""
For lc = 0 To mlElements
rLongArray(lc + mlArrayBase) = mvKeys(Sequence(lc))
Next lc
End Sub
Public Function EOF() As Boolean
' returns true if all possibles been found?
EOF = mbComplete
End Function
Public Property Get Item(Element) As Variant
' ** WARNING: READ THESE NOTES:
' make this the default proeprty
' Select Tools, Provedure attributes, select the Item propery,
' then Advanced, change the procedure ID to Default,
' then click APPLY
' this will return the key value for an element
' or if no keys were specified it will return
' the numeric value of the sequence
If mlKeyCount > 0 Then
Item = mvKeys(Sequence(Element))
Else
Item = Sequence(Element)
End If
End Property
Public Property Get Value(Element) As Long
' this will return the numeric value for an element
Value = Sequence(Element)
End Property
Public Sub MoveFirst()
' move to the start of the sequence
ReDim B(mlElements)
ReDim Sequence(mlElements)
Dim lc As Long
' SET UP LOWEST POSSIBLE VALUE
For lc = 0 To mlElements
Sequence(lc) = lc
Next
' setup starting point for next move
mlCurrent = mlElements
ElementsFound = 1
mbComplete = False
End Sub
Public Sub MoveNext()
' setup key values for the next item
Dim bInvalid As Boolean
Dim lc As Long
Dim lVal As Long
' keep looping until the next valid permutation is found
' example 42345 is invalid so add 1
' butthe thing that makes this routine fast
' is that it knows that the 2nd 4 is repeated and must be changed next
Do
Advance
If mbComplete Then Exit Sub
' now see if the current sequence is a valid permutation
' clear an incidator so see if a value has been found
For lc = 0 To mlElements
B(lc) = False
Next
bInvalid = False
For lc = 0 To mlElements
lVal = Sequence(lc)
If B(lVal) Then
bInvalid = True
Exit For
Else
B(lVal) = True
End If
Next
If Not bInvalid Then
' make sure next advance will work on the last change
mlCurrent = mlElements
Exit Do
End If
Loop
ElementsFound = ElementsFound + 1
End Sub
Private Sub Advance()
' to see what this functions does is imagine you
' are working in base 10 and you have the number
' 12349
' add 1 to this number and you get 12350
' this function does the same but in the specified base
' ABC
' ACA
' ACB
Do
' add 1 to the last returned sequence
Sequence(mlCurrent) = Sequence(mlCurrent) + 1
If Sequence(mlCurrent) <= mlElements Then
mlCurrent = mlElements
' Form1.List1.AddItem "N: " + CurrentKey
Exit Sub
End If
Sequence(mlCurrent) = 0
mlCurrent = mlCurrent - 1
If mlCurrent < 0 Then
mbComplete = True
Exit Sub
End If
Loop
End Sub
Public Property Get Elements() As Long
' returns the number of elements
Elements = mlElements + 1
End Property
Public Property Let Elements(NewValue As Long)
' Sets the number of elements to be used
' example value passed as 5
' is elements 0 to 4 so the number 4 is stored
' but don't allow less than 2 elements
If NewValue < 2 Then
mlElements = 1
Else
mlElements = NewValue - 1
End If
ReDim mvKeys(mlElements)
Dim lc As Long
For lc = 0 To mlElements
mvKeys(lc) = Chr(65 + lc)
Next lc
mlKeyCount = 0
MoveFirst
End Property
Public Property Get Permutations() As Double
' calculate the possibilities
Dim P As Double
Dim lc As Double
P = 1
For lc = mlElements + 1 To 2 Step -1
P = P * lc
Next
Permutations = P
End Property
Private Sub Class_Initialize()
mlArrayBase = 0
End Sub
It loops like a recordset, for simplicity and will return either a key value or an array of numeric values.
See examples in the declarations...
----------Class: zPermutations.cls
Option Explicit
' Class: zPermutations
' Author: Nick Young nyoung@vipintersoft.com
' Copyright (c) 2003 Nick Young
' You may use & distribute freely but provided that the author and copyright are acknowledged.
' WARNING: Read The Notes for the item property
'EXAMPLES OF USAGE:
'' example 1 using numeric keys
'Dim Px As zPermutations
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.MoveFirst
'Do While Not Px.EOF
' Debug.Print Px.CurrentKey
' Px.MoveNext
'Loop
'Stop
'
'' example 2 using aplha keys
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey "A"
'Px.AddKey "B"
'Px.AddKey "C"
'Px.Numeric = False
'Px.MoveFirst
'Do While Not Px.EOF
' Debug.Print Px.CurrentKey
' Px.MoveNext
'Loop
'Stop
'
'' Example 3 using array of values
'Set Px = New zPermutations
'Px.Elements = 3
'Px.AddKey 1
'Px.AddKey 2
'Px.AddKey 3
'Px.Numeric = True
'Px.ArrayBase = 0 ' set
'
'Px.MoveFirst
'
'Dim CurrentKey() As Long
'Dim lc As Long
'
'Do While Not Px.EOF
' Px.LoadCurrentLongArray CurrentKey()
' For lc = LBound(CurrentKey) To UBound(CurrentKey)
' Debug.Print CStr(CurrentKey(lc)); " ";
' Next lc
' Debug.Print
' Px.MoveNext
'Loop
'Stop
Dim mlElements As Long
Dim B() As Boolean
Dim Sequence() As Long
Dim mbComplete As Boolean
Dim mlCurrent As Long
Public ElementsFound As Long
Public Numeric As Boolean
Dim mlKeyCount
Dim mvKeys() As Variant
Dim mlArrayBase As Long
Public Function AddKey(Key)
' adds a key value for the next element
mlKeyCount = mlKeyCount + 1
ReDim Preserve mvKeys(mlKeyCount - 1)
mvKeys(mlKeyCount - 1) = Key
End Function
Public Property Let ArrayBase(plNewValue As Long)
mlArrayBase = plNewValue
End Property
Public Function Char(Item) As String
' converts a binary value into a letter
' so zero is A, 1 is B etc.
Char = Chr(Item + 65)
End Function
Public Function CurrentKey() As String
' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
If Numeric Then
Dim sKey As String
Dim lc As Long
sKey = Space(mlElements + 1)
For lc = 0 To mlElements
Mid(sKey, lc + 1, 1) = Chr(48 + mvKeys(Sequence(lc)))
Next lc
CurrentKey = sKey
Else
sKey = ""
For lc = 0 To mlElements
sKey = sKey & mvKeys(Sequence(lc))
Next lc
CurrentKey = sKey
End If
End Function
Public Sub LoadCurrentLongArray(rLong
' display the current key value
' this may key may be meaningless if numeric keys above 9 are used.
Static bDone As Boolean
If Not bDone Then
bDone = True
ReDim rLongArray(mlArrayBase To mlArrayBase + mlElements)
End If
Dim sKey As String
Dim lc As Long
sKey = ""
For lc = 0 To mlElements
rLongArray(lc + mlArrayBase) = mvKeys(Sequence(lc))
Next lc
End Sub
Public Function EOF() As Boolean
' returns true if all possibles been found?
EOF = mbComplete
End Function
Public Property Get Item(Element) As Variant
' ** WARNING: READ THESE NOTES:
' make this the default proeprty
' Select Tools, Provedure attributes, select the Item propery,
' then Advanced, change the procedure ID to Default,
' then click APPLY
' this will return the key value for an element
' or if no keys were specified it will return
' the numeric value of the sequence
If mlKeyCount > 0 Then
Item = mvKeys(Sequence(Element))
Else
Item = Sequence(Element)
End If
End Property
Public Property Get Value(Element) As Long
' this will return the numeric value for an element
Value = Sequence(Element)
End Property
Public Sub MoveFirst()
' move to the start of the sequence
ReDim B(mlElements)
ReDim Sequence(mlElements)
Dim lc As Long
' SET UP LOWEST POSSIBLE VALUE
For lc = 0 To mlElements
Sequence(lc) = lc
Next
' setup starting point for next move
mlCurrent = mlElements
ElementsFound = 1
mbComplete = False
End Sub
Public Sub MoveNext()
' setup key values for the next item
Dim bInvalid As Boolean
Dim lc As Long
Dim lVal As Long
' keep looping until the next valid permutation is found
' example 42345 is invalid so add 1
' butthe thing that makes this routine fast
' is that it knows that the 2nd 4 is repeated and must be changed next
Do
Advance
If mbComplete Then Exit Sub
' now see if the current sequence is a valid permutation
' clear an incidator so see if a value has been found
For lc = 0 To mlElements
B(lc) = False
Next
bInvalid = False
For lc = 0 To mlElements
lVal = Sequence(lc)
If B(lVal) Then
bInvalid = True
Exit For
Else
B(lVal) = True
End If
Next
If Not bInvalid Then
' make sure next advance will work on the last change
mlCurrent = mlElements
Exit Do
End If
Loop
ElementsFound = ElementsFound + 1
End Sub
Private Sub Advance()
' to see what this functions does is imagine you
' are working in base 10 and you have the number
' 12349
' add 1 to this number and you get 12350
' this function does the same but in the specified base
' ABC
' ACA
' ACB
Do
' add 1 to the last returned sequence
Sequence(mlCurrent) = Sequence(mlCurrent) + 1
If Sequence(mlCurrent) <= mlElements Then
mlCurrent = mlElements
' Form1.List1.AddItem "N: " + CurrentKey
Exit Sub
End If
Sequence(mlCurrent) = 0
mlCurrent = mlCurrent - 1
If mlCurrent < 0 Then
mbComplete = True
Exit Sub
End If
Loop
End Sub
Public Property Get Elements() As Long
' returns the number of elements
Elements = mlElements + 1
End Property
Public Property Let Elements(NewValue As Long)
' Sets the number of elements to be used
' example value passed as 5
' is elements 0 to 4 so the number 4 is stored
' but don't allow less than 2 elements
If NewValue < 2 Then
mlElements = 1
Else
mlElements = NewValue - 1
End If
ReDim mvKeys(mlElements)
Dim lc As Long
For lc = 0 To mlElements
mvKeys(lc) = Chr(65 + lc)
Next lc
mlKeyCount = 0
MoveFirst
End Property
Public Property Get Permutations() As Double
' calculate the possibilities
Dim P As Double
Dim lc As Double
P = 1
For lc = mlElements + 1 To 2 Step -1
P = P * lc
Next
Permutations = P
End Property
Private Sub Class_Initialize()
mlArrayBase = 0
End Sub
Here is a method to display as you were trying but not using a list box (which is slow) but using a virtual window VP
The results display instantly.
1) New project
2) Add picture box called VP
When you run the app press page/down and page/up to scroll through data.
Also set the VP.appearance to flat and the scalemode to pixels
-----------------------sam ple.frm
Option Explicit
Dim mlTextHeight As Long
Dim mlLinesInWindow As Long
Dim mlTopLine As Long
Dim mlTotalLines As Long
Dim MyArray(1 To 5) As String
Private Type udtPagePoint
Positions(1 To 5) As Long
End Type
Dim Pages() As udtPagePoint
Dim Current As udtPagePoint
Dim mlLineHeight As Long
Dim mlLinesInVP As Long
Dim mlPage As Long
Dim mlMaxPages As Long
Dim mbEOF As Boolean
Sub Advance()
' get next number
Dim lc As Long
lc = UBound(MyArray)
Do
Current.Positions(lc) = Current.Positions(lc) + 1
If Current.Positions(lc) <= UBound(MyArray) Then
mbEOF = False
Exit Do
End If
Current.Positions(lc) = 1
lc = lc - 1
If lc < 1 Then
mbEOF = True
Exit Do
End If
Loop
End Sub
Sub DisplayWindow()
If mlPage > UBound(Pages) Then
ReDim Preserve Pages(UBound(Pages) + 100)
End If
If mlPage > mlMaxPages Then
mlMaxPages = mlPage
Pages(mlPage) = Current
mbEOF = False
Else
If mlPage < 0 Then
mlPage = 0
MoveFirst
End If
Current = Pages(mlPage)
mbEOF = False
End If
Dim lc As Long
VP.Cls
Dim lcc As Long
For lc = 0 To mlLinesInVP
VP.CurrentX = 0
VP.CurrentY = lc * mlLineHeight
For lcc = 1 To UBound(Current.Positions)
VP.Print MyArray(Current.Positions( lcc));
Next
Advance
If mbEOF Then
Exit Sub
End If
Next
End Sub
Sub MoveFirst()
Dim lc As Long
For lc = 1 To UBound(MyArray)
Current.Positions(lc) = 1
Next
End Sub
Sub WindowSetup()
mlLineHeight = VP.TextHeight("V") * 1.05
mlLinesInVP = VP.ScaleHeight / mlLineHeight
End Sub
Private Sub Form_Activate()
VP.SetFocus
End Sub
Private Sub Form_Load()
MyArray(1) = "A"
MyArray(2) = "B"
MyArray(3) = "C"
MyArray(4) = "D"
MyArray(5) = "E"
mlPage = 0
mlMaxPages = -1
ReDim Pages(100)
WindowSetup
mlPage = 0
MoveFirst
DisplayWindow
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then Exit Sub
VP.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub VP_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case Is = vbKeyPageUp
mlPage = mlPage - 1
mbEOF = False
DisplayWindow
Case Is = vbKeyPageDown
mlPage = mlPage + 1
DisplayWindow
End Select
End Sub
The results display instantly.
1) New project
2) Add picture box called VP
When you run the app press page/down and page/up to scroll through data.
Also set the VP.appearance to flat and the scalemode to pixels
-----------------------sam
Option Explicit
Dim mlTextHeight As Long
Dim mlLinesInWindow As Long
Dim mlTopLine As Long
Dim mlTotalLines As Long
Dim MyArray(1 To 5) As String
Private Type udtPagePoint
Positions(1 To 5) As Long
End Type
Dim Pages() As udtPagePoint
Dim Current As udtPagePoint
Dim mlLineHeight As Long
Dim mlLinesInVP As Long
Dim mlPage As Long
Dim mlMaxPages As Long
Dim mbEOF As Boolean
Sub Advance()
' get next number
Dim lc As Long
lc = UBound(MyArray)
Do
Current.Positions(lc) = Current.Positions(lc) + 1
If Current.Positions(lc) <= UBound(MyArray) Then
mbEOF = False
Exit Do
End If
Current.Positions(lc) = 1
lc = lc - 1
If lc < 1 Then
mbEOF = True
Exit Do
End If
Loop
End Sub
Sub DisplayWindow()
If mlPage > UBound(Pages) Then
ReDim Preserve Pages(UBound(Pages) + 100)
End If
If mlPage > mlMaxPages Then
mlMaxPages = mlPage
Pages(mlPage) = Current
mbEOF = False
Else
If mlPage < 0 Then
mlPage = 0
MoveFirst
End If
Current = Pages(mlPage)
mbEOF = False
End If
Dim lc As Long
VP.Cls
Dim lcc As Long
For lc = 0 To mlLinesInVP
VP.CurrentX = 0
VP.CurrentY = lc * mlLineHeight
For lcc = 1 To UBound(Current.Positions)
VP.Print MyArray(Current.Positions(
Next
Advance
If mbEOF Then
Exit Sub
End If
Next
End Sub
Sub MoveFirst()
Dim lc As Long
For lc = 1 To UBound(MyArray)
Current.Positions(lc) = 1
Next
End Sub
Sub WindowSetup()
mlLineHeight = VP.TextHeight("V") * 1.05
mlLinesInVP = VP.ScaleHeight / mlLineHeight
End Sub
Private Sub Form_Activate()
VP.SetFocus
End Sub
Private Sub Form_Load()
MyArray(1) = "A"
MyArray(2) = "B"
MyArray(3) = "C"
MyArray(4) = "D"
MyArray(5) = "E"
mlPage = 0
mlMaxPages = -1
ReDim Pages(100)
WindowSetup
mlPage = 0
MoveFirst
DisplayWindow
End Sub
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then Exit Sub
VP.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
Private Sub VP_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case Is = vbKeyPageUp
mlPage = mlPage - 1
mbEOF = False
DisplayWindow
Case Is = vbKeyPageDown
mlPage = mlPage + 1
DisplayWindow
End Select
End Sub
On the form load you need to add
Me.Show
DoEvents
Before
DisplayWindow
Me.Show
DoEvents
Before
DisplayWindow
My code will NOT increase your speed at all.
It was simply intended to show you a different way of generating permutations. Your current method is limited because you are hard coding a series of For...Next loops which cannot be changed programmatically.
The method I demonstrate in my link can generate any length(s) of permutations given the "character set". You would simply initialize a string to the starting sequence and then repeatedly pass it in to the function inside a while loop until the desired string length is exceeded.
So my method is more flexible, but definitely not any faster...
It was simply intended to show you a different way of generating permutations. Your current method is limited because you are hard coding a series of For...Next loops which cannot be changed programmatically.
The method I demonstrate in my link can generate any length(s) of permutations given the "character set". You would simply initialize a string to the starting sequence and then repeatedly pass it in to the function inside a while loop until the desired string length is exceeded.
So my method is more flexible, but definitely not any faster...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
hehe, shouldn't have had the 'please help' at the end (that was a copy of the post).
Anyways, there ya go. You'll notice a huge difference. :D
Anyways, there ya go. You'll notice a huge difference. :D
The listbox never even disappears but about 210% speed increase...
yes, once you put the listbox in the code, I knew exactly what you were talking about, because
I've had exactly the same thing! :) if you want it to 'disappear' temporarily (which might even
be a *little* faster), stick a 'doEvents' after you do the 'visible' statement, i.e.,
listbox1.visible=false
doevents
...
etc
...
listbox1.visible=true
doevents
good luck!
I've had exactly the same thing! :) if you want it to 'disappear' temporarily (which might even
be a *little* faster), stick a 'doEvents' after you do the 'visible' statement, i.e.,
listbox1.visible=false
doevents
...
etc
...
listbox1.visible=true
doevents
good luck!
If you use listview you will have 500% faster
8->
8->
Virtual window would be million% faster as it is instant.
if you are concatenating strings, you might use the stringbuilder class, will be up to 1000% faster