5750895 [rkeene@sledge /home/rkeene/devel/archive/visualbasic4.0]$ cat -n vmpu.bas
   1: DECLARE FUNCTION Add$ (nnn1$, nnn2$)
   2: DECLARE FUNCTION AddComma$ (N$)
   3: DECLARE FUNCTION Div$ (nnn1$, nnn2$)
   4: DECLARE FUNCTION Fact$ (nn$)
   5: DECLARE FUNCTION IsGreater! (nnn1$, nnn2$)
   6: DECLARE FUNCTION Mul$ (nnn1$, nnn2$)
   7: DECLARE FUNCTION Pwr$ (n1$, n2$)
   8: DECLARE FUNCTION RemoveSpace$ (t$)
   9: DECLARE FUNCTION RemoveZero$ (n1$)
  10: DECLARE FUNCTION Solve$ (oe$, Meth!)
  11: DECLARE FUNCTION SolveSimple$ (equ$, Meth!)
  12: DECLARE FUNCTION Subt$ (nnn1$, nnn2$)
  13: Attribute VB
  14: 
  15: FUNCTION Add$ (nnn1$, nnn2$)
  16: n1$ = Trim$(nnn1$): n2$ = Trim$(nnn2$)
  17: IF INSTR(n1$, "-") <> 0 XOR INSTR(n2$, "-") <> 0 THEN
  18: IF INSTR(n2$, "-") <> 0 THEN Add$ = Subt$(RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")), RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))): EXIT FUNCTION
  19: IF INSTR(n1$, "-") <> 0 THEN Add$ = Subt$(RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-")), RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-"))): EXIT FUNCTION
  20: END IF
  21: IF INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") <> 0 THEN Neg$ = "-": n1$ = RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))
  22: 
  23: 
  24: 
  25: 
  26: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
  27: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
  28: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
  29: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
  30: 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")
  31: Stor = LEN(n1$) - INSTR(n1$, ".")
  32: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
  33: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
  34: ELSE
  35: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
  36: END IF
  37: 
  38: FOR q = LEN(n1$) TO 1 STEP -1
  39: mx$ = LTRIM$(RTRIM$(STR$((VAL(MID$(n1$, q, 1)) + VAL(MID$(n2$, q, 1))) + Rmd)))
  40: Rmd = VAL(LEFT$(mx$, LEN(mx$) - 1)): mx$ = RIGHT$(mx$, 1)
  41: cc$ = mx$ + cc$
  42: NEXT q
  43: IF Rmd = 0 THEN D$ = cc$ ELSE D$ = LTRIM$(RTRIM$(STR$(Rmd))) + cc$
  44: IF Stor <> 0 THEN D$ = LEFT$(D$, LEN(D$) - Stor) + "." + RIGHT$(D$, Stor)
  45: Add$ = Neg$ + D$
  46: 
  47: END FUNCTION
  48: 
  49: FUNCTION AddComma$ (N$)
  50: IF INSTR(N$, ".") = 0 THEN dd = LEN(N$) ELSE dd = INSTR(N$, ".") - 1
  51: FOR q = dd TO 1 STEP -1
  52: IF (dd - q) MOD 3 = 0 AND q <> dd THEN mm$ = "," + mm$
  53: mm$ = MID$(N$, q, 1) + mm$
  54: NEXT q
  55: IF INSTR(N$, ".") <> 0 THEN dc$ = "." + RIGHT$(N$, LEN(N$) - INSTR(N$, "."))
  56: AddComma$ = mm$ + dc$
  57: END FUNCTION
  58: 
  59: FUNCTION Div$ (nnn1$, nnn2$)
  60: n1$ = nnn1$: n2$ = nnn2$
  61: IF IsGreater(n1$, n2$) = 3 THEN Div$ = "1": EXIT FUNCTION
  62: IF INSTR(n1$, ".") = 0 THEN Mrk = LEN(n1$) ELSE Mrk = INSTR(n1$, ".")
  63: DIM Num$(9)
  64: Num$(1) = n2$
  65: FOR q = 2 TO 9
  66:         Num$(q) = Mul$(n2$, Trim$(STR$(q)))
  67: NEXT q
  68: Level = LEN(n1$)
  69: DO
  70:         Level = Level - 1
  71:         c = LEN(n1$) - Level: Cl$ = ""
  72:         DO UNTIL 1 = 2
  73:                 Cl$ = LEFT$(n1$, c)
  74:                 IF IsGreater(n1$, Cl$) = 1 OR IsGreater(n1$, Cl$) = 3 THEN EXIT DO ELSE c = c + 1
  75:         LOOP
  76:         mmx = c
  77:         Cl$ = LEFT$(n1$, mmx)
  78:         FOR g = 1 TO 9
  79:                 IF IsGreater(Cl$, Num$(g)) = 2 THEN mmz = g - 1: EXIT FOR
  80:         NEXT g
  81:         tt$ = tt$ + Trim$(STR$(mmz))
  82:         IF Level >= 0 THEN Post$ = STRING$(Level, "0"): pre$ = "" 'ELSE pre$ = "." + STRING$(Level * -1, "0"): Post$ = ""
  83:         n1$ = RemoveZero$(Subt$(n1$, Num$(mmz) + Post$))
  84: IF Level < 0 AND n1$ <> "0" THEN n1$ = n1$ + "0"
  85: 'if Instr(Mrk,tt$,)
  86: LOOP UNTIL n1$ = "0" OR Stpp
  87: tt$ = RemoveZero$(tt$)
  88: Debug.Print Mrk
  89: IF LEN(tt$) = Mrk - 1 THEN Div$ = tt$ ELSE Div$ = LEFT$(tt$, Mrk) + "." + RIGHT$(tt$, LEN(tt$) - (Mrk + 1))
  90: END FUNCTION
  91: 
  92: FUNCTION Fact$ (nn$)
  93: ff$ = nn$
  94: gg$ = nn$
  95: DO
  96: ff$ = RemoveZero$(Subt$(ff$, "1"))
  97: gg$ = RemoveZero$(Mul$(gg$, ff$))
  98: LOOP UNTIL RemoveZero$(ff$) = "1"
  99: Fact$ = RemoveZero$(gg$)
 100: END FUNCTION
 101: 
 102: FUNCTION IsGreater (nnn1$, nnn2$)
 103: n1$ = nnn1$: n2$ = nnn2$
 104: IF INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") = 0 THEN IsGreater = 2: EXIT FUNCTION
 105: IF INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") = 0 THEN IsGreater = 1: EXIT FUNCTION
 106: IF INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") <> 0 THEN nn1$ = n1$: nn2$ = n2$: n1$ = nn2$: n2$ = nn1$
 107: 
 108: n1$ = RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-")): n2$ = RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))
 109: 
 110: 
 111: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 112: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 113: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 114: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 115: 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")
 116: Stor = LEN(n1$) - INSTR(n1$, ".")
 117: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 118: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 119: ELSE
 120: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 121: END IF
 122: 
 123: 
 124: FOR q = 1 TO LEN(n1$)
 125: IF VAL(MID$(n1$, q, 1)) > VAL(MID$(n2$, q, 1)) THEN IsGreater = 1: EXIT FUNCTION
 126: IF VAL(MID$(n2$, q, 1)) > VAL(MID$(n1$, q, 1)) THEN IsGreater = 2: EXIT FUNCTION
 127: NEXT q
 128: IsGreater = 3
 129: END FUNCTION
 130: 
 131: FUNCTION Mul$ (nnn1$, nnn2$)
 132: nn1$ = Trim$(nnn1$): nn2$ = Trim$(nnn2$)
 133: IF nn1$ = "1" THEN Mul$ = nn2$: EXIT FUNCTION
 134: IF nn2$ = "1" THEN Mul$ = nn1$: EXIT FUNCTION
 135: 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
 136: 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
 137: 
 138: 
 139: IF LEFT$(nn1$, 1) = "-" XOR LEFT$(nn2$, 1) = "-" THEN Neg$ = "-" ELSE Neg$ = ""
 140: 
 141: IF IsGreater(n1$, n2$) = 2 THEN nn1$ = n2$: nn2$ = n1$: n1$ = nn1$: n2$ = nn2$
 142: 
 143: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 144: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 145: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 146: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 147: 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")
 148: Stor = LEN(n1$) - INSTR(n1$, ".")
 149: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 150: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 151: ELSE
 152: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 153: END IF
 154: 
 155: 
 156: IF INSTR(nn1$, ".") <> 0 OR INSTR(nn2$, ".") <> 0 THEN
 157: IF INSTR(nn1$, ".") = 0 THEN nn1$ = nn1$ + ".0"
 158: IF INSTR(nn2$, ".") = 0 THEN nn2$ = nn2$ + ".0"
 159: 
 160: Stor = (LEN(nn1$) - INSTR(nn1$, ".")) + (LEN(nn2$) - INSTR(nn2$, "."))
 161: IF INSTR(nn1$, ".") <> 0 THEN nn1$ = LEFT$(nn1$, INSTR(nn1$, ".") - 1) + RIGHT$(nn1$, (LEN(nn1$) - INSTR(nn1$, ".")))
 162: IF INSTR(nn2$, ".") <> 0 THEN nn2$ = LEFT$(nn2$, INSTR(nn2$, ".") - 1) + RIGHT$(nn2$, (LEN(nn2$) - INSTR(nn2$, ".")))
 163: END IF
 164: 
 165: FOR q1 = LEN(nn2$) TO 1 STEP -1
 166: ccc$ = STRING$(LEN(nn2$) - q1, "0")
 167: FOR q2 = LEN(nn1$) TO 1 STEP -1
 168: mmm$ = RTRIM$(LTRIM$(STR$((VAL(MID$(nn1$, q2, 1)) * VAL(MID$(nn2$, q1, 1))) + Rmd)))
 169: Rmd = VAL(LEFT$(mmm$, LEN(mmm$) - 1)): mmm$ = RIGHT$(mmm$, 1)
 170: ccc$ = mmm$ + ccc$
 171: NEXT q2
 172: ccc$ = LTRIM$(RTRIM$(STR$(Rmd))) + ccc$
 173: tt$ = Add$(tt$, ccc$)
 174: Rmd = 0
 175: NEXT q1
 176: 
 177: IF (LEN(tt$) - Stor) < 0 THEN tt$ = STRING$((LEN(tt$) - Stor) * -1, "0") + tt$
 178: IF Stor > 0 THEN tt$ = LEFT$(tt$, LEN(tt$) - Stor) + "." + RIGHT$(tt$, Stor)
 179: 
 180: Mul$ = Neg$ + tt$
 181: END FUNCTION
 182: 
 183: FUNCTION Pwr$ (n1$, n2$)
 184: nz1$ = n1$
 185: nz2$ = n1$
 186: gg$ = n2$
 187: DO
 188: nz1$ = RemoveZero$(Mul$(nz1$, nz2$))
 189: gg$ = RemoveZero$(Subt$(gg$, "1"))
 190: LOOP UNTIL RemoveZero$(gg$) = "1"
 191: Pwr$ = RemoveZero$(nz1$)
 192: END FUNCTION
 193: 
 194: FUNCTION RemoveSpace$ (t$)
 195: FOR q = 1 TO LEN(t$)
 196: IF MID$(t$, q, 1) = " " THEN  ELSE dd$ = dd$ + MID$(t$, q, 1)
 197: NEXT q
 198: RemoveSpace$ = dd$
 199: END FUNCTION
 200: 
 201: FUNCTION RemoveZero$ (n1$)
 202: Neg = INSTR(n1$, "-")
 203: IF INSTR(n1$, ".") = 0 THEN ddd = LEN(n1$) ELSE ddd = INSTR(n1$, ".")
 204: FOR q = 1 + Neg TO ddd
 205: IF MID$(n1$, q, 1) <> "0" THEN EXIT FOR
 206: NEXT q
 207: IF Neg <> 0 THEN Nx$ = "-" ELSE Nx$ = ""
 208: IF RIGHT$(n1$, LEN(n1$) - q + 1) = "" THEN Rz$ = "0" ELSE Rz$ = RIGHT$(n1$, LEN(n1$) - q + 1)
 209: IF INSTR(Rz$, ".") = 1 THEN Rz$ = "0" + Rz$
 210: IF INSTR(Rz$, ".") = 0 THEN RemoveZero$ = Nx$ + Rz$: EXIT FUNCTION
 211: FOR q = LEN(Rz$) TO INSTR(Rz$, ".") STEP -1
 212: IF MID$(Rz$, q, 1) <> "0" THEN EXIT FOR
 213: NEXT q
 214: RemoveZero$ = Nx$ + LEFT$(Rz$, q)
 215: 
 216: END FUNCTION
 217: 
 218: FUNCTION Solve$ (oe$, Meth)
 219: e$ = Trim$(RemoveSpace$(oe$))
 220: DO
 221: m = INSTR(e$, "^")
 222: IF m = 0 THEN m = INSTR(e$, "*")
 223: IF m = 0 THEN m = INSTR(e$, "/")
 224: IF m = 0 THEN m = INSTR(e$, "+"): dd = 12
 225: IF m = 0 THEN m = INSTR(e$, "-"): dd = 12
 226: IF m = 1 AND dd = 12 THEN m = 0
 227: dd = 0
 228: IF m = 0 THEN GOTO Solved
 229: FOR q = 1 TO m - 1
 230: 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
 231: NEXT q
 232: FOR q1 = m - 1 TO LEN(e$)
 233: IF LTRIM$(RTRIM$(STR$(VAL(MID$(e$, m + q1, 1))))) <> MID$(e$, m + q1, 1) AND MID$(e$, m + q1, 1) <> "." THEN EXIT FOR
 234: NEXT q1
 235: eq$ = MID$(e$, m - q + 1, (m - q) - 1 + (q1 + m))
 236: 'MSGBOX e$ + ", " + eq$ + STR$(q) + STR$(q1)
 237: 'k$ = (eq$)
 238: e$ = LEFT$(e$, m - q) + SolveSimple$(eq$, Meth) + MID$(e$, q1 + m, LEN(e$))
 239: Solved:
 240: LOOP UNTIL m = 0
 241: Solve$ = e$
 242: END FUNCTION
 243: 
 244: FUNCTION SolveSimple$ (equ$, Meth)
 245: IF Meth = 0 THEN
 246: 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
 247: 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
 248: 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
 249: 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
 250: 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
 251: ELSE
 252: 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
 253: 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
 254: 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
 255: 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
 256: 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
 257: 
 258: END IF
 259: END FUNCTION
 260: 
 261: FUNCTION Subt$ (nnn1$, nnn2$)
 262: n1$ = nnn1$: n2$ = nnn2$
 263: 
 264: IF (INSTR(n2$, "-") <> 0 AND INSTR(n1$, "-") = 0) THEN Subt$ = Add$(n1$, RIGHT$(n2$, LEN(n2$) - INSTR(n2$, "-"))): EXIT FUNCTION
 265: IF (INSTR(n1$, "-") <> 0 AND INSTR(n2$, "-") = 0) THEN Subt$ = "-" + Add$(n2$, RIGHT$(n1$, LEN(n1$) - INSTR(n1$, "-"))): EXIT FUNCTION
 266: 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
 267: 
 268: IF IsGreater(n1$, n2$) = 2 THEN Neg = (1 + IsAnsNeg) MOD 2: dd1$ = n1$: dd2$ = n2$: n1$ = dd2$: n2$ = dd1$
 269: 
 270: 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
 271: 
 272: 
 273: 
 274: IF INSTR(n1$, ".") <> 0 OR INSTR(n2$, ".") <> 0 THEN
 275: IF INSTR(n1$, ".") = 0 THEN n1$ = n1$ + ".0"
 276: IF INSTR(n2$, ".") = 0 THEN n2$ = n2$ + ".0"
 277: IF INSTR(n1$, ".") > INSTR(n2$, ".") THEN n2$ = STRING$(INSTR(n1$, ".") - INSTR(n2$, "."), "0") + n2$ ELSE n1$ = STRING$(INSTR(n2$, ".") - INSTR(n1$, "."), "0") + n1$
 278: 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")
 279: Stor = LEN(n1$) - INSTR(n1$, ".")
 280: IF INSTR(n1$, ".") <> 0 THEN n1$ = LEFT$(n1$, INSTR(n1$, ".") - 1) + RIGHT$(n1$, (LEN(n1$) - INSTR(n1$, ".")))
 281: IF INSTR(n2$, ".") <> 0 THEN n2$ = LEFT$(n2$, INSTR(n2$, ".") - 1) + RIGHT$(n2$, (LEN(n2$) - INSTR(n2$, ".")))
 282: ELSE
 283: IF LEN(n1$) > LEN(n2$) THEN n2$ = STRING$(LEN(n1$) - LEN(n2$), "0") + n2$ ELSE n1$ = STRING$(LEN(n2$) - LEN(n1$), "0") + n1$
 284: END IF
 285: 
 286: 
 287: FOR q = LEN(n1$) TO 1 STEP -1
 288: 
 289: IF VAL(MID$(n1$, q, 1)) < VAL(MID$(n2$, q, 1)) THEN
 290:     Num1 = VAL(MID$(n1$, q, 1)) + 10
 291:     l = 0
 292:     DO
 293:         l = l + 1
 294:         Br$ = MID$(n1$, q - l, 1)
 295:         IF Br$ = "0" THEN MID$(n1$, q - l, 1) = "9"
 296:     LOOP UNTIL Br$ <> "0"
 297:     MID$(n1$, q - l, 1) = RTRIM$(LTRIM$(STR$(VAL(MID$(n1$, q - l, 1)) - 1)))
 298: ELSE
 299:     Num1 = VAL(MID$(n1$, q, 1))
 300: END IF
 301: sc = Num1 - VAL(MID$(n2$, q, 1))
 302: cc$ = Trim$(STR$(sc)) + cc$
 303: NEXT q
 304: IF Neg = 1 THEN cc$ = "-" + cc$
 305: IF Stor <> 0 THEN cc$ = LEFT$(cc$, LEN(cc$) - Stor) + "." + RIGHT$(cc$, Stor)
 306: 
 307: Subt$ = cc$
 308: 
 309: END FUNCTION
 310:
5750896 [rkeene@sledge /home/rkeene/devel/archive/visualbasic4.0]$
Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:52:43