i want to konw which code is more faster.
compare this two code
Dim x As Boolean
Dim y As Boolean
If x = True Then
If y = True Then
Else
End If
Else
If y = True Then
Else
End If
End If
'=============================================
Enum xx
o = 0
x = 1
xy = 2
y = 3
End Enum
Sub Script_validate()
Dim nn As xx
If nn.o Then
ElseIf nn.x Then
ElseIf nn.xy Then
ElseIf nn.y Then
End If
End Sub
which code is faster and which code had low memory usage
Related
I tried all possible solutions and they didn't work. Any help would be appreciated.
Function '' doesn't return a value on all code paths is my error
Public Function Isprime(n2 As Long)
Dim n, i As Integer
Dim b As Boolean
Console.WriteLine("enter a no : \")
n = Console.ReadLine()
i = 2
b = True
While i < n
If n Mod i = 0 Then
b = False
End If
i = i + 1
End While
If b Then
Console.WriteLine("prime no")
Else
Console.WriteLine("not prime no\")
End If
Console.ReadLine()
End Function
Public Function PrimePairs(ByVal n As Long, ByVal n2 As Long) As Integer
Dim count As Integer = 0
Console.ReadLine()
If n Mod 2 = 0 Then
For i = 1 To (n / 2) + 1
n2 = n - i
If Isprime(i) And Isprime(n2) = True Then
count += 1
End If
Next
Else
n2 = n - 2
If Isprime(n2) = True Then
count = +1
End If
End If
Console.WriteLine(count)
Return n
End Function
End Module
You function does not return a value and is quite convoluted. It does I/O and does a prime test at the same time. Separate logic from I/O.
Public Function IsPrime(n As Long) As Boolean
n = Math.Abs(n) ' Allows to consider negative prime numbers
If n < 2 Then ' Disallows -1, 0, 1
Return False
End If
Dim i As Long
i = 2
While i < n ' Note that for n = 2 we don't enter the loop and thus return True.
If n Mod i = 0 Then
Return False
End If
i += 1
End While
Return True
End Function
Also, it is missing a return type. Always work with Option Explicit On for better code quality.
Note that you can return when you hit the first prime factor. There is no point in continuing the loop then.
But there are ways to optimize this. For example we could test the divisibility by 2 separately and then test only odd divisors and it is enough to test divisors up to the square root of n.
Public Function IsPrime(n As Long) As Boolean
n = Math.Abs(n)
If n = 2 Then
Return True
End If
If n < 2 Or n Mod 2 = 0 Then
Return False
End If
Dim i As Long = 3
Dim limit As Long = CLng(Math.Sqrt(n))
While i <= limit
If n Mod i = 0 Then
Return False
End If
i += 2
End While
Return True
End Function
With the following global variables:
Dim SpilleBræt(8, 8) As PictureBox
Dim Position(8, 8) As String
Dim MarkeretFelt(8, 8) As String
Dim FeltFarve As String
Dim x As Integer
Dim y As Integer
Dim AktivMarkering As Boolean = 0
Dim SpilleBrik As String
And this code:
Private Sub PictureBox_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim FeltValg As PictureBox = CType(sender, PictureBox)
If AktivMarkering = 1 Then
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "LightTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "LightTile")
Case "DarkTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "DarkTile")
Case Else
'fjerner markerede
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTile"
Else
FeltFarve = "LightTile"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End Select
Else
'indsætter markering
'x,y i picturebox'ens navn fx ->(SpilBrik44) hvor x=4 og y=4
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTileMarked"
Else
FeltFarve = "LightTileMarked"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
MarkeretFelt(x, k) = FeltFarve
AktivMarkering = 1
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End If
End Sub
I have a problem with the first If statement aktivmarkering=1, goes directly to the 'Else' even though if statements is true.
First time code is run, aktivmarkering is = 0, and therefore it obviously goes to 'Else', but after that one has ben run AktivMarkering is = 1, and first if should be executed. I don't see why not - anyone whos able to help?
Thanks.
I have a spreadsheet/userform combo that takes user input to calculate product pricing/percent tax/and square footage in consideration to output a total cost for flooring in one of the userform's textboxes.
My userform is calculating everything correctly, but I am trying to figure out how to format the output box so that it only displays values up to two digits past the decimal (i.e. $1.00). Currently, it displays up to four digits or more beyond the decimal (as seen in the Total Area, Tax Amount, and Final Price text boxes).
My userform code is as follows (I left out some non-pertinent sections that had to do with opening and closing the userform but everything that has to do with the functioning of it is there):
Public Sub SumTool()
Dim A, B, C, D, E, F As Double
Dim x As Double
Dim finalSum As Double
Dim addUp As Double
Dim BeforePercent As Double
Dim Prcnt As Double
Dim percentALT As Double
Dim percentSum As Double
Dim i As Integer
addUp = 0
finalSum = 0
BeforePercent = 0
x = 0
i = 0
'These are all area measurements
A = 280
B = 118
C = 96
D = 243
E = 38
F = 83
Do While i < 1
'These are checks to see if checkboxes in the userform are True/False and
'correspond to the area measurements above
If LR.Value = True Then
x = x + A
Else
x = x
End If
If BR1.Value = True Then
x = x + B
Else
x = x
End If
If BR2.Value = True Then
x = x + C
Else
x = x
End If
If KT.Value = True Then
x = x + D
Else
x = x
End If
If BA.Value = True Then
x = x + E
Else
x = x
End If
If HALL.Value = True Then
x = x + F
Else
x = x
End If
i = i + 1
Loop
'I have different calculations because the user has the option of
'whether they want to include tax or not. If they do not (first option)
'no special conversions have to take place. If they do, the program has to
'take the entry and convert it from 5 or 10 to 0.05 or 0.10 and then carry
'forward with the rest of the operations
If Me.Y.Value = False Then
Prcnt = 0
addUp = x
finalSum = addUp * Me.ProductPrice.Value
Me.FinalResultsBox.Value = finalSum
Me.SqFtBox.Value = addUp
Me.TaxAmountValue.Value = 0
Else
Prcnt = Me.SalesTaxNumber.Value
addUp = x
percentALT = Prcnt * 0.01
BeforePercent = addUp * Me.ProductPrice.Value
percentSum = percentALT * BeforePercent
finalSum = BeforePercent + percentSum
Me.FinalResultsBox.Value = finalSum
Me.SqFtBox.Value = addUp
Me.TaxAmountValue.Value = percentSum
End If
End Sub
You may try something like this...
Me.FinalResultsBox.Value = Format(finalSum, "$0.00")
the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function
How to make first letter in upper case while pressing tab or space in vb 6.0 ?
My code is as follows
txtFirstName.Text = UCase$(txtFirstName.Text)
but it doesn't change after tab or space
It's just simple just do this in the text box keypress events...
Private sub textbox_keypress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Use the LostFocus event
Private Sub yourTextBox_LostFocus()
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
End With
End Sub
Apply the same logic to the KeyDown event and check if the pressed key is the space key.
Private Sub yourTextBox_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Then
With yourTextBox
'first letter in upper case, the rest, untouched.
.Text = UCase(Mid(.Text, 1, 1)) & Mid(.Text, 2, Len(.Text))
.SelStart = Len(.Text) 'put the cursor at the end of the textbox...
End With
End If
End Sub
StrConv Function
Returns a Variant (String) converted as specified.
Syntax
StrConv(string, conversion, LCID)
The StrConv function syntax has these named arguments:
Part Description
string Required. String expression to be converted.
conversion Required. Integer. The sum of values specifying the type of conversion to perform.
LCID Optional. The LocaleID, if different than the system LocaleID. (The system LocaleID is the default.)
Settings
The conversion argument settings are:
Constant Value Description
vbUpperCase 1 Converts the string to uppercase characters.
vbLowerCase 2 Converts the string to lowercase characters.
vbProperCase 3 Converts the first letter of every word in string to uppercase.
AND THERE IS MORE ...
TO GSERGE
$ means nothing when applied to a function name as opposed to a variable name. VBA uses $ AND B as a suffix to denote similar functionality.
VB6 IS VBA the person who said maybe in VB6 but not in VBA. VB6 program host VBA as their programming language. VB6 on it's own are some app objects and the forms package only - no programming language. It's best to think of VB6 as a VBA host like Office.
If you want to proper case see this WORDBASIC Ver 6 code, (which word 2003 helpfully converted to vba).
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Sub MAIN()
Select Case WordBasic.Int(GetModifer)
Case 0
WordBasic.ChangeCase
Case 1
WordBasic.ChangeCase 4
Case 2
WordBasic.ChangeCase 2
Case 3
ProperCase
Case Else
WordBasic.ChangeCase
End Select
End Sub
Private Sub ProperCase()
Dim F
Dim z
Dim a$
Dim P
F = 1
WordBasic.ChangeCase 2
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Add:=1
z = WordBasic.GetSelEndPos()
WordBasic.CharLeft 1
While WordBasic.GetSelEndPos() < z And Not WordBasic.AtEndOfDocument()
WordBasic.SelectCurWord
a$ = WordBasic.[Selection$]()
P = 0
If LCase(a$) = "a" Then
P = 1
ElseIf LCase(a$) = "an" Then
P = 1
ElseIf LCase(a$) = "as" Then
P = 1
ElseIf LCase(a$) = "at" Then
P = 1
ElseIf LCase(a$) = "be" Then
P = 1
ElseIf LCase(a$) = "by" Then
P = 1
ElseIf LCase(a$) = "in" Then
P = 1
ElseIf LCase(a$) = "is" Then
P = 1
ElseIf LCase(a$) = "of" Then
P = 1
ElseIf LCase(a$) = "on" Then
P = 1
ElseIf LCase(a$) = "or" Then
P = 1
ElseIf LCase(a$) = "to" Then
P = 1
ElseIf LCase(a$) = "and" Then
P = 1
ElseIf LCase(a$) = "are" Then
P = 1
ElseIf LCase(a$) = "for" Then
P = 1
ElseIf LCase(a$) = "the" Then
P = 1
ElseIf LCase(a$) = "from" Then
P = 1
ElseIf LCase(a$) = "what" Then
P = 1
ElseIf LCase(a$) = "with" Then
P = 1
End If
If P = 1 And F = 0 Then WordBasic.Insert LCase(a$)
WordBasic.WordRight 1
F = 0
Wend
WordBasic.WW7_EditGoTo Destination:="SerenityChangeCase"
WordBasic.EditBookmark Name:="SerenityChangeCase", SortBy:=0, Delete:=1
End Sub
Private Function GetModifer()
Dim a
Dim B
Dim c
Dim X
a = GetAsyncKeyState(16)
B = GetAsyncKeyState(17)
c = GetAsyncKeyState(18)
X = 0
If a < 0 Then X = X + 1
If B < 0 Then X = X + 2
If c < 0 Then X = X + 4
GetModifer = X
End Function
OK. Yeah txtFirstName is a good indicator of usage here.. So I'd use (sort of) Title Caps And I'd do it on the Validate event.. So
Private Sub txtFirstName_Validate(Cancel As Boolean)
Dim p As Integer ' i doubt we'll use more than 32K for a name....
Dim mName As String
p = 1
' first off lets trim any leading blanks.. assume NOTHING and make sure its all lower case..
mName = LCase(LTrim(txtFirstName))
Do While p > 0 And p <= Len(txtFirstName) ' start with the first non-blank
Mid(mName, p, 1) = UCase(Mid(mName, p, 1))
p = InStr(p, mName, " ")
If p > 0 And p < Len(mName) Then p = p + 1
Loop
Cancel = False
txtFirstName = mName
End Sub
Works every time, and capitalizes each word.. Didn't add any code to to do TRUE title caps but this is close, and short & easy...