#DecIntSize = 8 #DecIntValue = 100000000 Structure DecField Value.l[0] EndStructure Structure Dec Sign.i HighFields.i *High.DecField LowFields.i *Low.DecField EndStructure Procedure MaxAB(A,B) If A > B : ProcedureReturn A : Else : ProcedureReturn B : EndIf EndProcedure Procedure DecFields(String$) Protected StringLength = Len(String$) If StringLength ProcedureReturn (StringLength + #DecIntSize-StringLength%#DecIntSize)/#DecIntSize Else ProcedureReturn 0 EndIf EndProcedure ; Optimiert eine Dezimalzahl (entfernt führende und endende Nullen) Procedure OptDec(*Dec.Dec) While *Dec\HighFields And Not *Dec\High\Value[*Dec\HighFields-1] *Dec\HighFields - 1 Wend If *Dec\HighFields *Dec\High = ReAllocateMemory(*Dec\High, *Dec\HighFields*SizeOf(Long)) ElseIf *Dec\High FreeMemory(*Dec\High) : *Dec\High = 0 EndIf While *Dec\LowFields And Not *Dec\Low\Value[*Dec\LowFields-1] *Dec\LowFields - 1 Wend If *Dec\LowFields *Dec\Low = ReAllocateMemory(*Dec\Low, *Dec\LowFields*SizeOf(Long)) ElseIf *Dec\Low FreeMemory(*Dec\Low) : *Dec\Low = 0 EndIf EndProcedure ; Setzt eine Dezimalzahl aus einem String Procedure SetDec(String$) Protected High$, Low$ Protected *Dec.Dec = AllocateMemory(SizeOf(Dec)) If *Dec String$ = ReplaceString(String$, " ", "") If Left(String$, 1) = "-" *Dec\Sign = -1 String$ = Mid(String$, 2) Else *Dec\Sign = 1 EndIf High$ = StringField(String$, 1, ".") Low$ = StringField(String$, 2, ".") *Dec\HighFields = DecFields(High$) *Dec\LowFields = DecFields(Low$) If *Dec\HighFields *Dec\High = AllocateMemory(*Dec\HighFields*SizeOf(Long)) High$ = RSet(High$, *Dec\HighFields*#DecIntSize, "0") If *Dec\High For n = 0 To *Dec\HighFields-1 *Dec\High\Value[n] = Val(Right(High$, #DecIntSize)) High$ = Left(High$, Len(High$)-#DecIntSize) Next EndIf EndIf If *Dec\LowFields *Dec\Low = AllocateMemory(*Dec\LowFields*SizeOf(Long)) Low$ = LSet(Low$, *Dec\LowFields*#DecIntSize, "0") If *Dec\Low For n = 0 To *Dec\LowFields-1 *Dec\Low\Value[n] = Val(Left(Low$, #DecIntSize)) Low$ = Mid(Low$, #DecIntSize+1) Next EndIf EndIf ProcedureReturn *Dec EndIf EndProcedure ; Kopiert eine Dezimalzahl Procedure CopyDec(*Dec1.Dec) Protected *Dec.Dec = AllocateMemory(SizeOf(Dec)) If *Dec CopyMemory(*Dec1, *Dec, SizeOf(Dec)) If *Dec1\LowFields *Dec\Low = AllocateMemory(*Dec1\LowFields*SizeOf(Long)) CopyMemory(*Dec1\Low, *Dec\Low, *Dec1\LowFields*SizeOf(Long)) EndIf If *Dec1\HighFields *Dec\High = AllocateMemory(*Dec1\HighFields*SizeOf(Long)) CopyMemory(*Dec1\High, *Dec\High, *Dec1\HighFields*SizeOf(Long)) EndIf ProcedureReturn *Dec EndIf EndProcedure ; Gibt eine Dezimalzahl frei Procedure FreeDec(*Dec.Dec) If *Dec\LowFields FreeMemory(*Dec\Low) EndIf If *Dec\HighFields FreeMemory(*Dec\High) EndIf FreeMemory(*Dec) EndProcedure ; Gibt eine Dezimalzahl als String aus Procedure.s GetDec(*Dec.Dec) Protected High$, Low$, Dec$ For n = 0 To *Dec\HighFields-1 High$ = RSet(Str(*Dec\High\Value[n]), #DecIntSize, "0") + High$ Next For n = 0 To *Dec\LowFields-1 Low$ = Low$ + RSet(Str(*Dec\Low\Value[n]), #DecIntSize, "0") Next Dec$ = High$+"."+Low$ ReplaceString(Dec$, "0", " ", #PB_String_InPlace) Dec$ = Trim(Dec$) ReplaceString(Dec$, " ", "0", #PB_String_InPlace) If *Dec\Sign = -1 ProcedureReturn "-"+Dec$ Else ProcedureReturn Dec$ EndIf EndProcedure Procedure CmpDecAbs(*Dec1.Dec, *Dec2.Dec) Protected A, B, HighFields, LowFields HighFields = MaxAB(*Dec1\HighFields, *Dec2\HighFields) For n = HighFields-1 To 0 Step -1 If n < *Dec1\HighFields : A = *Dec1\High\Value[n] : Else : A = 0 : EndIf If n < *Dec2\HighFields : B = *Dec2\High\Value[n] : Else : B = 0 : EndIf If A > B ProcedureReturn 1 ElseIf A < B ProcedureReturn -1 EndIf Next LowFields = MaxAB(*Dec1\LowFields, *Dec2\LowFields) For n = 0 To LowFields-1 If n < *Dec1\LowFields : A = *Dec1\Low\Value[n] : Else : A = 0 : EndIf If n < *Dec2\LowFields : B = *Dec2\Low\Value[n] : Else : B = 0 : EndIf If A > B ProcedureReturn 1 ElseIf A < B ProcedureReturn -1 EndIf Next ProcedureReturn 0 EndProcedure ; Vergleich zwei Dezimalzahlen ; -1 : Dec1 < Dec2 ; 0 : Dec1 = Dec2 ; +1 : Dec1 > Dec2 Procedure CmpDec(*Dec1.Dec, *Dec2.Dec) If *Dec1\Sign > *Dec2\Sign ProcedureReturn 1 ElseIf *Dec1\Sign < *Dec2\Sign ProcedureReturn -1 ElseIf *Dec1\Sign = 1 ProcedureReturn CmpDecAbs(*Dec1.Dec, *Dec2.Dec) Else ProcedureReturn -CmpDecAbs(*Dec1.Dec, *Dec2.Dec) EndIf EndProcedure ; Addiert zwei Dezimalzahlen Procedure AddDec(*Dec1.Dec, *Dec2.Dec) Protected *Dec.Dec = AllocateMemory(SizeOf(Dec)) Protected Result.q, Sign=1, Sign1=1, Sign2=1 If *Dec If *Dec1\Sign = *Dec2\Sign *Dec\Sign = *Dec1\Sign Else Sign = -1 Swap Sign1, *Dec1\Sign Swap Sign2, *Dec2\Sign If CmpDec(*Dec1, *Dec2)<0 Swap *Dec1, *Dec2 Swap Sign1, Sign2 EndIf If Sign1 < Sign2 *Dec\Sign = -1 Else *Dec\Sign = 1 EndIf EndIf *Dec\HighFields = MaxAB(*Dec1\HighFields, *Dec2\HighFields) *Dec\LowFields = MaxAB(*Dec1\LowFields, *Dec2\LowFields) If *Dec\LowFields *Dec\Low = AllocateMemory(*Dec\LowFields*SizeOf(Long)) If *Dec\Low For n = *Dec\LowFields-1 To 0 Step -1 Result = 0 If n < *Dec1\LowFields Result + *Dec1\Low\Value[n] EndIf If n < *Dec2\LowFields Result + *Dec2\Low\Value[n] * Sign EndIf Result + Over If Result >= #DecIntValue Over = IntQ(Result/#DecIntValue) Result = Result%#DecIntValue ElseIf Result < 0 Over = -1 Result = #DecIntValue+Result Else Over = 0 EndIf *Dec\Low\Value[n] = Result Next EndIf EndIf If *Dec\HighFields *Dec\High = AllocateMemory(*Dec\HighFields*SizeOf(Long)) If *Dec\High For n = 0 To *Dec\HighFields-1 Result = 0 If n < *Dec1\HighFields Result + *Dec1\High\Value[n] EndIf If n < *Dec2\HighFields Result + *Dec2\High\Value[n] * Sign EndIf Result + Over If Result >= #DecIntValue Over = IntQ(Result/#DecIntValue) Result = Result%#DecIntValue ElseIf Result < 0 Over = -1 Result = #DecIntValue+Result Else Over = 0 EndIf *Dec\High\Value[n] = Result Next EndIf EndIf If Over *Dec\HighFields + 1 *Dec\High = ReAllocateMemory(*Dec\High, *Dec\HighFields*SizeOf(Long)) *Dec\High\Value[*Dec\HighFields-1] = Over EndIf If Sign1 <> Sign2 Swap Sign1, *Dec1\Sign Swap Sign2, *Dec2\Sign EndIf OptDec(*Dec) ProcedureReturn *Dec EndIf EndProcedure ; Subtrahiert zwei Dezimalzahlen Procedure SubDec(*Dec1.Dec, *Dec2.Dec) Protected *Dec *Dec2\Sign * -1 *Dec = AddDec(*Dec1.Dec, *Dec2.Dec) *Dec2\Sign * -1 ProcedureReturn *Dec EndProcedure Macro MulDec_Inner(ValueA, ValueB) Result = *Dec1\ValueA\Value[n] * *Dec2\ValueB\Value[m] If Result >= #DecIntValue Result(i) + Result%#DecIntValue Result(i+1) + IntQ(Result/#DecIntValue) Else Result(i) + Result EndIf EndMacro ; Multipliziert zwei Dezimalzahlen Procedure MulDec(*Dec1.Dec, *Dec2.Dec) Protected *Dec.Dec = AllocateMemory(SizeOf(Dec)) Protected Result.q If *Dec *Dec\Sign = *Dec1\Sign * *Dec2\Sign *Dec\HighFields = *Dec1\HighFields + *Dec2\HighFields *Dec\LowFields = *Dec1\LowFields + *Dec2\LowFields Protected Dim Result.q(*Dec\HighFields+*Dec\LowFields) ; LowFields = 10 : HighFields = 10 ; 0 .. 8 9 10 11 .. 19 20 ; Lo9 .. Lo1 Lo0 Hi0 Hi1 .. Hi9 -- Protected d = *Dec\LowFields For n = 0 To *Dec1\LowFields-1 For m = 0 To *Dec2\LowFields-1 i = d-n-m-2 MulDec_Inner(Low,Low) Next Next For n = 0 To *Dec1\HighFields-1 For m = 0 To *Dec2\LowFields-1 i = d+n-m-1 MulDec_Inner(High,Low) Next Next For n = 0 To *Dec1\LowFields-1 For m = 0 To *Dec2\HighFields-1 i = d-n+m-1 MulDec_Inner(Low,High) Next Next For n = 0 To *Dec1\HighFields-1 For m = 0 To *Dec2\HighFields-1 i = d+n+m MulDec_Inner(High,High) Next Next If *Dec\LowFields *Dec\Low = AllocateMemory(*Dec\LowFields*SizeOf(Long)) For i = *Dec\LowFields-1 To 0 Step -1 Result = Result(d-i-1) + Over If Result >= #DecIntValue Over = IntQ(Result/#DecIntValue) Result = Result%#DecIntValue Else Over = 0 EndIf *Dec\Low\Value[i] = Result Next EndIf If *Dec\HighFields *Dec\High = AllocateMemory(*Dec\HighFields*SizeOf(Long)) For i = 0 To *Dec\HighFields-1 Result = Result(d+i) + Over If Result >= #DecIntValue Over = IntQ(Result/#DecIntValue) Result = Result%#DecIntValue Else Over = 0 EndIf *Dec\High\Value[i] = Result Next EndIf OptDec(*Dec) ProcedureReturn *Dec EndIf EndProcedure ; Dividiert zwei Dezimalzahlen Procedure DivDec(*Dec1.Dec, *Dec2.Dec, Accuracy=#DecIntSize) Protected *Dec.Dec, *Start.Dec, *Shift10.Dec = SetDec("10") Protected HighFields, Dec$, Sign=1 If CmpDecAbs(*Dec1, *Dec2) < 0 HighFields = 0 Else HighFields = 1 + *Dec1\HighFields - *Dec2\HighFields EndIf AccuracyLowFields = (Accuracy+#DecIntSize-Accuracy%#DecIntSize)/#DecIntSize LowFields = MaxAB(*Dec1\LowFields,*Dec2\LowFields)+AccuracyLowFields If HighFields Shift = (HighFields-1)*#DecIntSize + Log10(*Dec1\High\Value[*Dec1\HighFields-1]) If *Dec2\HighFields And *Dec2\High\Value[*Dec2\HighFields-1] Shift - Log10(*Dec2\High\Value[*Dec2\HighFields-1]) EndIf If Shift *Shift.Dec = SetDec("."+ReplaceString(Space(Shift-1)," ","0")+"1") *Start = MulDec(*Dec1, *Shift) Else *Start = CopyDec(*Dec1) EndIf Else *Start = CopyDec(*Dec1) Shift = 0 EndIf Swap Sign, *Dec2\Sign *Start\Sign = 1 For n = -Shift To LowFields*#DecIntSize Count = 0 While CmpDecAbs(*Dec2, *Start) <= 0 *New = SubDec(*Start, *Dec2) FreeDec(*Start) : *Start = *New Count + 1 Wend Dec$ + Str(Count) *New = MulDec(*Start, *Shift10) FreeDec(*Start) : *Start = *New If n = 0 : Dec$+"." : EndIf Next FreeDec(*Shift10) FreeDec(*Start) Swap Sign, *Dec2\Sign *Dec = SetDec(Dec$) *Dec\Sign = *Dec1\Sign * *Dec2\Sign ProcedureReturn *Dec EndProcedure ; IDE Options = PureBasic 4.40 Beta 5 (Windows - x86) ; CursorPosition = 51 ; FirstLine = 49