stdecmth.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StDecMth.pas 4.03                           *}
{*********************************************************}
{* SysTools: Class for doing decimal arithmetic          *}
{*********************************************************}

{$I StDefine.inc}

unit StDecMth;

interface

{Note: StDecMth declares and implements TStDecimal. This is a fixed-
       point value with a total of 38 significant digits of which
       16 are to the right of the decimal point.}

uses
  SysUtils;

type
  TStRoundMethod = ( {different rounding methods...}
    rmNormal,        {..normal (round away from zero if half way)}
    rmTrunc,         {..truncate (always round to zero)}
    rmBankers,       {..bankers (round to even digit if half way)}
    rmUp);           {..force round up (always round from zero)}

  TStInt128 = array [0..3] of longint; // must be longint, not DWORD

  TStDecimal = class
    private
      FInt : TStInt128;
    protected
      function dcGetAsStr : AnsiString;
      procedure dcSetFromStr(const aValue : AnsiString);               {!!.02}
    public
      constructor Create;
      destructor Destroy; override;

      function Compare(X : TStDecimal) : integer;
        {-returns <0 if Self < X, 0 is equal, >0 otherwise}
      function IsNegative : boolean;
        {-returns Self < 0.0}
      function IsOne : boolean;
        {-returns Self = 1.0}
      function IsPositive : boolean;
        {-returns Self > 0.0}
      function IsZero : boolean;
        {-returns Self = 0.0}
      procedure SetToOne;
        {-sets Self equal to 1.0}
      procedure SetToZero;
        {-sets Self equal to 0.0}

      procedure Assign(X : TStDecimal);
        {-sets Self equal to X}
      procedure AssignFromFloat(aValue : double);
        {-sets Self equal to aValue}
      procedure AssignFromInt(aValue : integer);
        {-sets Self equal to aValue}

      function AsFloat : double;
        {-returns Self as an floating point value}
      function AsInt(aRound : TStRoundMethod) : integer;
        {-returns Self as an integer, rounded}

      procedure Abs;
        {-calculates Self := Abs(Self)}
      procedure Add(X : TStDecimal);
        {-calculates Self := Self + X}
      procedure AddOne;
        {-calculates Self := Self + 1.0}
      procedure ChangeSign;
        {-calculates Self := ChgSign(Self)}
      procedure Divide(X : TStDecimal);
        {-calculates Self := Self div X}
      procedure Multiply(X : TStDecimal);
        {-calculates Self := Self * X}
      procedure RaiseToPower(N : integer);
        {-calculates Self := Self ^ N}
      procedure Round(aRound : TStRoundMethod; aDecPl : integer);
        {-calculates Self := Round(Self)}
      procedure Subtract(X : TStDecimal);
        {-calculates Self := Self - X}
      procedure SubtractOne;
        {-calculates Self := Self - 1}

      property AsString : AnsiString read dcGetAsStr write dcSetFromStr;
        {-returns Self as a string, sets Self from a string}
  end;

implementation

uses
  StConst,
  StBase;

type
  TStInt256 = array [0..7] of integer;
  TStInt192 = array [0..5] of integer;

const
  MaxDecPl = 16;

  Int128One_0 = longint($6FC10000);
  Int128One_1 = longint($002386F2);

  PowerOf10 : array [0..MaxDecPl div 2] of integer =
              (1, 10, 100, 1000, 10000, 100000, 1000000, 10000000,
               100000000);

