Показать сообщение отдельно
  #3  
Старый 23.03.2012, 16:49
Pyro Pyro вне форума
Так проходящий
 
Регистрация: 18.07.2011
Сообщения: 805
Версия Delphi: 7Lite
Репутация: 6063
По умолчанию

PHP код:
// uses PerlRegEx


function sort(s: string): string;
var list: 
tstringlist;
begin
  
list := TStringList.Create;
  list.
Text := s;
  list.
Sort;
  
result := list.Text;
  list.
free;
end;


function 
regexp(subj, pattern: string): TPerlRegEx;
begin
  result 
:= TPerlRegEx.Create;
  
result.regex := pattern;
  
result.subject := subj;
end;
function 
sub(strin: string; oldpattern: string; replacer: TPerlRegExReplaceEvent): string; overload;
begin
  with regexp
(strin, oldpattern) do begin
    onreplace 
:= replacer;
    
replaceall;
    
result := subject;
    
free
  end
end
;
function 
sub(strin: string; oldpattern: string; new: string): string; overload;
begin
  with regexp
(strin, oldpattern) do begin
    replacement 
:= new;
    
replaceall;
    
result := subject;
    
free
  end
end
;


procedure TForm1.Button1Click(Sender: TObject);
begin
  memo2
.Font.Name := 'courier';
  
memo2.Text := sub(memo1.text, '\d+[а-я]?', form1.onreplace);
  
memo2.text := sort(memo2.text);
  
memo2.Text := sub(memo2.text, '[ ]', '');
  
memo2.Text := sub(memo2.text, '([а-я])(\d+)', '$2$1');
end;

procedure TForm1.onreplace(Sender: TObject; var replacewith: PCREString);
var 
reg: TPerlRegEx;
begin
  reg 
:= sender as TPerlRegEx;
  
replacewith := reg.replacement;
  
replacewith := Format('%05s', [reg.matchedtext]);
  if 
replacewith[length(replacewith)] in ['Ё', 'ё', 'А'..'я'] then begin
    replacewith 
:= replacewith[length(replacewith)] + replacewith;
    
setlength(replacewith, length(replacewith) - 1)
  
end
end
; 
Ответить с цитированием