1: Attribute VB_Name = "Module1" 2: 3: Function Add$(nnn1$, nnn2$) 4: n1$ = Trim$(nnn1$): n2$ = Trim$(nnn2$) 5: If InStr(n1$, "-") <> 0 Xor InStr(n2$, "-") <> 0 Then 6: If InStr(n2$, "-") <> 0 Then Add$ = Subt$(Right$(n1$, Len(n1$) - InStr(n1$, "-")), Right$(n2$, Len(n2$) - InStr(n2$, "-"))): Exit Function 7: If InStr(n1$, "-") <> 0 Then Add$ = Subt$(Right$(n2$, Len(n2$) - InStr(n2$, "-")), Right$(n1$, Len(n1$) - InStr(n1$, "-"))): Exit Function 8: End If 9: If InStr(n1$, "-") <> 0 And InStr(n2$, "-") <> 0 Then Neg$ = "-": n1$ = Right$(n1$, Len(n1$) - InStr(n1$, "-")): n2$ = Right$(n2$, Len(n2$) - InStr(n2$, "-")) 10: 11: 12: 13: 14: If InStr(n1$, ".") <> 0 Or InStr(n2$, ".") <> 0 Then 15: If InStr(n1$, ".") = 0 Then n1$ = n1$ + ".0" 16: If InStr(n2$, ".") = 0 Then n2$ = n2$ + ".0" 17: If InStr(n1$, ".") > InStr(n2$, ".") Then n2$ = String$(InStr(n1$, ".") - InStr(n2$, "."), "0") + n2$ Else n1$ = String$(InStr(n2$, ".") - InStr(n1$, "."), "0") + n1$ 18: If Len(n1$) - InStr(n1$, ".") > Len(n2$) - InStr(n2$, ".") Then n2$ = n2$ + String$((Len(n1$) - InStr(n1$, ".")) - (Len(n2$) - InStr(n2$, ".")), "0") Else n1$ = n1$ + String$((Len(n2$) - InStr(n2$, ".")) - (Len(n1$) - InStr(n1$, ".")), "0") 19: Stor = Len(n1$) - InStr(n1$, ".") 20: If InStr(n1$, ".") <> 0 Then n1$ = Left$(n1$, InStr(n1$, ".") - 1) + Right$(n1$, (Len(n1$) - InStr(n1$, "."))) 21: If InStr(n2$, ".") <> 0 Then n2$ = Left$(n2$, InStr(n2$, ".") - 1) + Right$(n2$, (Len(n2$) - InStr(n2$, "."))) 22: Else 23: If Len(n1$) > Len(n2$) Then n2$ = String$(Len(n1$) - Len(n2$), "0") + n2$ Else n1$ = String$(Len(n2$) - Len(n1$), "0") + n1$ 24: End If 25: 26: For q = Len(n1$) To 1 Step -1 27: mx$ = LTrim$(RTrim$(Str$((Val(Mid$(n1$, q, 1)) + Val(Mid$(n2$, q, 1))) + Rmd))) 28: Rmd = Val(Left$(mx$, Len(mx$) - 1)): mx$ = Right$(mx$, 1) 29: cc$ = mx$ + cc$ 30: Next q 31: If Rmd = 0 Then D$ = cc$ Else D$ = LTrim$(RTrim$(Str$(Rmd))) + cc$ 32: If Stor <> 0 Then D$ = Left$(D$, Len(D$) - Stor) + "." + Right$(D$, Stor) 33: Add$ = Neg$ + D$ 34: 35: End Function 36: 37: Function AddComma$(N$) 38: If InStr(N$, ".") = 0 Then dd = Len(N$) Else dd = InStr(N$, ".") - 1 39: For q = dd To 1 Step -1 40: If (dd - q) Mod 3 = 0 And q <> dd Then mm$ = "," + mm$ 41: mm$ = Mid$(N$, q, 1) + mm$ 42: Next q 43: If InStr(N$, ".") <> 0 Then dc$ = "." + Right$(N$, Len(N$) - InStr(N$, ".")) 44: AddComma$ = mm$ + dc$ 45: End Function 46: 47: Function Div$(nnn1$, nnn2$) 48: n1$ = nnn1$: n2$ = nnn2$ 49: If IsGreater(n1$, n2$) = 3 Then Div$ = "1": Exit Function 50: If InStr(n1$, ".") = 0 Then Mrk = Len(n1$) Else Mrk = InStr(n1$, ".") 51: Dim Num$(9) 52: Num$(1) = n2$ 53: For q = 2 To 9 54: Num$(q) = Mul$(n2$, Trim$(Str$(q))) 55: Next q 56: Level = Len(n1$) 57: Do 58: Level = Level - 1 59: c = Len(n1$) - Level: Cl$ = "" 60: Do Until 1 = 2 61: Cl$ = Left$(n1$, c) 62: If IsGreater(n1$, Cl$) = 1 Or IsGreater(n1$, Cl$) = 3 Then Exit Do Else c = c + 1 63: Loop 64: mmx = c 65: Cl$ = Left$(n1$, mmx) 66: For g = 1 To 9 67: If IsGreater(Cl$, Num$(g)) = 2 Then mmz = g - 1: Exit For 68: Next g 69: tt$ = tt$ + Trim$(Str$(mmz)) 70: If Level >= 0 Then Post$ = String$(Level, "0"): pre$ = "" 'ELSE pre$ = "." + STRING$(Level * -1, "0"): Post$ = "" 71: n1$ = RemoveZero$(Subt$(n1$, Num$(mmz) + Post$)) 72: If Level < 0 And n1$ <> "0" Then n1$ = n1$ + "0" 73: 'if Instr(Mrk,tt$,) 74: Loop Until n1$ = "0" Or Stpp 75: tt$ = RemoveZero$(tt$) 76: Debug.Print Mrk 77: If Len(tt$) = Mrk - 1 Then Div$ = tt$ Else Div$ = Left$(tt$, Mrk) + "." + Right$(tt$, Len(tt$) - (Mrk + 1)) 78: End Function 79: 80: Sub Errorr(Msg$) 81: Print "Error:"; Msg$ 82: End Sub 83: 84: Function Fact$(nn$) 85: ff$ = nn$ 86: gg$ = nn$ 87: Do 88: ff$ = RemoveZero$(Subt$(ff$, "1")) 89: gg$ = RemoveZero$(Mul$(gg$, ff$)) 90: Loop Until RemoveZero$(ff$) = "1" 91: Fact$ = RemoveZero$(gg$) 92: End Function 93: 94: Function FindCPUMathErrors() 95: Cls 96: VIEW PRINT 1 TO 24 97: LOCATE 1, 1: Print "CPU"; Tab(36); " ³ "; "VMPU" 98: LOCATE 2, 1: Print String$(36, 196) + "Å" + String$(42, 196); 99: LOCATE 25, 1: Print "Press Any Key to Stop Test"; 100: VIEW PRINT 3 TO 24 101: If 33.1 / 331 <> 0.1 Then ErrErrs = 1: Print 33.1 / 331; Tab(36); " ³ .1" 102: g$ = "-40" 103: inc$ = ".001" 104: Do 105: g$ = Add$(g$, inc$) 106: If IsGreater(Str$(Val(g$) - Val(inc$)), Subt$(g$, inc$)) <> 3 Then ErrErr1 = 1 107: If Val(g$) - Val(inc$) <> Val(Subt$(g$, inc$)) And ErrErr1 = 1 Then Print Val(g$) - Val(inc$); Tab(36); " ³ "; Val(Subt$(g$, inc$)): ErrErrs = ErrErrs + 1 108: 109: If IsGreater(Str$(Val(g$) * Val(inc$)), Mul$(g$, inc$)) <> 3 Then ErrErr2 = 1 110: If Val(g$) * Val(inc$) <> Val(Mul$(g$, inc$)) And ErrErr2 = 1 Then Print Val(g$) * Val(inc$); Tab(36); " ³ "; Val(Mul$(g$, inc$)): ErrErrs = ErrErrs + 1 111: 112: If IsGreater(Str$(Val(g$) + Val(inc$)), Add$(g$, inc$)) <> 3 Then ErrErr3 = 1 113: If Val(g$) + Val(inc$) <> Val(Add$(g$, inc$)) And ErrErr3 = 1 Then Print Val(g$) + Val(inc$); Tab(36); " ³ "; Val(Add$(g$, inc$)): ErrErrs = ErrErrs + 1 114: 115: 116: 'LOCATE CSRLIN, 1: PRINT g$; ", Errors:"; ErrErrs; 117: ErrErr1 = 0: ErrErr2 = 0: ErrErr3 = 0: ErrErr4 = 0: 118: If INKEY$ <> "" Then Print: Exit Do 119: Loop Until g$ = "40" 120: FindCPUMathErrors = ErrErrs 121: X = CSRLIN 122: VIEW PRINT 1 TO 25 123: LOCATE X, 1 124: End Function 125: 126: Function IsGreater(nnn1$, nnn2$) 127: n1$ = nnn1$: n2$ = nnn2$ 128: If InStr(n1$, "-") <> 0 And InStr(n2$, "-") = 0 Then IsGreater = 2: Exit Function 129: If InStr(n2$, "-") <> 0 And InStr(n1$, "-") = 0 Then IsGreater = 1: Exit Function 130: If InStr(n2$, "-") <> 0 And InStr(n1$, "-") <> 0 Then nn1$ = n1$: nn2$ = n2$: n1$ = nn2$: n2$ = nn1$ 131: 132: n1$ = Right$(n1$, Len(n1$) - InStr(n1$, "-")): n2$ = Right$(n2$, Len(n2$) - InStr(n2$, "-")) 133: 134: 135: If InStr(n1$, ".") <> 0 Or InStr(n2$, ".") <> 0 Then 136: If InStr(n1$, ".") = 0 Then n1$ = n1$ + ".0" 137: If InStr(n2$, ".") = 0 Then n2$ = n2$ + ".0" 138: If InStr(n1$, ".") > InStr(n2$, ".") Then n2$ = String$(InStr(n1$, ".") - InStr(n2$, "."), "0") + n2$ Else n1$ = String$(InStr(n2$, ".") - InStr(n1$, "."), "0") + n1$ 139: If Len(n1$) - InStr(n1$, ".") > Len(n2$) - InStr(n2$, ".") Then n2$ = n2$ + String$((Len(n1$) - InStr(n1$, ".")) - (Len(n2$) - InStr(n2$, ".")), "0") Else n1$ = n1$ + String$((Len(n2$) - InStr(n2$, ".")) - (Len(n1$) - InStr(n1$, ".")), "0") 140: Stor = Len(n1$) - InStr(n1$, ".") 141: If InStr(n1$, ".") <> 0 Then n1$ = Left$(n1$, InStr(n1$, ".") - 1) + Right$(n1$, (Len(n1$) - InStr(n1$, "."))) 142: If InStr(n2$, ".") <> 0 Then n2$ = Left$(n2$, InStr(n2$, ".") - 1) + Right$(n2$, (Len(n2$) - InStr(n2$, "."))) 143: Else 144: If Len(n1$) > Len(n2$) Then n2$ = String$(Len(n1$) - Len(n2$), "0") + n2$ Else n1$ = String$(Len(n2$) - Len(n1$), "0") + n1$ 145: End If 146: 147: 148: For q = 1 To Len(n1$) 149: If Val(Mid$(n1$, q, 1)) > Val(Mid$(n2$, q, 1)) Then IsGreater = 1: Exit Function 150: If Val(Mid$(n2$, q, 1)) > Val(Mid$(n1$, q, 1)) Then IsGreater = 2: Exit Function 151: Next q 152: IsGreater = 3 153: End Function 154: 155: Function Mul$(nnn1$, nnn2$) 156: nn1$ = Trim$(nnn1$): nn2$ = Trim$(nnn2$) 157: If nn1$ = "1" Then Mul$ = nn2$: Exit Function 158: If nn2$ = "1" Then Mul$ = nn1$: Exit Function 159: If nn1$ = "-1" Then nn2$ = " " + nn2$: Mid$(nn2$, Val(Switch$(InStr(nn2$, "-") = 0, "1", InStr(nn2$, "-") <> 0, Str$(InStr(nn2$, "-")))), 1) = Switch$(InStr(nn2$, "-") <> 0, " ", InStr(nn2$, "-") = 0, "-"): Mul$ = Trim$(nn2$): Exit Function 160: If nn2$ = "-1" Then nn1$ = " " + nn1$: Mid$(nn1$, Val(Switch$(InStr(nn1$, "-") = 0, "1", InStr(nn1$, "-") <> 0, Str$(InStr(nn1$, "-")))), 1) = Switch$(InStr(nn1$, "-") <> 0, " ", InStr(nn1$, "-") = 0, "-"): Mul$ = Trim$(nn1$): Exit Function 161: 162: 163: If Left$(nn1$, 1) = "-" Xor Left$(nn2$, 1) = "-" Then Neg$ = "-" Else Neg$ = "" 164: 165: If IsGreater(n1$, n2$) = 2 Then nn1$ = n2$: nn2$ = n1$: n1$ = nn1$: n2$ = nn2$ 166: 167: If InStr(n1$, ".") <> 0 Or InStr(n2$, ".") <> 0 Then 168: If InStr(n1$, ".") = 0 Then n1$ = n1$ + ".0" 169: If InStr(n2$, ".") = 0 Then n2$ = n2$ + ".0" 170: If InStr(n1$, ".") > InStr(n2$, ".") Then n2$ = String$(InStr(n1$, ".") - InStr(n2$, "."), "0") + n2$ Else n1$ = String$(InStr(n2$, ".") - InStr(n1$, "."), "0") + n1$ 171: If Len(n1$) - InStr(n1$, ".") > Len(n2$) - InStr(n2$, ".") Then n2$ = n2$ + String$((Len(n1$) - InStr(n1$, ".")) - (Len(n2$) - InStr(n2$, ".")), "0") Else n1$ = n1$ + String$((Len(n2$) - InStr(n2$, ".")) - (Len(n1$) - InStr(n1$, ".")), "0") 172: Stor = Len(n1$) - InStr(n1$, ".") 173: If InStr(n1$, ".") <> 0 Then n1$ = Left$(n1$, InStr(n1$, ".") - 1) + Right$(n1$, (Len(n1$) - InStr(n1$, "."))) 174: If InStr(n2$, ".") <> 0 Then n2$ = Left$(n2$, InStr(n2$, ".") - 1) + Right$(n2$, (Len(n2$) - InStr(n2$, "."))) 175: Else 176: If Len(n1$) > Len(n2$) Then n2$ = String$(Len(n1$) - Len(n2$), "0") + n2$ Else n1$ = String$(Len(n2$) - Len(n1$), "0") + n1$ 177: End If 178: 179: 180: If InStr(nn1$, ".") <> 0 Or InStr(nn2$, ".") <> 0 Then 181: If InStr(nn1$, ".") = 0 Then nn1$ = nn1$ + ".0" 182: If InStr(nn2$, ".") = 0 Then nn2$ = nn2$ + ".0" 183: 184: Stor = (Len(nn1$) - InStr(nn1$, ".")) + (Len(nn2$) - InStr(nn2$, ".")) 185: If InStr(nn1$, ".") <> 0 Then nn1$ = Left$(nn1$, InStr(nn1$, ".") - 1) + Right$(nn1$, (Len(nn1$) - InStr(nn1$, "."))) 186: If InStr(nn2$, ".") <> 0 Then nn2$ = Left$(nn2$, InStr(nn2$, ".") - 1) + Right$(nn2$, (Len(nn2$) - InStr(nn2$, "."))) 187: End If 188: 189: For q1 = Len(nn2$) To 1 Step -1 190: ccc$ = String$(Len(nn2$) - q1, "0") 191: For q2 = Len(nn1$) To 1 Step -1 192: mmm$ = RTrim$(LTrim$(Str$((Val(Mid$(nn1$, q2, 1)) * Val(Mid$(nn2$, q1, 1))) + Rmd))) 193: Rmd = Val(Left$(mmm$, Len(mmm$) - 1)): mmm$ = Right$(mmm$, 1) 194: ccc$ = mmm$ + ccc$ 195: Next q2 196: ccc$ = LTrim$(RTrim$(Str$(Rmd))) + ccc$ 197: tt$ = Add$(tt$, ccc$) 198: Rmd = 0 199: Next q1 200: If Stor <> 0 Then tt$ = Left$(tt$, Len(tt$) - Stor) + "." + Right$(tt$, Stor) 201: 202: Mul$ = Neg$ + tt$ 203: End Function 204: 205: Function Pwr$(n1$, n2$) 206: nz1$ = n1$ 207: nz2$ = n1$ 208: gg$ = n2$ 209: Do 210: nz1$ = RemoveZero$(Mul$(nz1$, nz2$)) 211: gg$ = RemoveZero$(Subt$(gg$, "1")) 212: Loop Until RemoveZero$(gg$) = "1" 213: Pwr$ = RemoveZero$(nz1$) 214: End Function 215: 216: Function RemoveSpace$(t$) 217: For q = 1 To Len(t$) 218: If Mid$(t$, q, 1) = " " Then Else dd$ = dd$ + Mid$(t$, q, 1) 219: Next q 220: RemoveSpace$ = dd$ 221: End Function 222: 223: Function RemoveZero$(n1$) 224: Neg = InStr(n1$, "-") 225: If InStr(n1$, ".") = 0 Then ddd = Len(n1$) Else ddd = InStr(n1$, ".") 226: For q = 1 + Neg To ddd 227: If Mid$(n1$, q, 1) <> "0" Then Exit For 228: Next q 229: If Neg <> 0 Then Nx$ = "-" Else Nx$ = "" 230: If Right$(n1$, Len(n1$) - q + 1) = "" Then Rz$ = "0" Else Rz$ = Right$(n1$, Len(n1$) - q + 1) 231: If InStr(rx$, ".") = 0 Then RemoveZero$ = Nx$ + Rz$: Exit Function 232: For q = Len(Rz$) To InStr(Rz$, ".") Step -1 233: If Mid$(Rz$, q, 1) <> "0" Then Exit For 234: Next q 235: RemoveZero$ = Nx$ + Left$(Rz$, q) 236: 237: End Function 238: 239: Function Solve$(oe$, Meth) 240: e$ = Trim$(RemoveSpace$(oe$)) 241: Do 242: m = InStr(e$, "^") 243: If m = 0 Then m = InStr(e$, "*") 244: If m = 0 Then m = InStr(e$, "/") 245: If m = 0 Then m = InStr(e$, "+"): dd = 12 246: If m = 0 Then m = InStr(e$, "-"): dd = 12 247: If m = 1 And dd = 12 Then m = 0 248: dd = 0 249: If m = 0 Then GoTo Solved 250: For q = 1 To m - 1 251: If LTrim$(RTrim$(Str$(Val(Mid$(e$, m - q, 1))))) <> Mid$(e$, m - q, 1) And Mid$(e$, m - q, 1) <> "." And (q = 1 And Left$(e$, 1) <> "-") Then Exit For 252: Next q 253: For q1 = m - 1 To Len(e$) 254: If LTrim$(RTrim$(Str$(Val(Mid$(e$, m + q1, 1))))) <> Mid$(e$, m + q1, 1) And Mid$(e$, m + q1, 1) <> "." Then Exit For 255: Next q1 256: eq$ = Mid$(e$, m - q + 1, (m - q) - 1 + (q1 + m)) 257: 'MSGBOX e$ + ", " + eq$ + STR$(q) + STR$(q1) 258: 'k$ = (eq$) 259: e$ = Left$(e$, m - q) + SolveSimple$(eq$, Meth) + Mid$(e$, q1 + m, Len(e$)) 260: Solved: 261: Loop Until m = 0 262: Solve$ = e$ 263: End Function 264: 265: Function SolveSimple$(equ$, Meth) 266: If Meth = 0 Then 267: If InStr(equ$, "^") <> 0 Then z1$ = Trim$(Mid$(equ$, 1, InStr(equ$, "^") - 1)): z2$ = Trim$(Mid$(equ$, InStr(equ$, "^") + 1, Len(equ$) - InStr(equ$, "^"))): SolveSimple$ = RemoveZero$(Pwr$(z1$, z2$)): Exit Function 268: If InStr(equ$, "*") <> 0 Then z1$ = Trim$(Mid$(equ$, 1, InStr(equ$, "*") - 1)): z2$ = Trim$(Mid$(equ$, InStr(equ$, "*") + 1, Len(equ$) - InStr(equ$, "*"))): SolveSimple$ = RemoveZero$(Mul$(z1$, z2$)): Exit Function 269: If InStr(equ$, "/") <> 0 Then z1$ = Trim$(Mid$(equ$, 1, InStr(equ$, "/") - 1)): z2$ = Trim$(Mid$(equ$, InStr(equ$, "/") + 1, Len(equ$) - InStr(equ$, "/"))): SolveSimple$ = RemoveZero$(Div$(z1$, z2$)): Exit Function 270: If InStr(equ$, "+") <> 0 Then z1$ = Trim$(Mid$(equ$, 1, InStr(equ$, "+") - 1)): z2$ = Trim$(Mid$(equ$, InStr(equ$, "+") + 1, Len(equ$) - InStr(equ$, "+"))): SolveSimple$ = RemoveZero$(Add$(z1$, z2$)): Exit Function 271: If InStr(equ$, "-") <> 0 Then z1$ = Trim$(Mid$(equ$, 1, InStr(equ$, "-") - 1)): z2$ = Trim$(Mid$(equ$, InStr(equ$, "-") + 1, Len(equ$) - InStr(equ$, "-"))): SolveSimple$ = RemoveZero$(Subt$(z1$, z2$)): Exit Function 272: Else 273: If InStr(equ$, "^") <> 0 Then z1 = Val(Mid$(equ$, 1, InStr(equ$, "^") - 1)): z2 = Val(Mid$(equ$, InStr(equ$, "^") + 1, Len(equ$) - InStr(equ$, "^"))): SolveSimple$ = Trim$(Str$(z1 ^ z2)): Exit Function 274: If InStr(equ$, "*") <> 0 Then z1 = Val(Mid$(equ$, 1, InStr(equ$, "*") - 1)): z2 = Val(Mid$(equ$, InStr(equ$, "*") + 1, Len(equ$) - InStr(equ$, "*"))): SolveSimple$ = Trim$(Str$(z1 * z2)): Exit Function 275: If InStr(equ$, "/") <> 0 Then z1 = Val(Mid$(equ$, 1, InStr(equ$, "/") - 1)): z2 = Val(Mid$(equ$, InStr(equ$, "/") + 1, Len(equ$) - InStr(equ$, "/"))): SolveSimple$ = Trim$(Str$(z1 / z2)): Exit Function 276: If InStr(equ$, "+") <> 0 Then z1 = Val(Mid$(equ$, 1, InStr(equ$, "+") - 1)): z2 = Val(Mid$(equ$, InStr(equ$, "+") + 1, Len(equ$) - InStr(equ$, "+"))): SolveSimple$ = Trim$(Str$(z1 + z2)): Exit Function 277: If InStr(equ$, "-") <> 0 Then z1 = Val(Mid$(equ$, 1, InStr(equ$, "-") - 1)): z2 = Val(Mid$(equ$, InStr(equ$, "-") + 1, Len(equ$) - InStr(equ$, "-"))): SolveSimple$ = Trim$(Str$(z1 - z2)): Exit Function 278: 279: End If 280: End Function 281: 282: Function Subt$(nnn1$, nnn2$) 283: n1$ = nnn1$: n2$ = nnn2$ 284: 285: If (InStr(n2$, "-") <> 0 And InStr(n1$, "-") = 0) Then Subt$ = Add$(n1$, Right$(n2$, Len(n2$) - InStr(n2$, "-"))): Exit Function 286: If (InStr(n1$, "-") <> 0 And InStr(n2$, "-") = 0) Then Subt$ = "-" + Add$(n2$, Right$(n1$, Len(n1$) - InStr(n1$, "-"))): Exit Function 287: If (InStr(n1$, "-") <> 0 And InStr(n2$, "-") <> 0) Then n1$ = Right$(n1$, Len(n2$) - InStr(n2$, "-")): n2$ = Right$(n2$, Len(n2$) - InStr(n2$, "-")): IsAnsNeg = 1 288: 289: If IsGreater(n1$, n2$) = 2 Then Neg = (1 + IsAnsNeg) Mod 2: dd1$ = n1$: dd2$ = n2$: n1$ = dd2$: n2$ = dd1$ 290: 291: If InStr(n1$, "-") <> 0 And InStr(n2$, "-") <> 0 Then Neg = 1: n1$ = Right$(n1$, Len(n1$) - InStr(n1$, "-")): n2$ = Right$(n2$, Len(n2$) - InStr(n2$, "-")): Subt$ = "-" + Add$(n1$, n2$): Exit Function 292: 293: 294: 295: If InStr(n1$, ".") <> 0 Or InStr(n2$, ".") <> 0 Then 296: If InStr(n1$, ".") = 0 Then n1$ = n1$ + ".0" 297: If InStr(n2$, ".") = 0 Then n2$ = n2$ + ".0" 298: If InStr(n1$, ".") > InStr(n2$, ".") Then n2$ = String$(InStr(n1$, ".") - InStr(n2$, "."), "0") + n2$ Else n1$ = String$(InStr(n2$, ".") - InStr(n1$, "."), "0") + n1$ 299: If Len(n1$) - InStr(n1$, ".") > Len(n2$) - InStr(n2$, ".") Then n2$ = n2$ + String$((Len(n1$) - InStr(n1$, ".")) - (Len(n2$) - InStr(n2$, ".")), "0") Else n1$ = n1$ + String$((Len(n2$) - InStr(n2$, ".")) - (Len(n1$) - InStr(n1$, ".")), "0") 300: Stor = Len(n1$) - InStr(n1$, ".") 301: If InStr(n1$, ".") <> 0 Then n1$ = Left$(n1$, InStr(n1$, ".") - 1) + Right$(n1$, (Len(n1$) - InStr(n1$, "."))) 302: If InStr(n2$, ".") <> 0 Then n2$ = Left$(n2$, InStr(n2$, ".") - 1) + Right$(n2$, (Len(n2$) - InStr(n2$, "."))) 303: Else 304: If Len(n1$) > Len(n2$) Then n2$ = String$(Len(n1$) - Len(n2$), "0") + n2$ Else n1$ = String$(Len(n2$) - Len(n1$), "0") + n1$ 305: End If 306: 307: 308: For q = Len(n1$) To 1 Step -1 309: 310: If Val(Mid$(n1$, q, 1)) < Val(Mid$(n2$, q, 1)) Then 311: Num1 = Val(Mid$(n1$, q, 1)) + 10 312: l = 0 313: Do 314: l = l + 1 315: Br$ = Mid$(n1$, q - l, 1) 316: If Br$ = "0" Then Mid$(n1$, q - l, 1) = "9" 317: Loop Until Br$ <> "0" 318: Mid$(n1$, q - l, 1) = RTrim$(LTrim$(Str$(Val(Mid$(n1$, q - l, 1)) - 1))) 319: Else 320: Num1 = Val(Mid$(n1$, q, 1)) 321: End If 322: sc = Num1 - Val(Mid$(n2$, q, 1)) 323: cc$ = Trim$(Str$(sc)) + cc$ 324: Next q 325: If Neg = 1 Then cc$ = "-" + cc$ 326: If Stor <> 0 Then cc$ = Left$(cc$, Len(cc$) - Stor) + "." + Right$(cc$, Stor) 327: 328: Subt$ = cc$ 329: 330: End Function 331: 332: Function Switch$(tof1, r1$, tof2, r2$) 333: If tof1 = -1 Then Switch$ = r1$ 334: If tof2 = -1 Then Switch$ = r2$ 335: End Function 336: 337: Function Trim$(t$) 338: Trim$ = LTrim$(RTrim$(t$)) 339: End Function 340: math.bas VB4 Arbitrary Precision Math Routines |