program Project1;

uses
Windows,KOL;
 {$R *.res}
type
PForm1 = ^TForm1;
TForm1 = object(TObj)
  Form,
  ListBox1,
  EditBox1,
  Button1,
  StrListCount:PControl;
  //Button2:

public
 // procedure Timer1Timer(Sender: PObj);
 procedure Button1Click(Sender: PObj);
 procedure Button2Click(Sender: PObj);
end;

var
Form1: PForm1;
 t:Cardinal;

// : PStrList; Spisok:= NewStrList;

procedure TForm1.Button2Click(Sender: PObj);
begin
 ListBox1.Add('S')
end;

procedure TForm1.Button1Click(Sender: PObj);
var
 m: byte;
 sL: PStrList; //TStringList;
 L:integer;//cardinal;
 sLCount:integer;

function IndifStrnig(S0: string):boolean;
var Last,Next:string;
   i:byte;

begin
result:=true ;
Last:='';
for I := 1 to m do begin
                 Next:=S0[i];
                 //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                 if Next<>Last then Last:=Next else result:=false;
                   end;
//if Last=S0[m] then  else result:=false;

end;
procedure GenStr(S0, S1: string);
var
 i: byte;
begin
 if Length(S0) = m then begin
 if IndifStrnig(S0) then  sL.Add(S0); // msgok('добавляем строчку '+S0) end
                         end
 else
   for i := 1 to Length(S1) do
     GenStr(S0+S1[i], copy(S1,1,i-1) + copy(S1,i+1,Length(S1)));
end;

begin
 sL := NewStrList; //TStringList.Create;
 t:=Gettickcount;
 try
   //sL.Sort(false);
   //sL.Sort(true);
   //sL.Items[] //Duplicates := dupIgnore;
   m := Length(EditBox1.Text);
   GenStr('',EditBox1.Text);
   //ListBox1.text:= sL.Text; // .Items.Text

   StrListCount.Caption := int2str(sL.Count)+' время = '+int2str(Gettickcount-t) ;
   sLCount:=sL.Count-1;
   //for l := 0 to sLCount do ListBox1.Add(int2str(l)+' ) '+sL.Items[l]);//нужно было для просмотра
    for l := 0 to sLCount do ListBox1.Add(sL.Items[l]);//нужно было для просмотра
  // ListBox1.Text := sL.Text;

   sL.SaveToFile('Data.txt');
 finally
   sL.Free;
 end;
end;

procedure NewForm1(var Result: PForm1; AParent: PControl);
begin
New(Result, Create);
with Result^ do
begin
  Form := NewForm(AParent, 'Project1');
  Form.Add2AutoFree(Result);
  Applet := Form;
  Form.Font.FontName:='TimesNewRoman';
  Form.Font.FontHeight:=-14;
  Form.SetClientSize(340, 320).CenterOnParent;   //loSort ,loNoIntegralHeight
   Result.ListBox1 := NewListBox( Result.Form, [loSort ] ).SetPosition( 128, 16 ).SetSize( 185, 193 );
   Result.ListBox1.Color := TColor(clWindow);
   //ListBox1.Add('Значения ');
   Result.Button1 := NewButton( Result.Form, 'Button1' ).SetPosition( 8, 200 );
   Result.Button1.OnClick := Button1Click;
   Result.EditBox1 := NewEditBox( Result.Form, [  ] ).SetPosition( 8, 232 ).SetSize( 129, 17 );
   Result.EditBox1.Text := '236513';//236513264532
   Result.EditBox1.Color := TColor(clWindow);
   Result.StrListCount := NewLabel( Form, 'StrListCount' ).SetPosition( 8, 272 ).SetSize( 180, 17 );
   //.PlaceUnder.AutoSize(true);
   //SetSize(120, 13 );
  // Result.Button2 := NewButton( Result.Form, 'Button2' ).PlaceUnder.AutoSize(true);
  //Result.Button2.OnClick := Button2Click
end;
end;

begin
NewForm1(Form1, nil);
Run(Form1.Form);
end.

 //sL.Items[] //Duplicates := dupIgnore;

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   Edit1: TEdit;
   Button1: TButton;
   Label1: TLabel;
   Label2: TLabel;
   Count: TLabel;
   Label3: TLabel;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 data : array of integer; // Тут будут храниться данные
 Step:integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 m: integer;
 sL: TStringList;

function IndifStrnig(S0: string):boolean;
var Last,Next:string;
  i:byte;

begin
result:=true ;
Last:='';
for I := 1 to m do begin
                Next:=S0[i];
                //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                if Next<>Last then Last:=Next else result:=false;
                  end;
//if Last=S0[m] then  else result:=false;

end;
procedure GenStr(S0, S1: string);
var
 i: integer;
begin
 if Length(S0) = m then  begin
  if IndifStrnig(S0) then sL.Add(S0)
   end
 else
   for i := 1 to Length(S1) do begin
     GenStr(S0+S1[i], copy(S1,1,i-1) + copy(S1,i+1,Length(S1)));
     inc(Step); Application.ProcessMessages;Count.Caption:=intTostr(Step)
                               end;
end;

begin
 sL := TStringList.Create;
 try
   sL.Sorted := True;
   //sL.Duplicates := dupIgnore;
   m := Length(Edit1.Text);
   GenStr('',Edit1.Text);
   ListBox1.Items.Text := sL.Text;
   Label3.Caption:=intTostr(sL.Count-1);
 finally
   sL.Free;
 end;
end;
end.

 ListBox1.Items.Text := sL.Text;
  Label3.Caption:=intTostr(sL.Count-1);
finally

for I := 1 to m do begin
                Next:=S0[i];
                //showmessage(Next+ ' <> '+ Last +' Last '+ Last );
                form1.Caption:='добавляем строчку '+S0;
                sleep(100);
                if Next<>Last then Last:=Next else result:=false;
                  end;

ListBox1.Items.Text := sL.Text;
   Label3.Caption:=intTostr(sL.Count);
   sL.SaveToFile('Data.txt');
 finally