String intelligent Kürzen

[BBoy]

Wie ihr das so auf die schnelle hin bekommt

Wie viele Buchstaben max. gelöscht werden sollen? Der String ist max. 128 Zeichen lang. Aber das kommt eigentlich nie vor. Schätze die max. länge des Strings auf etwa 50 oder 60.

Bei der Version von himitsu stimmt zwar immer die Länge aber es werden nicht alle Worte ausgegeben. So wird aus "Lorscher Geschichte Laurissa" leider nur "LorscherGeschi" das Wort "Laurissa" oder wenigstens ein teil davon kommt leider nicht. Aber das wäre wichtig. Da z.B. mehrere ähnliche Bezeichnungen vorkommen können:
"Lorscher Geschichte Laurissa"
"Lorscher Geschichte Mathilde"
usw...

Ich bin euch beiden echt Dankbar!! Ohne Euch wäre ich voll aufgeschmissen

Geht es nicht irgendwie das er in bestimmten Fällen halt 15 Zeichen zurück gibt und man dann wieder eins löscht (aber keine zahl am ende)?

[mkinzler]

Man könnte meine Version leicht anpassen, dass das letzte Wort komplett angehängt wird und dann auf nlen gekürzt wird

Delphi-Quellcode:

function KuerzeDateiname( orig: string; nlen: Integer): string;
var
  sl: TStrings;
  s, s2, res: string;
  i, j, g, k, ab: Integer;
begin
   k := 0;
   //Zahl am Ende erkennen und abtrennen
   s2 := '';
   i := length( orig);
   while orig[i] in [ '0'..'9'] do
       dec(i);
   if i < length( orig) then
   begin
       s2 := Copy( orig, i+1, length(orig) - i + 1 );
       Delete( orig, i+1, length( orig) - i + 1);
       nlen := nlen - Length(s2) - 1;
   end;
   //Ungueltige Zeichen entfernen
   s := '';
   Orig := Trim(Orig);
   for i := 1 to length( orig) do
   begin
       if orig[i] in [' ', 'a'..'z', 'A'..'Z'] then
           s := s + orig[i];
   end;
   //Nach Wörter trennen
   try
        sl := TStringList.Create;
        sl.Delimiter := ' ';
        sl.StrictDelimiter := True;
        sl.DelimitedText := s;
        ab := nlen DIV sl.Count; //Anzahl Buchstaben pro Wort
        for i := 0 to sl.Count -2 do
        begin
            g := min( Length( sl[i]), ab+k);
            if Length( sl[i]) < ab+k then
                k := ab+k - Length( sl[i])
            else
                k := 0;
            for j := 1 to g do
            begin
                res := res + sl[i][j];
            end;
        end;
        inc(i);
        res := res + sl[i];
        res := Copy( res, 1, nlen);
        result := res + s2;
   finally
       sl.Free;
  end;
end;

[himitsu]

Wenn man Code blind schreibt und nicht prüft
- waren eigentlich nur 2 Fehler ' ' wurde als ungültiges Zeichen mit gelöscht
- und beim Zahlenentfernen war ein NOT zuviel (sei froh, daß keine Zahl vorkam, sonst wären alle -buchstaben gelöscht wurden )
> hab's im Post #10 geändert

Delphi-Quellcode:

type TKueDatErlaubt = function(S: String): Boolean;
// type TKueDatErlaubt = function(S: String): Boolean of object;  // für Objektmethoden
// type TKueDatErlaubt = reference to function(S: String): Boolean;  // ab D2010 für Alles

function KuerzeDateiname(S: String; Len: Integer; Erlaubt: TKueDatErlaubt): String;
var
  i, i2, u: Integer;
  SL: TStrings;
  US: record
    case Integer of
      0: (i: Int64);
      1: (s: Set of 0..63);
  end;
