home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S1.ARC / COPYSTOA.MOD < prev    next >
Encoding:
Text File  |  1987-12-08  |  4.0 KB  |  84 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                 CopyStoA -- Copy string to character array               *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE CopyStoA( S : AnyStr; VAR A ; Length_A : INTEGER );
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*    Procedure: CopyStoA                                                   *)
  10. (*                                                                          *)
  11. (*    Purpose:   Copies string to character array, blank fill               *)
  12. (*                                                                          *)
  13. (*    Calling Sequence:                                                     *)
  14. (*                                                                          *)
  15. (*       CopyStoA( S : AnyStr; VAR A ; Length_A: INTEGER );                 *)
  16. (*                                                                          *)
  17. (*          S        --- String to be copied                                *)
  18. (*          A        --- Character array to be copied into                  *)
  19. (*          Length_A --- No. of characters in A                             *)
  20. (*                                                                          *)
  21. (*    Calls:  None                                                          *)
  22. (*                                                                          *)
  23. (*--------------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    I    : INTEGER;
  27.    AA   : PACKED ARRAY[ 1 .. 1 ] OF CHAR ABSOLUTE A;
  28.  
  29. BEGIN (* CopyStoA *)
  30.  
  31.    FillChar( AA[1], Length_A, ' ' );
  32.    MOVE    ( S [1], AA[1],    MIN( Length_A , LENGTH( S ) ) );
  33.  
  34. END   (* CopyStoA *);
  35.  
  36. (*--------------------------------------------------------------------------*)
  37. (*       CopyS2AR -- Copy string to character array, right adjust           *)
  38. (*--------------------------------------------------------------------------*)
  39.  
  40. PROCEDURE CopyS2AR( S : AnyStr; VAR A ; Length_A : INTEGER );
  41.  
  42. (*--------------------------------------------------------------------------*)
  43. (*                                                                          *)
  44. (*    Procedure: CopyS2AR                                                   *)
  45. (*                                                                          *)
  46. (*    Purpose:   Copies string to character array, blank fill on left       *)
  47. (*                                                                          *)
  48. (*    Calling Sequence:                                                     *)
  49. (*                                                                          *)
  50. (*       CopyS2AR( S : AnyStr; VAR A ; Length_A: INTEGER );                 *)
  51. (*                                                                          *)
  52. (*          S        --- String to be copied                                *)
  53. (*          A        --- Character array to be copied into                  *)
  54. (*          Length_A --- No. of characters in A                             *)
  55. (*                                                                          *)
  56. (*    Calls:  None                                                          *)
  57. (*                                                                          *)
  58. (*--------------------------------------------------------------------------*)
  59.  
  60. VAR
  61.    I        : INTEGER;
  62.    Len_S    : INTEGER;
  63.    Len_A    : INTEGER;
  64.    L        : INTEGER;
  65.    AA       : PACKED ARRAY[ 1 .. 1 ] OF CHAR ABSOLUTE A;
  66.  
  67. BEGIN (* CopyS2AR *)
  68.  
  69.    Len_S  := LENGTH( S );
  70.    Len_A  := Length_A;
  71.    L      := MIN( Len_A , Len_S );
  72.  
  73.    FOR I := 1 TO L DO
  74.       BEGIN
  75.          AA[Len_A] := S[Len_S];
  76.          DEC( Len_A );
  77.          DEC( Len_S );
  78.       END;
  79.  
  80.    FOR I := Len_A DOWNTO 1 DO
  81.       AA[I] := ' ';
  82.  
  83. END   (* CopyS2AR *);
  84.