{===Helper routines==================================================}
procedure Int256Div10E8(var X : TStInt256; var aRem : integer);
{Note: this routine assumes X is positive}
asm
  push ebx             // save ebx

  push edx             // save address of remainder variable

  mov ecx, 100000000   // we're dividing by 10^8
  mov ebx, eax         // ebx points to X

  xor edx, edx         // start off with high dividend digit zero
  mov eax, [ebx+28]    // get last 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+28], eax    // save highest quotient digit

  mov eax, [ebx+24]    // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+24], eax    // save next quotient digit

  mov eax, [ebx+20]    // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+20], eax    // save next quotient digit

  mov eax, [ebx+16]    // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+16], eax    // save next quotient digit

  mov eax, [ebx+12]    // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+12], eax    // save next quotient digit

  mov eax, [ebx+8]     // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+8], eax     // save next quotient digit

  mov eax, [ebx+4]     // get next 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx+4], eax     // save next quotient digit

  mov eax, [ebx]       // get first 32-bit digit
  div ecx              // divide by 10: eax is quotient, edx remainder
  mov [ebx], eax       // save first quotient digit

  pop eax              // pop off the address of remainder variable
  mov [eax], edx       // store remainder

  pop ebx              // restore ebx
end;
{--------}
procedure Int192Times10E8(var X : TStInt192);
{Note: this routine assumes X is positive}
asm
  push ebx           // save ebx
  push ebp           // save ebp

  mov ecx, 100000000 // we're multiplying by 10^8
  mov ebx, eax       // ebx points to X

  mov eax, [ebx]     // get the first 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  mov [ebx], eax     // save first digit of result
  mov ebp, edx       // save overflow

  mov eax, [ebx+4]   // get the second 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  add eax, ebp       // add the overflow from the first digit
  adc edx, 0
  mov [ebx+4], eax   // save second digit of result
  mov ebp, edx       // save overflow

  mov eax, [ebx+8]   // get the third 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  add eax, ebp       // add the overflow from the second digit
  adc edx, 0
  mov [ebx+8], eax   // save third digit of result
  mov ebp, edx       // save overflow

  mov eax, [ebx+12]  // get the fourth 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  add eax, ebp       // add the overflow from the third digit
  adc edx, 0
  mov [ebx+12], eax  // save fourth digit of result
  mov ebp, edx       // save overflow

  mov eax, [ebx+16]  // get the fifth 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  add eax, ebp       // add the overflow from the fourth digit
  adc edx, 0
  mov [ebx+16], eax  // save fifth digit of result
  mov ebp, edx       // save overflow

  mov eax, [ebx+20]  // get the sixth 32-bit digit
  mul ecx            // multiply it by 10^8 to give answer in edx:eax
  add eax, ebp       // add the overflow from the fifth digit
  mov [ebx+20], eax  // save sixth digit of result

  pop ebp            // restore ebp
  pop ebx            // restore ebx
end;
{--------}
function Int32MultPrim(X, Y : longint;
                   var P : longint; Carry : longint) : longint;
asm
  {Note: calculates X * Y + P + Carry
         returns answer in P, with overflow as result value}
  mul edx
  add eax, [ecx]
  adc edx, 0
  add eax, Carry
  adc edx, 0
  mov [ecx], eax
  mov eax, edx
end;
{--------}
procedure Int128Add(var X : TStInt128; const Y : TStInt128);
asm
  push ebx
  mov ecx, [edx]
  mov ebx, [edx+4]
  add [eax], ecx
  adc [eax+4], ebx
  mov ecx, [edx+8]
  mov ebx, [edx+12]
  adc [eax+8], ecx
  adc [eax+12], ebx
  pop ebx
end;
{--------}
procedure Int128AddInt(var X : TStInt128; aDigit : integer);
asm
  add [eax], edx
  adc dword ptr [eax+4], 0
  adc dword ptr [eax+8], 0
  adc dword ptr [eax+12], 0
end;
{--------}
procedure Int128ChgSign(var X : TStInt128);
asm
  mov ecx, [eax]
  mov edx, [eax+4]
  not ecx
  not edx
  add ecx, 1
  adc edx, 0
  mov [eax], ecx
  mov [eax+4], edx
  mov ecx, [eax+8]
  mov edx, [eax+12]
  not ecx
  not edx
  adc ecx, 0
  adc edx, 0
  mov [eax+8], ecx
  mov [eax+12], edx
