خطاي overflow در vb هنگام ضرب

[sahhamed]

سلام دوستان. من يه مشكلي دارم. موقعي كه دو تا عدد رو ضرب ميكنم (مثلا 22 * 1500) خطاي overflow مياد. نميدونم چطور بايد حلش كنم. اگه كسي ميتونه كمكم كنه.:ناراحت:

[alitavakoli]

قسمتی از کد رو قرار بدین:
حتما بعد از ضرب شدن داخل متغیری میریزید که رنجش از محدوده عدد ضرب شده کمتره

[SlowCode]

بايد يكيش رو به long يا يه متغير با گنجايش بزرگتر تبديل كني، مثلا:
MsgBox CLng(1500) * 22

[sahhamed]

اين كد منه: msgbox 22 * 1500
مرسي. مشكلم حل شد. بايد حتما عدد تو يه متغير باشه و همچنين متغيير از نوع Single باشه

[sahhamed]

بايد يكيش رو به long يا يه متغير با گنجايش بزرگتر تبديل كني، مثلا:
MsgBox CLng(1500) * 22
مرسي از راهنمايتون. long هم بعضي وقتها جواب نميده

[SlowCode]

بايد حتما عدد تو يه متغير باشه
نه اينطور نيست، برات يه مثال نقض زدم.

مرسي از راهنمايتون. long هم بعضي وقتها جواب نميده
جواب ميده ولي بايد دقت داشته باشين كه فقط اعداد صحيح رو ذخيره ميكنه و اگه اعشار داشته باشه حذف ميشه پس بهتره از single يا اگه بزرگتر باشه از Double استفاده كني.

[m.4.r.m]

Dim i, j As Long
i = 1500
j = 1500
Text1.Text = i * j

[m.4.r.m]

اینم برنامه ضرب 999999999999999999999999999 در 999999999999999999999999999999999999 :

ماژول :

Option Explicit
'************************************************* *****************
' Extra Long Integer Mathematics
'
' Programmer: Eric L. Truitte
' Contact Info: etruitte@programmer.net
' Date Created: April 3, 2003
' Purpose:
' Functions to handle mathmatics too large for
' conventional variables and operations.
'
' Copyright notice:
' This code is subject to the GNU General Public License.
' If you make changes, add a Revision note.
' This code is Open Source and should remain so.
'
'************************************************* *****************
' Revision Date: April 5, 2003
' Programmer: Eric L. Truitte
' Details:
' Addition and Multiplication tested and finallized
' Update comments
'
' Revision Date: February 19, 2005
' Programmer: Eric L. Truitte
' Details:
' Finallized Subtraction and Division
' Updated comments
'
'************************************************* *****************
'Notes:
'
'THERE IS CURRENTLY VERY LITTLE FAULT TOLERANCE IN THE FUNCTIONS
'entering a non-numeric character will cause errors. If you intend to use these,
'make sure what you pass in is just a string of integers.
'
'To do list:
' Decimals
' Negatives
' Multi-string length numbers
'
'What is the largest number that can be handled at this point?
' A String can hold roughly the largest size of a Long value in characters.
' That is the number of potential digits you can have in a number.
'
'I will be working on a decimal handling, possitive/negative, and arrays of strings
'containing segments of an Extra Long Integer. I hope if you have need of such
'capacity of numbers that you have a system that can adequitely handle both
'system overhead and processor side-effects from overclocking for an extended
'period of time.
'
'************************************************* *****************

Public STOPNOW As Boolean 'This is a sentinel variable used in the demo form

Public Function IntAddition(ByVal FirstNum As String, ByVal SecondNum As String) As String
Dim a As Long, DifLen As Long, TempStr As String, TempNum As Integer
Dim Num1 As String, Num2 As String, TempNum1 As Integer, TempNum2 As Integer
Dim CarryOver As Integer, LeftOvers As Long

'Setup the numbers so that they are easier to handle.
'I originally had about 10 nested if statements that this block
'of code simplifies Dramatically.
If Len(FirstNum) >= Len(SecondNum) Then
Num1 = FirstNum
Num2 = SecondNum
Else
Num2 = FirstNum
Num1 = SecondNum
End If

'Just setup some of the variables that need an initial value
DifLen = Len(Num1) - Len(Num2)
CarryOver = 0
LeftOvers = DifLen

'Ok, now for the real math. Looping from the end of the numbers
'just like our preschool teachers taught us, we add numbers that
'line up in the 'places' (I.E. ones, tens, hundreds, thousands, etc)
For a = Len(Num2) To 1 Step -1
TempNum1 = Int(Mid(Num1, a + DifLen, 1))
TempNum2 = Int(Mid(Num2, a, 1))
TempNum = TempNum1 + TempNum2 + CarryOver
CarryOver = TempNum \ 10
TempStr = (TempNum - (CarryOver * 10)) & TempStr
DoEvents
If STOPNOW = True Then GoTo StopAdd
Next a

