как-то подобная тема проскакивала... с подачи
procedure TForm1.Button1Click(Sender: TObject);
var
set_of_chars: set of Char;
word_flag : Boolean;
word_start : Integer;
word_end : Integer;
c : Char;
i : Integer;
function rand(S:string): String;
var
Len : Integer;
Aux : String;
i,r : Integer;
begin
Len := Length (S);
Result := '';
if Len < 4 then Result := S
else
begin
Randomize;
Aux := Copy (S, 2, Len - 2);
for i := 1 to Len - 2 do
begin
r := Random(Len - 1 - i) + 1;
Result := Result + Aux[r];
Aux := Copy(Aux, 1, r - 1) + Copy(Aux, r + 1, Len - i - r - 1);
end;
Result := S[1] + Result + S[Len];
end;
end;
begin
set_of_chars := ['ё','Ё', 'А' .. 'я'];
(*set_of_chars := ['а', 'б', 'в', 'г', 'д', 'е', 'ё', 'ж', 'з', 'и', 'й', 'к',
'л', 'м', 'н', 'о', 'п', 'р', 'с', 'т', 'у', 'ф', 'х', 'ц',
'ч', 'ш', 'щ', 'ъ', 'ы', 'ь', 'э', 'ю', 'я',
'А', 'Б', 'В', 'Г', 'Д', 'Е', 'Ё', 'Ж', 'З', 'И', 'Й', 'К',
'Л', 'М', 'Н', 'О', 'П', 'Р', 'С', 'Т', 'У', 'Ф', 'Х', 'Ц',
'Ч', 'Ш', 'Щ', 'Ъ', 'Ы', 'Ь', 'Э', 'Ю', 'Я']; *)
word_flag := False;
word_start := 0;
word_end := 0;
Memo2.Lines.Clear;
for i := 1 to Length(Memo1.Text) do
begin
c := Memo1.Text[i];
if c in set_of_chars then
if not word_flag then
begin
word_flag := True;
word_start := i;
word_end := 0;
end
else
begin
if i = Length(Memo1.Text) then
word_end := i;
end
else
begin
if word_flag then
word_end := i-1
else
word_end := 0;
word_flag := False;
end;
if word_end > 0 then
Memo2.Text := Memo2.Text +rand(Copy(Memo1.Text, word_start, word_end-word_start + 1));
if not word_flag then
Memo2.Text := Memo2.Text + String(c);
end;
end;