end;
{--------}
function Int128Compare(const X, Y : TStInt128) : integer;
asm
  // Can be called from pascal
  // All registers are preserved, except eax, which returns the
  //   result of the comparison
  push ebx
  push ecx
  mov ecx, [eax+12]
  mov ebx, [edx+12]
  xor ecx, $80000000
  xor ebx, $80000000
  cmp ecx, ebx
  jb @@LessThan
  ja @@GreaterThan
  mov ecx, [eax+8]
  mov ebx, [edx+8]
  cmp ecx, ebx
  jb @@LessThan
  ja @@GreaterThan
  mov ecx, [eax+4]
  mov ebx, [edx+4]
  cmp ecx, ebx
  jb @@LessThan
  ja @@GreaterThan
  mov ecx, [eax]
  mov ebx, [edx]
  cmp ecx, ebx
  jb @@LessThan
  ja @@GreaterThan
  xor eax, eax
  jmp @@Exit
@@LessThan:
  mov eax, -1
  jmp @@Exit
@@GreaterThan:
  mov eax, 1
@@Exit:
  pop ecx
  pop ebx
end;
{--------}
procedure Int192SHL(var X : TStInt192);
asm
  // DO NOT CALL FROM PASCAL
  // IN:  eax -> 192-bit integer to shift left
  // OUT: eax -> 192-bit integer shifted left
  //      CF  =  most significant bit shifted out
  // All registers are preserved
  push ebx
  push ecx
  mov ebx, [eax]
  mov ecx, [eax+4]
  shl ebx, 1
  rcl ecx, 1
  mov [eax], ebx
  mov [eax+4], ecx
  mov ebx, [eax+8]
  mov ecx, [eax+12]
  rcl ebx, 1
  rcl ecx, 1
  mov [eax+8], ebx
  mov [eax+12], ecx
  mov ebx, [eax+16]
  mov ecx, [eax+20]
  rcl ebx, 1
  rcl ecx, 1
  mov [eax+16], ebx
  mov [eax+20], ecx
  pop ecx
  pop ebx
end;
{--------}
procedure Int128RCL(var X : TStInt128);
asm
  // DO NOT CALL FROM PASCAL
  // IN:  eax -> 128-bit integer to shift left
  //      CF  =  least significant bit to shift in
  // OUT: eax -> 128-bit integer shifted left
  //      CF  -> topmost bit shifted out
  // All registers are preserved
  push ebx
  push ecx
  mov ebx, [eax]
  mov ecx, [eax+4]
  rcl ebx, 1
  rcl ecx, 1
  mov [eax], ebx
  mov [eax+4], ecx
  mov ebx, [eax+8]
  mov ecx, [eax+12]
  rcl ebx, 1
  rcl ecx, 1
  mov [eax+8], ebx
  mov [eax+12], ecx
  pop ecx
  pop ebx
end;
{--------}
procedure Int128FastDivide(var X       : TStInt192;
                           var Y, aRem : TStInt128);
asm
  push ebp
  push ebx
  push edi
  push esi

  mov esi, eax         // esi -> dividend
  mov edi, edx         // edi -> divisor
  mov ebp, ecx         // ebp -> remainder

  mov ecx, 192         // we'll do the loop for all 192 bits in the
                       //   dividend

  xor eax, eax         // zero the remainder
  mov [ebp], eax
  mov [ebp+4], eax
  mov [ebp+8], eax
  mov [ebp+12], eax

@@GetNextBit:
  mov eax, esi         // shift the dividend left, and...
  call Int192SHL
  mov eax, ebp         // ...shift the topmost bit into the remainder
  call Int128RCL

  mov eax, ebp         // compare the remainder with the divisor
  mov edx, edi
  call Int128Compare

  cmp eax, 0           // if the remainder is smaller, we can't
  jl @@TooSmall        //   subtract the divisor

                       // essentially we've shown that the divisor
                       //   divides the remainder exactly once, so

  add dword ptr [esi], 1   // add one to the quotient

  mov eax, [ebp]       // subtract the divisor from the remainder
  mov ebx, [ebp+4]
  sub eax, [edi]
  sbb ebx, [edi+4]
  mov [ebp], eax
  mov [ebp+4], ebx