'What do we do if there is a 1 or a 2 that carries over outside the
'numbers that line up in the places, well, we do the following block of
'code. The do loop is used incase we get a situation like this:
'
' 199999 When you add 1 to a set of nines it continues to
' _+___1 Carry over until it hits the first digit
' 200000
Do Until CarryOver = 0 Or LeftOvers = 0
TempNum = Int(Mid(Num1, LeftOvers, 1)) + CarryOver
CarryOver = TempNum \ 10
TempStr = (TempNum - (CarryOver * 10)) & TempStr
LeftOvers = LeftOvers - 1
Loop

'Since there are two possible ways of exiting the Loop above, we need
'to test and apply the other variable and its associated values in the following
'two if statements.

'Handle a possible carryover that will drop off the front end creating a new place.
If CarryOver > 0 Then TempStr = CarryOver & TempStr

'add any of the numbers that are remaining on the left side of the longer string
If LeftOvers > 0 Then TempStr = Left(Num1, LeftOvers) & TempStr

'and return the value
StopAdd:
IntAddition = TrimZeros(TempStr)
End Function

Public Function IntMultiply(ByVal FirstNum As String, ByVal SecondNum As String) As String
Dim ZeroStr As String
Dim a As Long, b As Long, Multiplier1 As Integer, Multiplier2 As Integer
Dim Num As Integer, CarryOver As Integer, TempStr As String, TallyStr As String

'THIS FUNCTION IS COMPLETE AND WORKS

'This function can handle two extra longs. It cycles through
'the firstnum one digit at a time from secondnum.
'this function works on the distrubution Principle of Multiplication:
' 9999 * 222 = (9999 * 2) + (9999 * 20) + (9999 * 200)
'
'The zero's are concatinated on after the multiplication takes place.
'
'This function is dependent on the IntAddition function above.

For a = Len(FirstNum) To 1 Step -1
'setup variables for this loop of multiplication
TempStr = ""
CarryOver = 0
Multiplier1 = Mid(FirstNum, a, 1)

'Multiply one digit at a time from right to left
For b = Len(SecondNum) To 1 Step -1
Multiplier2 = Mid(SecondNum, b, 1)

Num = (Multiplier1 * Multiplier2) + CarryOver
CarryOver = Num \ 10
TempStr = (Num - (CarryOver * 10)) & TempStr
Next b

'Check to see if the multiplication added a new digit
If CarryOver > 0 Then TempStr = CarryOver & TempStr

'Add the zeros
TempStr = TempStr & ZeroStr
TallyStr = IntAddition(TempStr, TallyStr)
ZeroStr = ZeroStr & "0"

DoEvents

'sentinel
If STOPNOW = True Then GoTo StopMultiply
Next a

StopMultiply:
IntMultiply = TrimZeros(TallyStr)
End Function

Public Function TrimZeros(ByVal Num As String) As String
Dim a As Long, TempStr As String
For a = 1 To Len(Num)
If Mid(Num, a, 1) <> 0 Then GoTo YuckFu
Next a
TrimZeros = "0"
Exit Function
YuckFu:
TrimZeros = Mid(Num, a, Len(Num) - a + 1)
End Function

Public Function IntSubtract(ByVal FirstNum As String, ByVal SecondNum As String) As String
'***
'DO NOT change the integers to bytes, there are negative values in this function
'***
Dim Num1 As String, Num2 As String, a As Long, Neg As Boolean, DifLen As Long
Dim TempStr As String, TempNum1 As Integer, TempNum2 As Integer
Dim TempNum As Integer, Barrow As Byte

'This function operates on a theory known as Two-Compliment.
'If you want to know more, look for it at www.mathforum.com
'This function works great now

'This block of code arranges the numbers into the Num1 and Num2 based on
'which number is larger. This prevents a great number of errors if the numbers
'dont line up, or if the larger number is taken from the smaller number.
If Len(FirstNum) > Len(SecondNum) Then
Num1 = FirstNum
Num2 = SecondNum
Neg = False
ElseIf Len(FirstNum) < Len(SecondNum) Then
Num1 = SecondNum
Num2 = FirstNum
Neg = True
Else

'In the case that the strings are of equal length we have this pretty little
'set of code to find which number has the first larger digit.
For a = 1 To Len(FirstNum)
If Int(Mid(FirstNum, a, 1)) > Int(Mid(SecondNum, a, 1)) Then
Num1 = FirstNum
Num2 = SecondNum
Neg = False
GoTo ContinSubtraction

ElseIf Int(Mid(FirstNum, a, 1)) < Int(Mid(SecondNum, a, 1)) Then
Num1 = SecondNum
Num2 = FirstNum
Neg = True
GoTo ContinSubtraction
End If

