home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D4 / ESBRTNS.ZIP / ESBRtns.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-02  |  30KB  |  1,209 lines
  1. {: ESB Routines Collection v1.2
  2.  
  3.     Miscellaneous Routines to enhance your 32-bit Delphi
  4.     Programming including: <p>
  5.  
  6.     - 16-bit Bit Lists <p>
  7.     - Block Operations <p>
  8.     - various String Routines and Conversions <p>
  9.  
  10.     (c) 1997-1998 ESB Consultancy <p>
  11.  
  12.     These routines are used by ESB Consultancy within the
  13.     development of their Customised Application. <p>
  14.  
  15.     ESB Consultancy retains full copyright. <p>
  16.  
  17.     ESB Consultancy grants users of this code royalty free rights
  18.     to do with this code as they wish. <p>
  19.  
  20.     ESB Consultancy makes no guarantees nor excepts any liabilities
  21.     due to the use of these routines. <p>
  22.  
  23.     We do ask that if this code helps you in you development
  24.     that you send as an email mailto:esb@gold.net.au or even
  25.     a local postcard. It would also be nice if you gave us a
  26.     mention in your About Box or Help File. <p>
  27.  
  28.     ESB Consultancy Home Page: http://www.gold.net.au/~esb <p>
  29.  
  30.     Mail Address: PO Box 2259, Boulder, WA 6432 AUSTRALIA <p>
  31.  
  32.     History: <p>
  33.  
  34.     v1.2 2 Sep 1998 <p>
  35.         - Delphi 4 Support Added <p>
  36.         - Comments changed to be Time2Help compliant <p>
  37.           - Help File Added <p>
  38.           - Max/Min of Data types removed as High/Low should be used <p>
  39.           - Byte2Str removed as LInt2Str can be used in it's place <p>
  40.         - Added String To Integer conversions for Smallint,
  41.                LongWord (4) and Int64(D4) <p>
  42.  
  43.     v1.1 14 Nov 1997 <p>
  44.         - 32-Bit Bit Lists added <p>
  45.  
  46.     v1.0 Intial Release <p>
  47.  
  48. }
  49.  
  50. unit ESBRtns;
  51.  
  52. {$J+}
  53.  
  54. interface
  55.  
  56. const
  57.      //: Character to use for Left Hand Padding of Numerics
  58.     NumPadCh: Char = ' ';
  59.  
  60. type
  61.      //: Used for a Bit List of 16 bits from 15 -> 0
  62.     TBitList = Word;
  63.  
  64.      {$IFNDEF VER120}
  65.      //: Used for a Bit List of 32 bits from 31 -> 0
  66.     TLongBitList = LongInt;
  67.      {$ELSE}
  68.      //: Used for a Bit List of 32 bits from 31 -> 0
  69.     TLongBitList = LongWord;
  70.      {$ENDIF}
  71.  
  72. type
  73.     String16 = string [16]; // String of 16 characters
  74.     String32 = string [32]; // String of 32 characters
  75.  
  76. {--- Bit Manipulation ---}
  77.  
  78. {: Sets all Bits in the BitList to 0 }
  79. procedure ClearAllBits (var Body: TBitList);
  80.  
  81. {: Sets all Bits in the BitList to 1 }
  82. procedure SetAllBits (var Body: TBitList);
  83.  
  84. {: Flips all Bits in the BitList, i.e 1 -> 0 and 0 -> 1 }
  85. procedure FlipAllBits (var Body: TBitList);
  86.  
  87. {: Sets specified Bit in the BitList to 0 }
  88. procedure ClearBit (var Body: TBitList; const I: Byte);
  89.  
  90. {: Sets specified Bit in the BitList to 1 }
  91. procedure SetBit (var Body: TBitList; const I: Byte);
  92.  
  93. {: Flips specified Bit in the BitList, i.e. 0 -> 1 and 1 -> 0 }
  94. procedure FlipBit (var Body: TBitList; const I: Byte);
  95.  
  96. {: Returns True if Specified Bit in the BitList is 1 }
  97. function BitIsSet (const Body: TBitList; const I: Byte): Boolean;
  98.  
  99. {: Reverses the Bit List, i.e. Bit 15 <-> Bit 0, Bit 14 <-> Bit1, etc. }
  100. procedure ReverseBits (var Body: TBitList); register;
  101.  
  102. {: Converts a Bit list to a string of '1' and '0'. }
  103. function Bits2Str (const Body: TBitList): String16;
  104.  
  105. {: Converts a string of '1' and '0' into a BitList. }
  106. function Str2Bits (const S: String16): TBitList; register;
  107.  
  108. {: Returns a number from 0 -> 16 indicating the number of Bits Set }
  109. function BitsSet (const Body: TBitList): Byte; register;
  110.  
  111. {: Converts an Array of Boolean into a BitList.
  112.    Only the first 16 Booleans will be used }
  113. function Booleans2BitList (const B: array of Boolean): TBitList;
  114.  
  115. {: Sets all Bits in a LongBitList to 0 }
  116. procedure ClearAllLBits (var Body: TLongBitList);
  117.  
  118. {: Sets all Bits in a LongBitList to 1 }
  119. procedure SetAllLBits (var Body: TLongBitList);
  120.  
  121. {: Flips all Bits in a LongBitList, i.e 1 -> 0 and 0 -> 1 }
  122. procedure FlipAllLBits (var Body: TLongBitList);
  123.  
  124. { Sets specified Bit in a LongBitList to 0 }
  125. procedure ClearLBit (var Body: TLongBitList; const I: Byte);
  126.  
  127. {: Sets specified Bit in a LongBitList to 1 }
  128. procedure SetLBit (var Body: TLongBitList; const I: Byte);
  129.  
  130. {: Flips specified Bit in a LongBitList, i.e. 0 -> 1 and 1 -> 0 }
  131. procedure FlipLBit (var Body: TLongBitList; const I: Byte);
  132.  
  133. {: Returns True if Specified Bit in a LongBitList is 1 }
  134. function LBitIsSet (const Body: TLongBitList; const I: Byte): Boolean;
  135.  
  136. {: Converts a Long Bit list to a string of '1' and '0'. }
  137. function LBits2Str (const Body: TLongBitList): String32;
  138.  
  139. {--- Block Operations ---}
  140.  
  141. {: Moves Size bytes from Source starting at Ofs1 to destination
  142.     starting at Ofs 2 using fast dword moves. BASM }
  143. procedure ESBMoveOfs (const Source; const Ofs1: Integer;
  144.     var Dest; const Ofs2: Integer; const Size: Integer);
  145.  
  146. {: Fills given structure with specified number of 0 values,
  147.     effectively clearing it.    }
  148. procedure ESBClear (var Dest; const Size: Integer);
  149.  
  150. {: Fills given structure with specified number of $FF values,
  151.     effectively setting it. }
  152. procedure ESBSet (var Dest; const Size: Integer);
  153.  
  154.  
  155. {--- String to Integer Types ---}
  156.  
  157. {: Converts a String into a LongInt }
  158. function Str2LInt (const S: String): LongInt;
  159.  
  160. {: Converts a String into a Byte }
  161. function Str2Byte (const S: String): Byte;
  162.  
  163. {: Converts a String into a ShortInt }
  164. function Str2SInt (const S: String): ShortInt;
  165.  
  166. {: Converts a String into an Integer }
  167. function Str2Int (const S: String): Integer;
  168.  
  169. {: Converts a String into a SmallInt }
  170. function Str2SmallInt (const S: String): SmallInt;
  171.  
  172. {: Converts a String into a Word }
  173. function Str2Word (const S: String): Word;
  174.  
  175. {$IFDEF VER120}
  176. {: Converts a String into a LongWord }
  177. function Str2LWord (const S: String): LongWord;
  178.  
  179. {: Converts a String into an Int64 }
  180. function Str2Int64 (const S: String): Int64;
  181. {$ENDIF}
  182.  
  183. {--- Integer Types to Strings ---}
  184.  
  185. {: Converts a LongInt into a String of length N with
  186.     <See Const=NumPadCh> Padding to the Left }
  187. function LInt2Str (const L: LongInt; const Len: Byte): String;
  188.  
  189. {: Converts a LongInt into a String of length N with
  190.     <See Const=NumPadCh> Padding to the Left }
  191. function LInt2ZStr (const L: LongInt; const Len: Byte): String;
  192.  
  193. {: Converts a LongInt into a String of length N with
  194.     <See Const=NumPadCh> Padding to the Left, with blanks returned
  195.     if Value is 0 }
  196. function LInt2ZBStr (const L: LongInt; const Len: Byte): String;
  197.  
  198. {: Convert a LongInt into a Comma'ed String of length Len,
  199.     with <See Const=NumPadCh> Padding to the Left }
  200. function LInt2CStr (const L : LongInt; const Len : Byte): string;
  201.  
  202. {: Convert a LongInt into an exact String, No Padding }
  203. function LInt2EStr (const L: LongInt): String;
  204.  
  205. {: Convert a LongInt into an exact String, No Padding,
  206.     with null returned if Value is 0 }
  207. function LInt2ZBEStr (const L: LongInt): String;
  208.  
  209. {: Convert a LongInt into a Comma'ed String without Padding }
  210. function LInt2CEStr (const L : LongInt): string;
  211.  
  212.  
  213. {--- Extended Reals to Strings ---}
  214.  
  215. {: Converts an Extended Real into an exact String, No padding,
  216.     with given number of Decimal Places }
  217. function Ext2EStr (const E: Extended; const Decimals: Byte): String;
  218.  
  219. {: Converts an Extended Real into an exact String, No padding,
  220.     with at most the specified number of Decimal Places }
  221. function Ext2EStr2 (const E: Extended; const Decimals: Byte): String;
  222.  
  223. {: Converts an Extended Real into an exact String, No padding,
  224.     with given number of Decimal Places, with Commas separating
  225.     thousands }
  226. function Ext2CEStr (const E: Extended; const Decimals: Byte): String;
  227.  
  228. {: Converts a Double Real into an exact String, No padding,
  229.     with given number of Decimal Places }
  230. function Double2EStr (const D: Double; const Decimals: Byte): String;
  231.  
  232. {: Converts a Single Real into an exact String, No padding,
  233.     with given number of Decimal Places }
  234. function Single2EStr (const S: Single; const Decimals: Byte): String;
  235.  
  236. {: Converts a Comp (Integral) Real into an exact String, No padding }
  237. function Comp2EStr (const C: Comp): String;
  238.  
  239. {: Converts a Comp (Integral) Real into a Comma'ed String of
  240.     specified Length, Len, NumPadCh used for Left padding }
  241. function Comp2CStr (const C : Comp; const Len : Byte): string;
  242.  
  243. {: Converts a Comp (Integral) Real into a Comma'ed String
  244.     without Padding }
  245. function Comp2CEStr (const C : Comp): string;
  246.  
  247. {: Converts an Extended Real into a String of specified Length, using
  248.     NumPadCh for Left Padding, and with Specified number of Decimals }
  249. function Ext2Str (const E: Extended; const Len, Decimals: Byte): String;
  250.  
  251. {: Converts a Double Real into a String of specified Length, using
  252.     NumPadCh for Left Padding, and with Specified number of Decimals }
  253. function Double2Str (const D: Double; const Len, Decimals: Byte): String;
  254.  
  255. {: Converts an Single Real into a String of specified Length, using
  256.     NumPadCh for Left Padding, and with Specified number of Decimals }
  257. function Single2Str (const S: Single; const Len, Decimals: Byte): String;
  258.  
  259. {: Converts a Comp (Integral) Real into a String of specified Length, using
  260.     NumPadCh for Left Padding }
  261. function Comp2Str (const C: Comp; const Len : Byte): String;
  262.  
  263.  
  264. {--- Strings to Extended Reals ---}
  265.  
  266. {: Converts a String into an Extended Real }
  267. function Str2Ext (const S: String): Extended;
  268.  
  269. {--- Extra String Operations ---}
  270.  
  271. {: Returns the substring consisting of the first N characters of S.
  272.     If N > Length (S) then the substring = S. }
  273. function LeftStr (const S : string; const N : Integer): string;
  274.  
  275. {: Returns the substring consisting of the last N characters of S.
  276.     If N > Length (S) then the substring = S. }
  277. function RightStr (const S : string; const N : Integer): string;
  278.  
  279. {: Returns the substring consisting of the characters from S
  280.     up to but not including the specified one.  If the specified
  281.     character is not found then a null string is returned. }
  282. function LeftTillStr (const S : string; const Ch : Char): string;
  283.  
  284. {: Returns the sub-string to the right AFTER the first
  285.     N Characters. if N >= Length (S) then a Null string
  286.     is returned. }
  287. function RightAfterStr (const S : String; const N : Integer): String;
  288.  
  289. {: Returns the sub-string to the right AFTER the first
  290.     ocurrence of specifiec character.  If Ch not found then
  291.     a Null String is returned. }
  292. function RightAfterChStr (const S : String; const Ch : Char): String;
  293.  
  294. {: Returns the String with all specified trailing characters removed. }
  295. function StripTChStr (const S : string; const Ch : Char): string;
  296.  
  297. {: Returns the String with all specified leading characters removed. }
  298. function StripLChStr (const S : string; const Ch : Char): string;
  299.  
  300. {: Returns the String with all specified leading and trailing
  301.     characters removed. }
  302. function StripChStr (const S : string; const Ch : Char): string;
  303.  
  304. {: Returns the String with all occurrences of OldCh character
  305.     replaced with NewCh character. }
  306. function ReplaceChStr (const S : string; const OldCh, NewCh : Char): string;
  307.  
  308. {: Returns a string composed of N occurrences of Ch. }
  309. function FillStr (const Ch : Char; const N : Integer): string;
  310.  
  311. {: Returns a string composed of N blank spaces (i.e. #32) }
  312. function BlankStr (const N : Integer): string;
  313.  
  314. {: Returns a string composed of N occurrences of '-'. }
  315. function DashStr (const N : Integer): String;
  316.  
  317. {: Returns a string composed of N occurrences of '='. }
  318. function DDashStr (const N : Integer): string;
  319.  
  320. {: Returns a string composed of N occurrences of '*'. }
  321. function StarStr (const N : Integer): string;
  322.  
  323. {: Returns a string composed of N occurrences of '#'. }
  324. function HashStr (const N : Integer): string;
  325.  
  326. {: Returns a string with blank spaces added to the end of the
  327.     string until the string is of the given length. <p>
  328.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  329. function PadRightStr (const S : string; const Len : Integer): string;
  330.  
  331. {: Returns a string with blank spaces added to the beginning of the
  332.     string until the string is of the given length. <p>
  333.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  334. function PadLeftStr (const S : string; const Len : Integer): string;
  335.  
  336. {: Returns a string with blank spaces added to the beginning and
  337.     end of the string to in effect centre the string within the
  338.     given length. <p>
  339.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  340. function CentreStr (const S : String; const Len : Integer): String;
  341.  
  342. {: Returns a string with specified characters added to the end of the
  343.     string until the string is of the given length. <p>
  344.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  345. function PadChRightStr (const S : string; const Ch : Char;
  346.     const Len : Integer): string;
  347.  
  348. {: Returns a string with specified characters added to the beginning of the
  349.     string until the string is of the given length. <p>
  350.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  351. function PadChLeftStr (const S : string; const Ch : Char;
  352.     const Len : Integer): string;
  353.  
  354. {: Returns a string with specified characters added to the beginning and
  355.     end of the string to in effect centre the string within the
  356.     given length. <p>
  357.     If Length (S) >= Len then NO padding occurs, and S is returned. }
  358. function CentreChStr (const S : String; const Ch : Char;
  359.     const Len : Integer): String;
  360.  
  361. {: Returns a string of Length N with blank spaces added to the <b>end</b>
  362.     of the string if S is too short, or returning the N Left-most characters
  363.     of S if S is too long. }
  364. function LeftAlignStr (const S : string; const N : Integer): string;
  365.  
  366. {: Returns a string of Length N with blank spaces added to the <b>beginning</b>
  367.     of the string if S is too short, or returning the N Left-most characters
  368.     of S if S is too long. }
  369. function RightAlignStr (const S : string; const N : Integer): string;
  370.  
  371. {--- Boolean Conversions ---}
  372.  
  373. {: Converts a Boolean Value into the corresponding Character: <p>
  374.         True     -> 'T' <p>
  375.         False     -> 'F' <p>
  376. }
  377. function Boolean2TF (const B : Boolean): Char;
  378.  
  379. {: Converts a Boolean Value into the corresponding Character: <p>
  380.         True     -> 'Y' <p>
  381.         False     -> 'N' <p>
  382.  }
  383. function Boolean2YN (const B : Boolean): Char;
  384.  
  385. {: Converts a Boolean Value into the corresponding Character: <p>
  386.         True     ->  TrueChar <p>
  387.         False     ->  FalseChar <p>
  388.  }
  389. function Boolean2Char (const B : Boolean;
  390.     TrueChar, FalseChar: Char): Char;
  391.  
  392. {: Converts a Character Value into its corresponding Boolean value: <p>
  393.             'T', 't'    -> True <p>
  394.             Otherwise -> False <p>
  395.  }
  396. function TF2Boolean (const Ch : Char): Boolean;
  397.  
  398. {: Converts a Character Value into its corresponding Boolean value: <p>
  399.             'Y', 'y'    -> True <p>
  400.             Otherwise -> False <p>
  401.  }
  402. function YN2Boolean (const Ch : Char): Boolean;
  403.  
  404. implementation
  405.  
  406. uses
  407.     SysUtils;
  408.  
  409. {---- Bit Manipulation ----}
  410.  
  411. procedure ClearAllBits (var Body: TBitList);
  412.  
  413. begin
  414.     Body:= $0000
  415. end;
  416.  
  417. procedure SetAllBits (var Body: TBitList);
  418.  
  419. begin
  420.     Body:= $FFFF
  421. end;
  422.  
  423. procedure FlipAllBits (var Body: TBitList);
  424.  
  425. begin
  426.     Body:= Body xor $FFFF
  427. end;
  428.  
  429. procedure ClearBit (var Body: TBitList; const I: Byte);
  430.  
  431. begin
  432.     Body:= Body and (not ($0001 shl I))
  433. end;
  434.  
  435. procedure SetBit (var Body: TBitList; const I: Byte);
  436.  
  437. begin
  438.     Body:= Body or ($0001 shl I)
  439. end;
  440.  
  441. procedure FlipBit (var Body: TBitList; const I: Byte);
  442.  
  443. begin
  444.     Body:= Body xor ($0001 shl I)
  445. end;
  446.  
  447. function BitIsSet (const Body: TBitList; const I: Byte): Boolean;
  448.  
  449. begin
  450.     Result := (Body and ($0001 shl I)) <> 0
  451. end;
  452.  
  453. function Bits2Str (const Body: TBitList): String16;
  454. var
  455.     I: Integer;
  456. begin
  457.     SetLength (Result, 16);
  458.     for I := 0 to 15 do
  459.         if BitIsSet (Body, I) then
  460.             Result [I + 1] := '1'
  461.         else
  462.             Result [I + 1] := '0';
  463. end;
  464.  
  465. procedure ReverseBits (var Body: TBitList); assembler;
  466. asm
  467.         push esi
  468.         push ebx
  469.  
  470.         mov  esi, eax
  471.         mov  bx, Word Ptr [esi]
  472.         sub    ax, ax        // clear ax for out going bit list
  473.         mov    cx, 16        // 16 iterations needed for a word
  474.         sub    dx, dx        // clear dx for additions
  475.  
  476.     @1:
  477.         shl    ax, 1        // move all of ax right
  478.         shr    bx, 1        // move lsb into CF
  479.         adc    ax, dx        // add in the carry bit
  480.         loop @1
  481.  
  482.         mov Word Ptr [esi], ax
  483.  
  484.         pop     ebx
  485.         pop     esi
  486. end;
  487.  
  488. function Str2Bits (const S: String16): TBitList; assembler;
  489. asm
  490.         push esi
  491.         push ebx
  492.         mov    esi, eax
  493.  
  494.         lodsb            // Read Length
  495.         sub    ah, ah
  496.         mov    cx, ax        // & store in CX
  497.         sub    bx, bx        // clear BX for bit list construction
  498.         mov    dl, '0'        // for comparisons
  499.  
  500.     @1:    lodsb
  501.         shl    bx, 1        // mov bx along
  502.         cmp    al, dl
  503.         je    @2
  504.         add    bx, 1        // otherwise add 1
  505.     @2:    loop @1;
  506.         mov    ax, bx        // result must be in ax
  507.  
  508.         pop     ebx
  509.         pop     esi
  510. end;
  511.  
  512. function BitsSet (const Body: TBitList): Byte; assembler;
  513. asm
  514.         mov  dx, ax        // Place BitList into BX
  515.         xor    ax, ax        // Clear AX
  516.         mov  cx, 16        // Move 16 into CX
  517.     @2:    shl  dx, 1        // Shift Left
  518.         jnc    @1            // if no carry then no increment
  519.         inc    ax
  520.     @1:    loop @2
  521. end;
  522.  
  523. function Booleans2BitList (const B: array of Boolean): TBitList;
  524. var
  525.     I: Integer;
  526. begin
  527.     Result := 0;
  528.     for I := 0 to High (B) do
  529.         if B [I] then
  530.             SetBit (Result, 0);
  531. end;
  532.  
  533. procedure ESBMoveOfs (const Source; const Ofs1: Integer;
  534.     var Dest; const Ofs2: Integer; const Size: Integer);
  535. asm
  536.        push    esi
  537.        push    edi
  538.  
  539.        mov     esi, Source
  540.        add     esi, Ofs1
  541.        mov     edi, Dest
  542.        add     edi, Ofs2
  543.  
  544.        mov     eax, Size
  545.        mov     ecx, eax
  546.  
  547.        cmp     edi,esi
  548.        jg      @@DOWN
  549.        je      @@EXIT
  550.  
  551.        sar     ecx,2           //copy count DIV 4 dwords
  552.        js      @@EXIT
  553.  
  554.        rep     movsd
  555.  
  556.        mov     ecx,eax
  557.        and     ecx,03h
  558.        rep     movsb           //copy count MOD 4 bytes
  559.        jmp     @@EXIT
  560.  
  561. @@DOWN:
  562.        lea     esi,[esi+ecx-4] // point ESI to last dword of source
  563.        lea     edi,[edi+ecx-4] // point EDI to last dword of dest
  564.  
  565.        sar     ecx,2              // copy count DIV 4 dwords
  566.        js      @@EXIT
  567.        std
  568.        rep     movsd
  569.  
  570.        mov     ecx,eax
  571.        and     ecx,03h         // Copy count MOD 4 bytes
  572.        add     esi,4-1         // point to last byte of rest
  573.        add     edi,4-1
  574.        rep     movsb
  575.        cld
  576. @@EXIT:
  577.        pop     edi
  578.        pop     esi
  579. end;
  580.  
  581. procedure ESBClear (var Dest; const Size: Integer);
  582. begin
  583.     FillChar (Dest, Size, $00);
  584. end;
  585.  
  586. procedure ESBSet (var Dest; const Size: Integer);
  587. begin
  588.     FillChar (Dest, Size, $FF);
  589. end;
  590.  
  591. {$IFDEF Ver120}
  592. function Str2Int64 (const S: String): Int64;
  593. begin
  594.     try
  595.         Result := StrToInt64 (S);
  596.     except
  597.         Result := 0;
  598.     end;
  599. end;
  600. {$ENDIF}
  601.  
  602. function Str2LInt (const S: String): LongInt;
  603. {$IFDEF Ver120}
  604. var
  605.     L: Int64;
  606. {$ENDIF}
  607. begin
  608.     {$IFNDEF Ver120}
  609.     try
  610.         Result := StrToInt (S);
  611.     except
  612.         Result := 0;
  613.     end;
  614.     {$ELSE}
  615.     try
  616.         L := StrToInt64 (S);
  617.         if L > High (LongInt) then
  618.             Result := High (LongInt)
  619.         else if L < Low (LongInt) then
  620.             Result := Low (LongInt)
  621.         else
  622.             Result := L;
  623.     except
  624.         Result := 0;
  625.     end;
  626.     {$ENDIF}
  627. end;
  628.  
  629. {$IFDEF VER120}
  630. function Str2LWord (const S: String): LongWord;
  631. var
  632.     L: Int64;
  633. begin
  634.     try
  635.         L := StrToInt64 (S);
  636.         if L > High (LongWord) then
  637.             Result := High (LongWord)
  638.         else if L < Low (LongWord) then
  639.             Result := Low (LongWord)
  640.         else
  641.             Result := L;
  642.     except
  643.         Result := 0;
  644.     end;
  645. end;
  646. {$ENDIF}
  647.  
  648. function Str2Byte (const S: String): Byte;
  649. var
  650.     L: LongInt;
  651. begin
  652.     L := Str2LInt (S);
  653.     if L > High (Byte) then
  654.         Result := High (Byte)
  655.     else if L < Low (Byte) then
  656.         Result := Low (Byte)
  657.     else
  658.         Result := L;
  659. end;
  660.  
  661. function Str2SInt (const S: String): ShortInt;
  662. var
  663.     L: LongInt;
  664. begin
  665.     L := Str2LInt (S);
  666.     if L > High (ShortInt) then
  667.         Result := High (ShortInt)
  668.     else if L < Low (ShortInt) then
  669.         Result := Low (ShortInt)
  670.     else
  671.         Result := L;
  672. end;
  673.  
  674. function Str2Int (const S: String): Integer;
  675. begin
  676.     Result := Str2LInt (S);
  677. end;
  678.  
  679. function Str2SmallInt (const S: String): SmallInt;
  680. var
  681.     L: LongInt;
  682. begin
  683.     L := Str2LInt (S);
  684.     if L > High (SmallInt) then
  685.         Result := High (SmallInt)
  686.     else if L < Low (SmallInt) then
  687.         Result := Low (SmallInt)
  688.     else
  689.         Result := L;
  690. end;
  691.  
  692. function Str2Word (const S: String): Word;
  693. var
  694.     L: LongInt;
  695. begin
  696.     L := Str2LInt (S);
  697.     if L > High (Word) then
  698.         Result := High (Word)
  699.     else if L < Low (Word) then
  700.         Result := Low (Word)
  701.     else
  702.         Result := L;
  703. end;
  704.  
  705. function LInt2EStr (const L: LongInt): String;
  706. begin
  707.     try
  708.         Result := IntToStr (L);
  709.     except
  710.         Result := '';
  711.     end;
  712. end;
  713.  
  714. function LInt2ZBEStr (const L: LongInt): String;
  715. begin
  716.     if L = 0 then
  717.         Result := ''
  718.     else
  719.         try
  720.             Result := IntToStr (L);
  721.         except
  722.             Result := '';
  723.         end;
  724. end;
  725.  
  726. function Ext2EStr (const E: Extended; const Decimals: Byte): String;
  727. begin
  728.     try
  729.         Result := FloatToStrF (E, ffFixed, 18, Decimals)
  730.     except
  731.         Result := '';
  732.     end;
  733. end;
  734.  
  735. function Ext2EStr2 (const E: Extended; const Decimals: Byte): String;
  736. begin
  737.     Result := Ext2EStr (E, Decimals);
  738.     Result := StripTChStr (Result, '0');
  739.     if Length (Result) > 0 then
  740.         if Result [Length (Result)] = DecimalSeparator then
  741.             Result := LeftStr (Result, Length (Result) - 1);
  742. end;
  743.  
  744. function Ext2CEStr (const E: Extended; const Decimals: Byte): String;
  745. begin
  746.     try
  747.         Result := FloatToStrF (E, ffNumber, 18, Decimals)
  748.     except
  749.         Result := '';
  750.     end;
  751. end;
  752.  
  753. function Double2EStr (const D: Double; const Decimals: Byte): String;
  754. begin
  755.     try
  756.         Result := FloatToStrF (D, ffFixed, 15, Decimals)
  757.     except
  758.         Result := '';
  759.     end;
  760. end;
  761.  
  762. function Single2EStr (const S: Single; const Decimals: Byte): String;
  763. begin
  764.     try
  765.         Result := FloatToStrF (S, ffFixed, 7, Decimals)
  766.     except
  767.         Result := '';
  768.     end;
  769. end;
  770.  
  771. function Comp2EStr (const C: Comp): String;
  772. begin
  773.     try
  774.         Result := FloatToStrF (C, ffFixed, 18, 0)
  775.     except
  776.         Result := '';
  777.     end;
  778. end;
  779.  
  780. function Str2Ext (const S: String): Extended;
  781. begin
  782.     try
  783.         Result := StrToFloat (S);
  784.     except
  785.         Result := 0;
  786.     end;
  787. end;
  788.  
  789. function LInt2Str (const L: LongInt; const Len: Byte): String;
  790. begin
  791.     try
  792.         Result := IntToStr (L);
  793.     except
  794.         Result := '';
  795.     end;
  796.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  797. end;
  798.  
  799. function Byte2Str (const L: LongInt; const Len: Byte): String;
  800. begin
  801.     try
  802.         Result := IntToStr (L);
  803.     except
  804.         Result := '';
  805.     end;
  806.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  807. end;
  808.  
  809. function LInt2ZBStr (const L: LongInt; const Len: Byte): String;
  810. begin
  811.     Result := LInt2ZBEStr (L);
  812.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  813. end;
  814.  
  815. function LInt2ZStr (const L: LongInt; const Len: Byte): String;
  816. begin
  817.     Result := LInt2EStr (L);
  818.     Result := PadChLeftStr (LeftStr (Result, Len), '0', Len);
  819. end;
  820.  
  821. function LInt2CStr (const L : LongInt; const Len : Byte): string;
  822. begin
  823.     Result := LInt2CEStr (L);
  824.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  825. end;
  826.  
  827. function LInt2CEStr (const L : LongInt): string;
  828. var
  829.     LS, L2, I : Integer;
  830.     Temp : string;
  831. begin
  832.     Result := LInt2EStr (L);
  833.     LS := Length (Result);
  834.     L2 := (LS - 1) div 3;
  835.     Temp := '';
  836.     for I := 1 to L2 do
  837.         Temp :=  ThousandSeparator + Copy (Result, LS - 3 * I + 1, 3) + Temp;
  838.     Result := Copy (Result, 1, (LS - 1) mod 3 + 1) + Temp;
  839. end;
  840.  
  841. function Comp2CStr (const C : Comp; const Len : Byte): string;
  842. begin
  843.     Result := Comp2CEStr (C);
  844.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  845. end;
  846.  
  847. function Comp2CEStr (const C : Comp): string;
  848. var
  849.     LS, L, I : Integer;
  850.     Temp : string;
  851. begin
  852.     Result := Comp2EStr (C);
  853.     LS := Length (Result);
  854.     L := (LS - 1) div 3;
  855.     Temp := '';
  856.     for I := 1 to L do
  857.         Temp :=  ThousandSeparator + Copy (Result, LS - 3 * I + 1, 3) + Temp;
  858.     Result := Copy (Result, 1, (LS - 1) mod 3 + 1) + Temp;
  859. end;
  860.  
  861. function Ext2Str (const E: Extended; const Len, Decimals: Byte): String;
  862. begin
  863.     try
  864.         Result := FloatToStrF (E, ffFixed, 18, Decimals)
  865.     except
  866.         Result := '';
  867.     end;
  868.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  869. end;
  870.  
  871. function Double2Str (const D: Double; const Len, Decimals: Byte): String;
  872. begin
  873.     try
  874.         Result := FloatToStrF (D, ffFixed, 15, Decimals)
  875.     except
  876.         Result := '';
  877.     end;
  878.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  879. end;
  880.  
  881. function Single2Str (const S: Single; const Len, Decimals: Byte): String;
  882. begin
  883.     try
  884.         Result := FloatToStrF (S, ffFixed, 7, Decimals)
  885.     except
  886.         Result := '';
  887.     end;
  888.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  889. end;
  890.  
  891. function Comp2Str (const C: Comp; const Len: Byte): String;
  892. begin
  893.     try
  894.         Result := FloatToStrF (C, ffFixed, 18, 0)
  895.     except
  896.         Result := '';
  897.     end;
  898.     Result := PadChLeftStr (LeftStr (Result, Len), NumPadCh, Len);
  899. end;
  900.  
  901. function LeftStr (const S : string; const N : Integer): string;
  902. begin
  903.     Result := Copy (S, 1, N);
  904. end;
  905.  
  906. function LeftAlignStr (const S : string; const N : Integer): string;
  907. begin
  908.     Result := PadRightStr (Copy (S, 1, N), N);
  909. end;
  910.  
  911. function RightAlignStr (const S : string; const N : Integer): string;
  912. begin
  913.     Result := PadLeftStr (Copy (S, 1, N), N);
  914. end;
  915.  
  916. function RightStr (const S : string; const N : Integer): string;
  917. var
  918.     M: Integer;
  919. begin
  920.     M := Length (S) - N + 1;
  921.     if M < 1 then
  922.         M := 1;
  923.     Result := Copy (S, M, N);
  924. end;
  925.  
  926. function LeftTillStr (const S : string; const Ch : Char): string;
  927. var
  928.     M: Integer;
  929. begin
  930.     M := Pos (Ch, S);
  931.     if M < 2 then
  932.         Result := ''
  933.     else
  934.         Result := Copy (S, 1, M - 1);
  935. end;
  936.  
  937. function RightAfterStr (const S : String; const N : Integer): String;
  938. begin
  939.     Result := Copy (S, N + 1, Length (S) - N );
  940. end;
  941.  
  942. function RightAfterChStr (const S : String; const Ch : Char): String;
  943. var
  944.     M: Integer;
  945. begin
  946.     M := Pos (Ch, S);
  947.     if M = 0 then
  948.         Result := ''
  949.     else
  950.         Result := Copy (S, M + 1, Length (S) - M);
  951. end;
  952.  
  953. function StripChStr (const S : string; const Ch: Char): string;
  954. begin
  955.     Result := StripTChStr (StripLChStr (S, Ch), Ch);
  956. end;
  957.  
  958. function StripTChStr (const S : string; const Ch: Char): string;
  959. var
  960.     Len: Integer;
  961. begin
  962.     Len := Length (S);
  963.     while (Len > 0) and (S [Len] = Ch) do
  964.         Dec (Len);
  965.     if Len = 0 then
  966.         Result := ''
  967.     else
  968.         Result := Copy (S, 1, Len);
  969. end;
  970.  
  971. function StripLChStr (const S : string; const Ch: Char): string;
  972. var
  973.     I, Len: Integer;
  974. begin
  975.     Len := Length (S);
  976.     I := 1;
  977.     while (I <= Len) and (S [I] = Ch) do
  978.         Inc (I);
  979.     if (I > Len) then
  980.         Result := ''
  981.     else
  982.         Result := Copy (S, I, Len - I + 1);
  983. end;
  984.  
  985. function ReplaceChStr (const S : string;
  986.     const OldCh, NewCh : Char): string;
  987. var
  988.     I: Integer;
  989. begin
  990.     Result := S;
  991.     if OldCh = NewCh then
  992.         Exit;
  993.     for I := 1 to Length (S) do
  994.         if S [I] = OldCh then
  995.             Result [I] := NewCh;
  996. end;
  997.  
  998. function FillStr (const Ch : Char; const N : Integer): string;
  999. begin
  1000.     SetLength (Result, N);
  1001.     FillChar (Result [1], N, Ch);
  1002. end;
  1003.  
  1004. function BlankStr (const N : Integer): string;
  1005. begin
  1006.     Result := FillStr (' ', N);
  1007. end;
  1008.  
  1009. function DashStr (const N : Integer): string;
  1010. begin
  1011.     Result := FillStr ('-', N);
  1012. end;
  1013.  
  1014. function DDashStr (const N : Integer): string;
  1015. begin
  1016.     Result := FillStr ('=', N);
  1017. end;
  1018.  
  1019. function LineStr (const N : Integer): string;
  1020. begin
  1021.     Result := FillStr (#196, N);
  1022. end;
  1023.  
  1024. function DLineStr (const N : Integer): string;
  1025. begin
  1026.     Result := FillStr (#205, N);
  1027. end;
  1028.  
  1029. function StarStr (const N : Integer): string;
  1030. begin
  1031.     Result := FillStr ('*', N);
  1032. end;
  1033.  
  1034. function HashStr (const N : Integer): string;
  1035. begin
  1036.     Result := FillStr ('#', N);
  1037. end;
  1038.  
  1039. function PadRightStr (const S : string; const Len : Integer): string;
  1040. var
  1041.     N: Integer;
  1042. begin
  1043.     N := Length (S);
  1044.     if N < Len then
  1045.         Result := S + BlankStr (Len - N)
  1046.     else
  1047.         Result := S;
  1048. end;
  1049.  
  1050. function PadLeftStr (const S : string; const Len : Integer): string;
  1051. var
  1052.     N: Integer;
  1053. begin
  1054.     N := Length (S);
  1055.     if N < Len then
  1056.         Result := BlankStr (Len - N) + S
  1057.     else
  1058.         Result := S;
  1059. end;
  1060.  
  1061. function CentreStr (const S : String; const Len : Integer): String;
  1062. var
  1063.     N, M: Integer;
  1064. begin
  1065.     N := Length (S);
  1066.     if N < Len then
  1067.     begin
  1068.         M := Len - N;
  1069.         if Odd (M) then
  1070.             Result := BlankStr (M div 2) + S
  1071.                 + BlankStr (M div 2 + 1)
  1072.         else
  1073.             Result := BlankStr (M div 2) + S
  1074.                 + BlankStr (M div 2);
  1075.     end
  1076.     else
  1077.         Result := S;
  1078. end;
  1079.  
  1080. function PadChRightStr (const S : string; const Ch : Char;
  1081.     const Len : Integer): string;
  1082. var
  1083.     N: Integer;
  1084. begin
  1085.     N := Length (S);
  1086.     if N < Len then
  1087.         Result := S + FillStr (Ch, Len - N)
  1088.     else
  1089.         Result := S;
  1090. end;
  1091.  
  1092. function PadChLeftStr (const S : string; const Ch : Char;
  1093.     const Len : Integer): string;
  1094. var
  1095.     N: Integer;
  1096. begin
  1097.     N := Length (S);
  1098.     if N < Len then
  1099.         Result := FillStr (Ch, Len - N) + S
  1100.     else
  1101.         Result := S;
  1102. end;
  1103.  
  1104. function CentreChStr (const S : String; const Ch : Char;
  1105.     const Len : Integer): String;
  1106. var
  1107.     N, M: Integer;
  1108. begin
  1109.     N := Length (S);
  1110.     if N < Len then
  1111.     begin
  1112.         M := Len - N;
  1113.         if Odd (M) then
  1114.             Result := FillStr (Ch, M div 2) + S
  1115.                 + FillStr (Ch, M div 2 + 1)
  1116.         else
  1117.             Result := FillStr (Ch, M div 2) + S
  1118.                 + FillStr (Ch, M div 2);
  1119.     end
  1120.     else
  1121.         Result := S;
  1122. end;
  1123.  
  1124. function Boolean2TF (const B : Boolean): Char;
  1125. begin
  1126.     if B then
  1127.         Result := 'T'
  1128.     else
  1129.         Result := 'F';
  1130. end;
  1131.  
  1132. function Boolean2YN (const B : Boolean): Char;
  1133. begin
  1134.     if B then
  1135.         Result := 'Y'
  1136.     else
  1137.         Result := 'N';
  1138. end;
  1139.  
  1140. function Boolean2Char (const B : Boolean;
  1141.     TrueChar, FalseChar: Char): Char;
  1142. begin
  1143.     if B then
  1144.         Result := TrueChar
  1145.     else
  1146.         Result := FalseChar;
  1147. end;
  1148.  
  1149. function TF2Boolean (const Ch : Char): Boolean;
  1150. begin
  1151.     Result := Ch in ['T', 't'];
  1152. end;
  1153.  
  1154. function YN2Boolean (const Ch : Char): Boolean; assembler;
  1155. begin
  1156.     Result := Ch in ['Y', 'y'];
  1157. end;
  1158.  
  1159. procedure ClearAllLBits (var Body: TLongBitList);
  1160. begin
  1161.     Body:= $00000000
  1162. end;
  1163.  
  1164. procedure SetAllLBits (var Body: TLongBitList);
  1165. begin
  1166.     Body:= $FFFFFFFF
  1167. end;
  1168.  
  1169. procedure FlipAllLBits (var Body: TLongBitList);
  1170. begin
  1171.     Body:= Body xor $FFFFFFFF
  1172. end;
  1173.  
  1174. procedure ClearLBit (var Body: TLongBitList; const I: Byte);
  1175. begin
  1176.     Body:= Body and (not (TLongBitList (1) shl I))
  1177. end;
  1178.  
  1179. procedure SetLBit (var Body: TLongBitList; const I: Byte);
  1180. begin
  1181.     Body:= Body or (TLongBitList (1) shl I)
  1182. end;
  1183.  
  1184. procedure FlipLBit (var Body: TLongBitList; const I: Byte);
  1185. begin
  1186.     Body:= Body xor (TLongBitList (1) shl I)
  1187. end;
  1188.  
  1189. function LBitIsSet (const Body: TLongBitList; const I: Byte): Boolean;
  1190. begin
  1191.     Result := (Body and (TLongBitList (1) shl I)) <> 0
  1192. end;
  1193.  
  1194. function LBits2Str (const Body: TLongBitList): String32;
  1195. var
  1196.     I: Integer;
  1197. begin
  1198.     SetLength (Result, 32);
  1199.     for I := 0 to 32 do
  1200.         if LBitIsSet (Body, I) then
  1201.             Result [I + 1] := '1'
  1202.         else
  1203.             Result [I + 1] := '0';
  1204. end;
  1205.  
  1206. end.
  1207.  
  1208.  
  1209.