работа со строчкой: помогите оптимизировать мой тупой код)

procedure TForm1.Button20Click(Sender: TObject); //разложение простых чисел
var  b,n,i,a: integer; c:real; str,str1:string;
begin
a:=strtoint(edit9.Text)  ;
b:=a; c:=a; i:=1;
str:=inttostr(b)+'='+str;
repeat i:=i+1;
if b mod i = 0 then begin   // если наше число делится без остатка на простое число тогда запишем это число в строку
c:=c/i;                             //if c=1 then str:=str+inttostr(i) else - это сразу без знака * в последнем символе
str:=str+inttostr(i)+'*'; b:=round(c); i:=1;
                    end;
until b=1;              // тут можно остановится и вывести результат но он будет без степеней например 16=2*2*2*2
 
for i:=2 to a div 2 do begin str1:=inttostr(i)+'*';
str:=StringReplace(str, str1+str1+str1+str1+str1+str1+str1+str1+str1, inttostr(i)+'^9*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1+str1+str1+str1+str1+str1, inttostr(i)+'^8*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1+str1+str1+str1+str1, inttostr(i)+'^7*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1+str1+str1+str1, inttostr(i)+'^6*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1+str1+str1, inttostr(i)+'^5*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1+str1, inttostr(i)+'^4*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1+str1, inttostr(i)+'^3*', [rfReplaceAll, rfIgnoreCase]);
str:=StringReplace(str, str1+str1, inttostr(i)+'^2*', [rfReplaceAll, rfIgnoreCase]);  end;      //самый долгий и тупой способ который придумал 
for i:=1 to Length(str) do if i=Length(str) then delete(str,i,1); // del last simb             
label4.caption:=(str) ;                                                                       //но он работает, но большие числа типо 10000000 считает долго
end;                                                                                         // ну и a^10 он уже запишет как а^9*2 итд
 
end.

uses
  System.SysUtils, Generics.Collections, System.StrUtils;
 
function PowerReplace(s:string):string;
var
  c:string;
  k:TDictionary<string,integer>;
  t:TPair<string,integer>;
begin
  Result:='';
  k:=TDictionary<string,integer>.Create;
  for c in System.StrUtils.SplitString(s,'*') do
    begin
      if k.ContainsKey(c) then
        k.Items[c]:=k.Items[c]+1
      else
        k.Add(c,1)
    end;
  for t in k do
    if t.Value>1 then
      Result:=Result+'*('+t.Key+'^'+IntToStr(t.Value)+')'
    else
      Result:=Result+'*'+t.Key;
  k.Free;
  Delete(result,1,1);
end;

PowerReplace('2*2*2*2*2*2*3*3*3*111*111*91')//(3^3)*(2^10)*91*(111^2)

uses
  SysUtils, Classes, Types, StrUtils;
 
function PowerReplaceD7(s:string):string;
var
  c:string;
  k:TStringList;
  i:Integer;
  t:TStringDynArray;
