Einzelnen Beitrag anzeigen

mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.858 Beiträge
 
Delphi 11 Alexandria
 
#12

AW: String intelligent Kürzen

  Alt 18. Jun 2011, 19:20
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;
Markus Kinzler
  Mit Zitat antworten Zitat