DoEvents

'sentinel
If STOPNOW = True Then GoTo ExitFunction
Next a

'In the case that no larger digit is found, then guess what, its a perfect
'subtraction, so we don't need to do the function, just assign a 0 outside the end.
GoTo ExitFunction
End If

ContinSubtraction:

'If we have a difference in length then ajust with 0's that will not affect the calculations.
'This allows us to get all the digits into the final out number.
DifLen = Len(Num1) - Len(Num2)
Num2 = String(DifLen, "0") & Num2
Barrow = 0

'lets do some math
For a = Len(Num2) To 1 Step -1

'Pick out the individual digit from each number
TempNum1 = Int(Mid(Num1, a, 1)) - Barrow
TempNum2 = Int(Mid(Num2, a, 1))
Barrow = 0

'Perform single digit subraction using the Two Compliment theory
If TempNum1 >= TempNum2 Then
TempNum = TempNum1 - TempNum2

ElseIf TempNum1 < TempNum2 Then
TempNum = (TempNum1 + 10) - TempNum2
Barrow = 1
End If

'Assign new digit to the final string.
TempStr = CStr(TempNum) & TempStr

DoEvents

'sentinel
If STOPNOW = True Then GoTo ExitFunction
Next a

'now, since we are subtracting, we need to determine if the number being returned is a negative.
'Just to note, the Trim is to remove unneccsary zero's at the head(left) of the return number.
If Neg = True Then
IntSubtract = "-" & TrimZeros(Trim(TempStr))
Else
IntSubtract = TrimZeros(Trim(TempStr))
End If

Exit Function
ExitFunction:
IntSubtract = 0
End Function

Public Function IntDivide(ByVal FirstNum As String, ByVal SecondNum As String) As String
'Before we even alocate memory for variables, test for some very important error values
If Len(FirstNum) < Len(SecondNum) Or InStr(1, IntSubtract(FirstNum, SecondNum), "-") > 0 Then
MsgBox "Fault: Extra Long Division does not support dividing a shorter number by a longer number, as this requires decimals which are not currently handled."

ElseIf TrimZeros(SecondNum) = "" Then
MsgBox "Fault: Cannot divide by Zero."

ElseIf TrimZeros(SecondNum) = "" Then
GoTo EndFunc

Else
GoTo continDivide
End If

GoTo ExitDivide

'After passing the error checking, lets get started with some division
continDivide:

Dim Num1 As String, DivTotal As String, DivMult As String
Dim DifLen As Long, DivSub As String, TempNum As String

'Initiallize values
Num1 = FirstNum
DivTotal = "0"
DifLen = (Len(Num1) - Len(SecondNum))
DivMult = String(DifLen, "0")
DivSub = SecondNum & DivMult

'Lets do some division
Do Until (Len(Num1) < Len(SecondNum) Or Num1 = "0" Or (InStr(1, IntSubtract(Num1, SecondNum), "-") > 0 And DivMult = "")) Or STOPNOW = True

'The way this division works is it subtracts values from the divided number
'until no more can be subtracted. This sets up a the largest possible number
'that can be subtracted from the number so that you remove larger chucks of
'Numbers at a time and waste less CPU Cycles doing it.
If DifLen >= 0 Then DivMult = String(DifLen, "0")
DivSub = SecondNum & DivMult

If InStr(1, IntSubtract(Num1, DivSub), "-") > 0 Then
If DifLen > 0 Then
DivMult = String(DifLen - 1, "0")
DivSub = SecondNum & DivMult
Else
Exit Do
End If
End If

'Perform the accually math. DivTotal adds up how many times the original
'number has been subtracted from the divided number. Num1 is the working
'number.
DivTotal = IntAddition(DivTotal, "1" & DivMult)
Num1 = IntSubtract(Num1, DivSub)
DifLen = Len(Num1) - Len(SecondNum)

DoEvents

'sentinel
If STOPNOW = True Then GoTo ExitDivide
Loop

'Since there are no decimals, we return return the devide results with a remainder.
IntDivide = DivTotal & "r" & Num1

EndFunc:
Exit Function
ExitDivide:
IntDivide = "NaN"
End Function


اینم کد جمع - تفریق - ضرب و تقسیم

Private Sub Command1_Click()
STOPNOW = False
Text3.Text = IntAddition(Text1.Text, Text2.Text)
End Sub

Private Sub Command2_Click()
STOPNOW = False
Text3.Text = IntSubtract(Text1.Text, Text2.Text)
End Sub

Private Sub Command3_Click()
STOPNOW = False
Text3.Text = IntMultiply(Text1.Text, Text2.Text)
End Sub

Private Sub Command4_Click()
STOPNOW = False
Text3.Text = IntDivide(Text1.Text, Text2.Text) & vbCrLf
End Sub