String intelligent Kürzen

[BBoy]

Habe folgendes Problem. Ein String der eine Bezeichnung enthält muss auf 14 Zeichen gekürzt werden. Aber nicht einfach abgeschnitten, sondern eben Intelligent.

1. Aus der Bezeichnung sollen alle Sonderzeichen und Satzzeichen entfernt werden. nur a-z, A-Z und 0-9 sollen erhalten bleiben
2. Ist am Ende der Bezeichnung eine Zahl so muss diese erhalten bleiben
3. Aus der Bezeichnung sollen alle Leerzeichen entfernt werden.

Ich denke man müsste zuerst berechnen wie viele Worte der String hat, und dann von jedem Wort ein paar Anfangsbuchstaben nehmen. Wobei es gut wäre wenn vom ersten Wort mehr Buchstaben genommen werden als von den nächsten. Zudem muss jeder Name einmalig sein. Sollte ein Name doppelt sein, müsste dieser anders benannt werden.

Bsp:
aus "Kitho´s Serie Teil 3" sollte "KithoSeriTeil3" werden.
aus "Lorscher Geschichte 'Laurissa'" sollte "LorschGescLaur" werden
aus "Die Rheinblick Serie 12" sollte "DieRheinblSe12" werden.

Hat von euch jemand eine Idee wie ich das verwirklichen kann?
Danke!

[mkinzler]

-Zuerst die Überprüfung/ggf Trennung der Zahl
-Druchgehen Rest und Zeichen Löschen wenn nicht in [0..9][a..Z] oder leerzeichen
-Trenner nach Wörter
-Berechnung Buchstaben pro Wort: Restlänge ( 14 - Länge Zahl) / Anzahl Wörter
-Kopieren der Buchstaben
-Zahl wieder anhängen

[BBoy]

Vor allem mit diesem Punkt habe ich Probleme: -Berechnung Buchstaben pro Wort: Restlänge ( 14 - Länge Zahl) / Anzahl Wörter
Könnte mir das bitte jemand anhand dieses Beispiels erklären: aus "Lorscher Geschichte 'Laurissa'" sollte "LorschGescLaur" werden ?? Ein Codeschnipsel wäre super, da ich echt kein plan habe wie ich das machen soll.

[mkinzler]

In etwa so

Delphi-Quellcode:

function KuerzeDateiname( orig: string): string;
var
  sl: TStrings;
  s: string;
  i, j, g, ab: Integer;
begin
   //Ungueltige Zeichen entfernen
   s := '';
   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 := 14 DIV sl.Count; //Anzahl Buchstaben pro Wort
        for i := 0 to sl.Count -1 do
        begin
            g := min( Length( sl[i]), ab);
            for j := 1 to g do
            begin
                result := result + sl[i][j];
            end;
        end;
   finally
       sl.Free;
  end;
end;

Es besteht natürlich noch Überarbeitungsbedarf

[BBoy]

Danke.

Zitat:

Es besteht natürlich noch Überarbeitungsbedarf ( z.B. wenn ein Wort kürzer ist, als die zu kopierende Anzahl von Buchstaben)

Aber eben darin sehe ich ein Problem das ich nicht zu lösen weiß. Denn wenn wörter kürzer sind, soll es ja von den vorherigen dementsprechend mehr Buchstaben nehmen, aber auch das muss erst geprüft werden ob da genug vorhanden sind. Wenn nicht muss er vom nächsten Wort mehr Buchstaben nehmen aber auch da muss erst wieder geprüft werden ob es geht. Und genau das wir schwer finde ich..... oder gibt es da eine Möglichkeit das doch recht einfach zu lösen?

[mkinzler]

Ich habe den Code nochmal etwas überarbeitet/erweitert

-es werden nun Zahlen am Ende erhalten
-man kann die Ziellänge angeben
-Unterdeckungen ( weil Wort zu kurz) wird auf andere Wörter verteilt

Delphi-Quellcode:

function KuerzeDateiname( orig: string; nlen: Integer): string;
var
  sl: TStrings;
  s, s2: 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 -1 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
                result := result + sl[i][j];
            end;
        end;
        result := result + s2;
   finally
       sl.Free;
  end;
end;