// Dieser Code entstand wieder einmal auf eine EMail-Anfrage.
// Es wurde eine Möglichkeit gesucht, mittels eines Eingabefeldes,
// welches oberhalb einer Tabelle bzw. eines Listenfeldes steht,
// Zahlen durch eine oder zwei Bedingungen zu filtern, wobei die
// Zeichen < = > zum Einsatz kommen sollten. Außerdem sollte bei
// zwei Bedingungen eine Verknüpfung durch "or" oder "and" möglich
// sein. Zum besseren Verständnis hier ein paar Möglichkeiten, wie
// die Bedingungen aussehen können:

// '<20 and >10' oder auch '<20 & >10' oder auch '<20 >10'
// bedeutet: Der Vergleichswert muss kleiner als Zwanzig sein,
// aber gleichzeitig auch größer als Zehn. Die Besonderheit ist
// hier, dass beim letzten Beispiel kein "and" oder "or" angegeben
// ist. Das wird vom Code immer als "and" interpretiert.

// '=33,2' oder auch '33,2'
// Der Vergleichswert muss genau Dreiunddreißig Komma Zwei sein.
// Wie man sieht, kann in diesem Fall das Gleichheitszeichen
// weggelassen werden.

// '>=100,0 v <50,0' oder auch '>=100,0 oder <50,0'
// Alle Werte, die kleiner sind als Fünzig, sowie alle Werte von
// Hundert an aufwärts werden akzeptiert.

// '10 or >=100'
// Werte ab Hundert aufwärts, aber auch ein Wert von genau Zehn
// sind erlaubt.

// Schlussbemerkung: Es ist nur möglich eine oder zwei Bedingungen
// zu formulieren. '<4 or >50 or =33' führt zu einer Fehlermeldung.

// Getestet mit D4 unter XP
 

type 
  uo = array[0..2] of string; 
 
var 
  o: uo = ('or', 'oder', 'v'); 
  // bedeutet: eins von beiden oder beides 
 
  u: uo = ('and', 'und', '&'); 
   // bedeutet: eins und gleichzeitig auch das andere 
 
function precondition(n, s: string): byte; 
var 
  v1, v2: byte; 
  s1, s2: string; 
  p, lg: integer; 
  z, nmbr: extended; 
  und, oder, erg, ergu, nuno: boolean; 
  procedure makes1; 
  begin 
    s1 := trim(copy(s, 1, p - 1)); 
    delete(s, 1, p - 1 + lg); 
    s := trim(s); 
  end; 
  function undoder(w: uo): boolean; 
  var x: integer; 
  begin 
    result := false; 
    for x := 0 to high(w) do begin 
      p := pos(w[x], s); 
      if p > 0 then begin 
        lg := length(w[x]); 
        break; 
      end; 
    end; 
    if p = 0 then exit; 
    makes1; 
    result := true; 
  end; 
  procedure makev(out v: byte); 
  begin 
    v := 0; 
    if copy(s, 1, 1) = '=' then begin 
      v := 1; 
      delete(s, 1, 1); 
    end else begin 
      if copy(s, 1, 1) = '<' then v := 2 else 
        if copy(s, 1, 1) = '>' then v := 4 else exit; 
      delete(s, 1, 1); 
      if copy(s, 1, 1) = '=' then begin 
        inc(v); 
        delete(s, 1, 1); 
      end; 
    end; 
  end; 
  function testen(vv: byte): boolean; 
  begin 
    case vv of 
      2: result := nmbr < z; 
      3: result := nmbr <= z; 
      4: result := nmbr > z; 
      5: result := nmbr >= z; 
    else result := nmbr = z; 
    end; 
  end; 
begin 
  result := 2; 
  s := lowercase(trim(s)); 
  s := stringreplace(s, ThousandSeparator, '', [rfreplaceall]); 
  s := stringreplace(s, '+', '', [rfreplaceall]); 
  if s = '' then exit;
  n := stringreplace(n, #32, '', [rfreplaceall]); 
  try    
    nmbr := StrToFloat(n); 
    oder := false; 
    s1 := ''; 
    makev(v1); 
    und := undoder(u); 
    if not und then oder := undoder(o); 
    if s1 = '' then begin 
      lg := 0; 
      p := pos('<', s); 
      if p = 0 then p := pos('>', s); 
      if p = 0 then p := pos('=', s); 
      if p = 0 then p := pos(#32, s); 
      if p > 0 then makes1; 
    end; 
    makev(v2); 
    s2 := trim(s); 
    if (v2 = 0) and (s1 = '') then begin 
      s1 := s2; 
      s2 := ''; 
    end; 
    nuno := not und and not oder; 
    if nuno then und := s2 <> ''; 
    if ((v2 > 0) or oder or und) and (s2 = '') then exit; 
    z := StrToFloat(s1); 
    result := 1; 
    erg := testen(v1); 
    if ((s2 = '') or oder) and erg 
      then result := 0; 
    if nuno or (result = 0) then exit; 
    if oder then erg := true; 
    z := StrToFloat(s2); 
    ergu := testen(v2); 
    result := ord(not (erg and ergu)); 
  except 
    result := 2; 
  end; 
end; 
 
// --- Beispielaufrufe --- 
 
// einzelene Zahl mit einer Bedingung vergleichen 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  case precondition('33,9e-2', '>0 and <1') of 
    0: showmessage('ok'); 
    1: showmessage('nein'); 
    2: showmessage('Syntax-Fehler'); 
  end; 
end; 
 
// Einträge einer Listbox werden entfernt, 
// wenn sie nicht der Bedingung in Edit1 entsprechen. 
 
procedure TForm1.Button2Click(Sender: TObject); 
var x: integer; 
  b: byte; 
begin 
  x := 0; 
  with Listbox1 do 
    while x < items.count do begin 
      if items[x] = '' then 
        items.delete(x) 
      else begin 
        b := precondition(items[x], Edit1.Text); 
        if b = 2 then raise exception.create('Syntaxfehler'); 
        if b = 1 then items.delete(x) 
        else inc(x); 
      end; 
    end; 
end;