begin
  // ungültige Zeichen entfernen
  for i := Length(S) downto 1 do
    if not (S[i] in [' ', 'a'..'z', 'A'..'Z', '0'..'9']) then
      Delete(S, i, 1);
  // ungültige Zahlen entfernen
  while (i > 0) and (S[i] in ['0'..'9']) do
    Dec(i);
  for i := i downto 1 do
    if (S[i] in ['0'..'9']) then
      Delete(S, i, 1);
  //
  SL := TStringList.Create;
  try
    US.s := [];
    repeat
      U := 0;
      // String aufsplitten
      SL.LineBreak := '';
      SL.Delimiter := ' ';
      SL.StrictDelimiter := True;
      SL.DelimitedText := S;
      // längstes Wort suchen + Capitalize
      i2 := 0;
      for i := SL.Count -1 downto 0 do begin
        SL[i] := UpperCase(Copy(SL[i], 1, 1)) + LowerCase(Copy(SL[i], 2));
        i2 := Max(i2, Length(SL[i]));
      end;
      // Anzahl der zu entfernenden Zeichen
      Len := Length(SL.Text) - Len;
      // kurze Wörter (Einzelbuchstaben) entfernen
      i := SL.Count - 1;
      while (Len > 0) and (i >= 0) do begin
        if Length(SL[i]) = 1 then begin
          if not (U in US.s) then begin
            SL.Delete(i);
            Dec(Len);
          end;
          Inc(U);
        end;
        Dec(i);
      end;
      // Wörter kürzen
      i := -1;
      while (Len > 0) do begin
        if i < 0 then begin
          i := SL.Count - 1;
          Dec(i2);
        end;
        if Length(SL[i]) > i2 then begin
          if not (U in US.s) then begin
            SL[i] := Copy(SL[i], 1, i2) + Copy(SL[i], i2 + 2);
            Dec(Len);
          end;
          Inc(U);
        end;
        Dec(i);
      end;
      // nächstes Set, für's Überspringen
      Inc(US.i);
      // Text zusammensetzen und ausgeben
      Result := SL.Text;
    until Erlaubt(Result);
  finally
    SL.Free;
  end;
end;

[BBoy]

@himitsu,
Bei           if not (U in US) then begin kommt "[DCC Fehler] Unit2.pas(2299): E2015 Operator ist auf diesen Operandentyp nicht anwendbar" das soll wohl us.s heißen, oder?

und am ende das until  until Erlaubt(Result); kann auch nicht stimmen, wie soll das richtig heißen?


@mkinzler, das würde mir auch genügen. Werde das später mal testen.

Noch mal vielen Dank ihr beiden....

[himitsu]

.s = jupp

und das Until sollte so stimmen ... Wieso, was stimmt denn daran nicht?

[BBoy]

Sorry, aber mal ganz blöd gefragt, wie rufe ich diese funktion auf?

memo1.text := KuerzeDateiname(edit1.Text,14, ??) < was kommt da hin?

[mkinzler]

Eine Funktion, welche wagr oder falsch zurückliefert, je nachdem ob gekürzt werden darf oder nicht

[BBoy]

Sowas hatte ich noch nie Das verstehe ich jetzt gar nicht. Ein False oder True ist es nicht. Was soll ich denn in diese funktion schreiben?

[mkinzler]

Die Funktion bekommt den aktuellen String als parameter. Anhand diesem muss sie entscheiden, ob dieser ok ist.

Delphi-Quellcode:

function SchonOK( s: string): Boolean;
begin
   ...
end;

...
memo1.text := KuerzeDateiname(edit1.Text,14, SchonOK);

[BBoy]

OK, dort überprüfe ich dann z.B. ob de Name schon vorhanden ist. Das funktioniert alles gut.
Nur ist mir aufgefallen das Zahlen am Ende nicht berücksichtigt werden. Aus "Bellenkrappen Mannheim 2" macht er "BellenkMannhei" aber zahlen am Ende müssen immer erhalten bleiben.
Wie könnte man das in der Version von himitsu noch nachbessern?
thx

Ich glaube es liegt daran das kurze wörter gelöscht werden. So wird also eine ziffer als zu kurz gewertet und gelöscht:

Delphi-Quellcode:

        if Length(SL[i]) = 1 then begin
          if not (U in US.s) then begin
            SL.Delete(i);
            Dec(Len);
          end;

zu was ist eigentlich der Record US da?