begin
  Result:='';
  k:=TStringList.Create;
  t:=SplitString(s,'*');
  for i:=0 to length(t)-1 do
    begin
      if k.IndexOfName(t[i])>=0 then
        k.Values[t[i]]:=IntToStr(StrToInt(k.Values[t[i]])+1)
      else
        k.Add(t[i]+'=1')
    end;
  for i:=0 to k.Count-1 do
    if StrToInt(k.ValueFromIndex[i])>1 then
      Result:=Result+'*('+k.Names[i]+'^'+k.ValueFromIndex[i]+')'
    else
      Result:=Result+'*'+k.Names[i];
  k.Free;
  Delete(result,1,1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  tmp,result,src: string;
  i,n: byte;
  // массив для подсчета количества мнежителей
  parts: array[1..9] of byte;
begin
  src:= Edit1.Text;
  // обнуляем массив
  FillChar(parts,SizeOf(parts),0);
  // убираем знаки умножения
  tmp:= StringReplace(Edit1.Text,'*','',[rfReplaceAll]);
  // перебираем все множители, входящие в строку
  for i:= 1 to Length(tmp) do
  begin
    n:= StrToInt(tmp[i]);
    parts[n]:= parts[n] + 1;
  end;
  // формируем ответ
  for i:= 1 to 9 do
  case parts[i] of
  0:; // здесь ничего не делаем
  1: begin
       if result = '' then result:= IntToStr(parts[i])
       else result:= result+' * '+IntToStr(i);
     end;
  else begin
         if result = '' then result:= Format('%d^%d',[i,parts[i]])
         else result:= result+' * '+Format('%d^%d',[i,parts[i]]);
       end;
  end;
  Edit2.Text:= result;
end;

{$APPTYPE CONSOLE}
uses
  Windows;
function wsprintfA(Output: PChar; Format: PChar): Integer; cdecl;varargs;external 'user32.dll';
var
  s:     array[0..256] of char ='142=2*2*2*2*2*2*2+3*3+5';
  parts: array[0..9] of LongWord;
  i,j:   LongWord;
begin
  write(s,'=');
  j:=lstrlen(@s)-1;
  for i:=pos('=',s) to j do
    inc(parts[ord(s[i])-48]);
  j:=0;
  for i:=0 to 9 do
    if parts[i]>0 then
    begin
      inc(j,wsprintfA(@s[j],'%i',i));
      if parts[i]>1 then
        inc(j,wsprintfA(@s[j],'^%i',parts[i]));
      s[j]:='+';
      inc(j);
    end;
  s[j-1]:=#0;
  writeln(s);
  readln;
end.

function TForm1.MyReplace(s: string): string;   //функция myreplace
var  i,j,x1,x2,x3: integer; str,str2:string;
begin
for i:=1 to (Length(s) div 2)-1 do begin J:=0;    //максимум проход цикла это
 x1:=pos('*',s);                                 //количество символов /2-1
 delete(s,x1,1);
 insert('/',s,x1);
 x2:=pos('*',s) ;                       //аогоритм несложный ,ищится позиция первого символа*
 x3:=x2-x1;                             //заменяется на '/' дальше находим ЧИСЛО , а не цифру
 str := copy(s, x1+1, x3-1);            //тк оностоит между двумя '*'заносим его в отдельную строку
     repeat                             //ищем его в исходной строке и удаляем + паралельно работает сщетчик
      x2:=pos(str,s);                   // если Число встречается больше чем 1 раз то 'грубо говоря'возводим в степень
       delete(s,x2-1,x3);               //далее избавляемся от ненужной информации занесенной в строку в ходе цикла.
      inc(j);
     until x2=0;
 if j=2 then str2:=str2+str+'*' else
 str2:=str2+str+'^'+inttostr(j-1)+'*';
                                     end;
str2:=StringReplace(str2,'^0*','', [rfReplaceAll, rfIgnoreCase]);
Delete(str2, Length(str2), 1);   //удалим последний символ тк он лишний
result:=str2;
end;

uses
  SysUtils, Types;
 
function StrScan(const Str: PChar; Chr: Char): PChar;
begin
  Result := Str;
  while Result^ <> #0 do
  begin
    if Result^ = Chr then
      Exit;
    Inc(Result);
  end;
  if Chr <> #0 then
    Result := nil;
end;
 
function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
begin
  Result := False;
  if (Index <= 0) or (Index > Length(S)) or (ByteType(S, Index) <> mbSingleByte) then exit;
  Result := StrScan(PChar(Delimiters), S[Index]) <> nil;
end;
 
function FindDelimiter(const Delimiters, S: string; StartIdx: Integer = 1): Integer;
var
  Stop: Boolean;
  Len: Integer;
begin
  Result := 0;
  Len := Length(S);
  Stop := False;
  while (not Stop) and (StartIdx <= Len) do
    if IsDelimiter(Delimiters, S, StartIdx) then
    begin
      Result := StartIdx;
      Stop := True;
    end
    else
      Inc(StartIdx);
end;
 
type
  TStringDynArray=array of string;
 
function SplitString(const S, Delimiters: string): TStringDynArray;
var
  StartIdx: Integer;
  FoundIdx: Integer;
  SplitPoints: Integer;
  CurrentSplit: Integer;
  i: Integer;
begin
  Result := nil;
 
  if S <> '' then
  begin
    { Determine the length of the resulting array }
    SplitPoints := 0;
    for i := 1 to Length(S) do
      if IsDelimiter(Delimiters, S, i) then
        Inc(SplitPoints);
 
    SetLength(Result, SplitPoints + 1);
 
    { Split the string and fill the resulting array }
    StartIdx := 1;
    CurrentSplit := 0;
    repeat
      FoundIdx := FindDelimiter(Delimiters, S, StartIdx);
      if FoundIdx <> 0 then
      begin
        Result[CurrentSplit] := Copy(S, StartIdx, FoundIdx - StartIdx);
        Inc(CurrentSplit);
        StartIdx := FoundIdx + 1;
      end;
    until CurrentSplit = SplitPoints;
 
    // copy the remaining part in case the string does not end in a delimiter
    Result[SplitPoints] := Copy(S, StartIdx, Length(S) - StartIdx + 1);
  end;
end;