home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / RA / RAOPP.ZIP / GETWORD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-14  |  2.1 KB  |  90 lines
  1. {  GetWord - Several String Manipulations  }
  2. {  Captured from FidoNet PASCAL echo  }
  3. {  Public Domain, I assume  }
  4. {  courtesy of RodentWare  }
  5. {  Michae Reece / James Calvert  }
  6.  
  7. Unit GetWord;
  8.  
  9. interface
  10.  
  11. function Get_Word(st:string; num:integer):string;
  12. function Del_Space(st:string; fb:integer):string;
  13. procedure No_space(var st:string);
  14.  
  15. implementation
  16.  
  17. function Get_Word(st:string; num:integer):string;
  18. var
  19.    i,a : integer;
  20.    tmp : string[15];
  21. begin
  22.    tmp := '';
  23.    i := 0;
  24.    a := 0;
  25.    if num = 1 then
  26.      begin                        { if first word wanted }
  27.        repeat;
  28.          inc(i);
  29.          if st[i] <> #32 then
  30.            tmp := tmp + st[i];
  31.        until (st[i] = #32) or (i = ord(st[0]));
  32.      end
  33.    else
  34.      begin
  35.        repeat;
  36.          inc(i);                  { if any others wanted }
  37.          if st[i] = #32 then
  38.            inc(a);
  39.        until (a = num-1) or (i = ord(st[0]));
  40.        repeat;
  41.          inc(i);
  42.          if st[i] in [#33..#94,#97..#126] then
  43.            tmp := tmp + st[i];
  44.        until (st[i] = #32) or (i = ord(st[0]));
  45.      end;
  46.    Get_Word := tmp;
  47. end;
  48.  
  49. function Del_Space(st:string; fb:integer):string;
  50. var
  51.    i,a,x : integer;
  52.    tmp : string[15];
  53. begin                                { fb = 0....del leading  }
  54.    tmp := st;                        { fb = 1....del trailing }
  55.    i := 1;                           { fb = 2....do both      }
  56.    if (fb = 0) or (fb = 2) then
  57.      begin
  58.        while st[i] = #32 do
  59.          begin
  60.            inc(i);
  61.          end;
  62.      tmp := copy(st,i,ord(st[0]));
  63.      end;
  64.    if (fb = 1) or (fb = 2) then
  65.      begin
  66.        a := ord(tmp[0]);
  67.        while tmp[a] = #32 do
  68.          begin
  69.            dec(a);
  70.          end;
  71.        tmp := copy(tmp,1,a);
  72.      end;
  73.    Del_Space := tmp;
  74. end;
  75.  
  76. {  procedure No_Space - Removes all double spaces from St  }
  77. {  added by Michael Reece, RodentWare  }
  78.  
  79. procedure no_space(var st:string);
  80.   var x,y,z : integer;
  81.   begin
  82.     for x:=1 to length(st) do
  83.     begin
  84.       If (St[x]=#32) and (st[x+1]=#32) then
  85.         delete(St,x,1);
  86.     end;
  87.   end;
  88.  
  89. end.
  90.