home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 21 / CTROM21B.mdf / win95 / zakelijk / esbcalc / setup.exe / file0008.bin < prev    next >
Encoding:
Text File  |  1999-07-07  |  3.2 KB  |  150 lines
  1. {: Extra Routines for ESBCalc - these are taken from our internal library.
  2.     This unit requires Delphi 4
  3.  
  4.     (c) 1999 ESB Consultancy <p>
  5.  
  6.     These routines are used by ESB Consultancy within the
  7.     development of their Customised Application. <p>
  8.  
  9.     ESB Consultancy retains full copyright. <p>
  10.  
  11.     ESB Consultancy grants users of this code royalty free rights
  12.     to do with this code as they wish. <p>
  13.  
  14.     ESB Consultancy makes no guarantees nor excepts any liabilities
  15.     due to the use of these routines. <p>
  16.  
  17.     We do ask that if this code helps you in you development
  18.     that you send as an email mailto:esb@gold.net.au or even
  19.     a local postcard. It would also be nice if you gave us a
  20.     mention in your About Box or Help File. <p>
  21.  
  22.     ESB Consultancy Home Page: http://www.gold.net.au/~esb <p>
  23.  
  24.     Mail Address: PO Box 2259, Boulder, WA 6432 AUSTRALIA <p>
  25. }
  26.  
  27. unit ESBExtra;
  28.  
  29. interface
  30.  
  31. // Virtual Keys that Delphi omitted
  32. const
  33.     VK_0 = 48;
  34.     VK_1 = 49;
  35.     VK_2 = 50;
  36.     VK_3 = 51;
  37.     VK_4 = 52;
  38.     VK_5 = 53;
  39.     VK_6 = 54;
  40.     VK_7 = 55;
  41.     VK_8 = 56;
  42.     VK_9 = 57;
  43.  
  44. const
  45.     VK_A = 65;
  46.     VK_B = 66;
  47.     VK_C = 67;
  48.     VK_D = 68;
  49.     VK_E = 69;
  50.     VK_F = 70;
  51.     VK_G = 71;
  52.     VK_H = 72;
  53.     VK_I = 73;
  54.     VK_J = 74;
  55.     VK_K = 75;
  56.     VK_L = 76;
  57.     VK_M = 77;
  58.     VK_N = 78;
  59.     VK_O = 79;
  60.     VK_P = 80;
  61.     VK_Q = 81;
  62.     VK_R = 82;
  63.     VK_S = 83;
  64.     VK_T = 84;
  65.     VK_U = 85;
  66.     VK_V = 86;
  67.     VK_W = 87;
  68.     VK_X = 88;
  69.     VK_Y = 89;
  70.     VK_Z = 90;
  71.  
  72. //: Dynamic Arrays used in the Calculator
  73. type
  74.     TDynFloatArray = array of Extended;
  75.     TDynCharArray = array of Char;
  76.  
  77. {: Returns the substring consisting of the first N characters of S.
  78.     If N > Length (S) then the substring = S. }
  79. function LeftStr (const S : string; const N : Integer): string;
  80.  
  81. {: Converts a String into an Extended Real }
  82. function Str2Ext (const S: String): Extended;
  83.  
  84. {: Converts an Extended Real into an exact String, No padding,
  85.     with given number of Decimal Places }
  86. function Ext2EStr (const E: Extended; const Decimals: Byte): String;
  87.  
  88. {: Converts an Extended Real into an exact String, No padding,
  89.     with given number of Decimal Places, with "Commas" separating
  90.     thousands }
  91. function Ext2CEStr (const E: Extended; const Decimals: Byte): String;
  92.  
  93. {: Removes all Thousand's Separators from a string }
  94. function StripThousandSep (const S: string): string;
  95.  
  96. implementation
  97.  
  98. uses
  99.     SysUtils;
  100.  
  101. function LeftStr (const S : string; const N : Integer): string;
  102. begin
  103.     Result := Copy (S, 1, N);
  104. end;
  105.  
  106. function Str2Ext (const S: String): Extended;
  107. var
  108.     S2: string;
  109. begin
  110.     try
  111.         S2 := StripThousandSep (S);
  112.         Result := StrToFloat (S2);
  113.     except
  114.         Result := 0;
  115.     end;
  116. end;
  117.  
  118. function Ext2EStr (const E: Extended; const Decimals: Byte): String;
  119. begin
  120.     try
  121.         Result := FloatToStrF (E, ffFixed, 18, Decimals)
  122.     except
  123.         Result := '';
  124.     end;
  125. end;
  126.  
  127. function Ext2CEStr (const E: Extended; const Decimals: Byte): String;
  128. begin
  129.     try
  130.         Result := FloatToStrF (E, ffNumber, 18, Decimals)
  131.     except
  132.         Result := '';
  133.     end;
  134. end;
  135.  
  136. function StripThousandSep (const S: string): string;
  137. var
  138.     P: Integer;
  139. begin
  140.     Result := S;
  141.     repeat
  142.         P := Pos (ThousandSeparator, Result);
  143.         if P > 0 then
  144.             Result := LeftStr (Result, P - 1) + Copy (Result, P + 1,
  145.                 Length (Result) - P);
  146.     until P = 0;
  147. end;
  148.  
  149. end.
  150.