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;