home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 04 / tricks / position.inc < prev    next >
Encoding:
Text File  |  1990-01-15  |  2.1 KB  |  55 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     POSITION.INC                       *)
  3. (*      erweiterte POS - Funktion für Turbo Pascal        *)
  4. (*          (c) 1990  Stephan Pietzko & TOOLBOX           *)
  5. (* ------------------------------------------------------ *)
  6.  
  7.  
  8. (* für Turbo 3.0 ist der TYPE STRING ohne Angabe der      *)
  9. (* Länge nicht zulässig, der Kopf der FUNCTION könnte     *)
  10. (* z.B. wie folgt aussehen:                               *)
  11. (*                                                        *)
  12. (* TYPE String_255 = STRING [255];                        *)
  13. (*                                                        *)
  14. (* FUNCTION Position(Nr        : INTEGER;
  15.                      Substr, S : String_255) : BYTE;      *)
  16.  
  17.  
  18.   FUNCTION Position(Nr        : INTEGER;
  19.                     Substr, S : STRING) : BYTE;
  20.  
  21.   (* Position sucht S nach dem Nr ten Vorkommen von       *)
  22.   (* Substr ab. Ist Nr z.B. 2, so wird die Position des 2.*)
  23.   (* Vorkommens ausgegeben. Ist Nr < 0, so wird die Nr te *)
  24.   (* Position von hinten gesucht. Ist Nr = 0, so ist das  *)
  25.   (* Funktionsergebnis die Anzahl des Vorkommens von      *)
  26.   (* Substr in S.                                         *)
  27.   (* Nur wenn Substr in S mindestens Nr mal vollständig   *)
  28.   (* enthalten ist, liefert die Funktion die Position des *)
  29.   (* Zeichens in S zurück, mit dem Substr zum Nr ten mal  *)
  30.   (* beginnt. Ansonsten ist das Ergebnis 0.               *)
  31.  
  32.   VAR
  33.     i, j : BYTE;
  34.     ii   : ARRAY [0..255] of BYTE;
  35.   BEGIN
  36.     j     := 0;
  37.     ii[0] := 0;
  38.     REPEAT
  39.       Inc(j);           (* für Turbo 3.0 :  j := SUCC(j); *)
  40.       i := Pos(Substr, S);
  41.       ii[j] := ii[j-1] + i;
  42.       S := Copy(S, i+1, 255);
  43.     UNTIL i = 0;
  44.     IF Nr = 0 THEN
  45.       Position := j - 1
  46.     ELSE
  47.       IF Abs(Nr) >= j THEN
  48.         Position := 0
  49.       ELSE
  50.         IF Nr < 0 THEN Position := ii[j + Nr]
  51.                   ELSE Position := ii[Nr];
  52.   END;
  53. (* ------------------------------------------------------ *)
  54. (*                Ende von POSITION.INC                   *)
  55.