Алгоритм генерации правдоподобных ников

[Naza]

лазил в нете и нашол прогу для деления на слоги и к ней кусок кода

unit Unit1;
{Программа слогоделения}
{Использованы правила слогоделения по А.Ю.Мусорину}
{Author by MonoLife}
{2005 г.}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
 MyGlas= set of 'а'..'я';
 MyZSoglas= set of 'а'..'я';
 MyGSoglas= set of 'а'..'я';
 MyIsklSimv= set of 'а'..'я';


type
  TForm1 = class(TForm)
    Edit2: TEdit;
    Label3: TLabel;
    Bevel2: TBevel;
    Button2: TButton;
    Label4: TLabel;
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Button1: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    function glastrue(d: char): boolean;
    function Zsoglastrue(d: char): boolean;
    function Gsoglastrue(d: char): boolean;
    function Isklsimvtrue(d: char): boolean;
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    Glas: MyGlas;
    ZSoglas: MyZSoglas;
    Gsoglas: MyGSoglas;
    IsklSimv: MyIsklSimv;
    Defis: char;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 Glas:=['а','е','ё','и','о','у','ы','э','ю','я'];
 ZSoglas:=['б','в','г','д','ж','з','л','м','н','р'];
 Gsoglas:=['к','п','с','т','ф','х','ц','ч','ш','щ'];
 IsklSimv:=['ь','ъ','й'];
 Defis:='-';
 Label2.Caption:='';
 ActiveControl:=Edit1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i, k,x,j: integer;
    zs: boolean;
    s1,s2, s3: string;
begin
 zs:=false;
 if Edit1.Text='' then
  begin
   Application.MessageBox('Введите слово в верхнее поле',
   'Слово по слогам', MB_ICONINFORMATION);
   ActiveControl:=Edit1;
   exit;
  end;
  s1:=Edit1.Text;
  s2:='';
  s3:='';
  k:=0;
 for i:=1 to length(s1) do
  begin
   if s1[i]=' ' then
    begin
     Application.MessageBox('Слово не должно содержать пробелов'
     , 'Слово по слогам',
     MB_ICONINFORMATION);
     Edit3.Text:='';
     ActiveControl:=Edit1;
     exit;
    end
   else
   if s1[i]=Defis then
    begin
      s2:=s2+'5';
      zs:=True;
      inc(k);
    end
   else
   if glastrue(AnsiLowerCase(s1)[i]) then
    begin
      s2:=s2+'1';
      inc(k);
    end
   else
   if Zsoglastrue(AnsiLowerCase(s1)[i]) then
      s2:=s2+'2'
   else
   if Gsoglastrue(AnsiLowerCase(s1)[i]) then
      s2:=s2+'3'
   else
   if Isklsimvtrue(AnsiLowerCase(s1)[i]) then
      s2:=s2+'4'
   else
   begin
    Application.MessageBox(pchar('Введенное слово написано неверно'+
    #13+'или не делится на слоги'), 'Слово по слогам',
    MB_ICONINFORMATION);
    Edit3.Text:=Edit1.Text;
    ActiveControl:=Edit1;
    exit;
  end;
  end;
  if k=0 then
  begin
   Application.MessageBox(pchar('Введенное слово написано неверно'+
   #13+'или не делится на слоги'), 'Слово по слогам',
   MB_ICONINFORMATION);
   Edit3.Text:=Edit1.Text;
   ActiveControl:=Edit1;
   exit;
  end;
  if k=1 then
   begin
    Edit2.Text:=s2;
    Label2.Caption:='Слогов в слове - '+IntToStr(k);
    Edit3.Text:=s1;
    exit;
   end;
  if zs then k:=k-1;
 x:=1;
 Edit2.Text:='';
for i:=1 to k do
 begin
  While (s2[x]<>'1') and (x<= length(S1)) do
   begin
     if s2[x]='5' then
      begin
       inc(x);
       continue;
      end;
     if s2[x]='4' then
       s3:=s3+s1[x]+'-'
     else
       s3:=s3+s1[x];
    inc(x);
   end;
     if s2[x]='5' then
      begin
       inc(x);
       continue;
      end;
   if s2[x+1]='1' then
    begin
     s3:=s3+s1[x]+'-';
     inc(x)
    end
    else
    begin
     if s2[x+1]='4' then
      begin
      if i=k then
       for j:=x to length(S1) do
       s3:=s3+s1[j] else
       s3:=s3+s1[x]+s1[x+1]+'-';
       inc(x,2);
       continue;
      end;
     if s2[x+1]='2' then
      begin
       if s2[x+2]='1' then
        begin
         s3:=s3+s1[x]+'-';
         inc(x)
        end
        else
         if s2[x+2]='2' then
          begin
          if i=k then
           s3:=s3+s1[x]+s1[x+1]+s1[x+2] else
           s3:=s3+s1[x]+'-';
           inc(x,1)
          end
          else
         if s2[x+2]='4' then
          begin
           if i=k then
           for j:=x to length(S1) do
            s3:=s3+s1[j]
            else
            s3:=s3+s1[x]+s1[x+1]+s1[x+2]+'-';
           inc(x,3)
          end
          else
          begin
           if i=k then
           for j:=x to length(S1) do
            s3:=s3+s1[j]
           else
            s3:=s3+s1[x]+s1[x+1]+'-';
           inc(x,2)
          end;
       end
         else
         if s2[x+1]='3' then
          begin
          if i=k then
           for j:=x to length(S1) do
            s3:=s3+s1[j]
           else
           begin
           s3:=s3+s1[x]+'-';
           inc(x);
           end;
          end
          else
          begin
          if s2[x+1]='5' then
           s3:=s3+s1[x]+'-' else
           s3:=s3+s1[x];
           inc(x);
          end;
      end;
 end;
 Label2.Caption:='Слогов в слове - '+IntToStr(k);
 Edit2.Text:=s2;
 Edit3.Text:=s3;
end;

function TForm1.glastrue(d: char): boolean;
begin
 Result:=False;
 if (d in Glas) or
    (d ='ё')  then
  Result:=True;
end;

function TForm1.Gsoglastrue(d: char): boolean;
begin
 Result:=False;
 if d in Gsoglas then
  Result:=True;
end;

function TForm1.Isklsimvtrue(d: char): boolean;
begin
 Result:=False;
 if d in IsklSimv then
  Result:=True;
end;

function TForm1.Zsoglastrue(d: char): boolean;
begin
 Result:=False;
 if d in ZSoglas then
  Result:=True;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Application.CreateForm(TForm2, Form2);
 Form2.ShowModal;
 Form2.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 case Button3.Tag of
 0: begin
     Form1.Height:=352;
     Button3.Tag:=1;
    end;
 1: begin
     Form1.Height:=216;
     Button3.Tag:=0;
    end;
  end;
end;

end.

ЕСТЬ ТАМ ЧО НУЖНОГО?