Przenoszenie znaków miedzy znacznikami w Listbox

Mam takie coś w listbox:

aaaaaa # bbb # cccc
aaaaaaa # bbbb # ccccc
aaaaaaaa # bbb # cccccc
aaaaaaaaa # bbbb #
# bbbb #
# bbb #

i chce teraz dokonać przeniesienia w dól to co jest krótsze od środkowej kolumny.

          # bbb #
          # bbbb#

aaaaaa # bbb #
aaaaaaa # bbbb # cccc
aaaaaaaa # bbbb # ccccc
aaaaaaaaa # bbb # cccccc

mam coś takiego :

var
i, x : integer;
sl, sl1, sl2, sl3, sl4 : TStringList;
sl_1, sl_2, sl_3 : TStringList;
begin
  sl := TstringList.Create;
  sl1 := TstringList.Create;
  sl2 := TstringList.Create;
  sl3 := TstringList.Create;
  sl4 := TstringList.Create;

  sl_1 := TStringList.Create;
  sl_2 := TStringList.Create;
  sl_3 := TStringList.Create;

  sl.Text := ListBox1.Items.Text;

  for i := 0 to sl.Count -1 do
  sl4.Add(inttostr(length(sl[i])));

  sl4.Sorted := True;

  for i := 0 to sl.Count -1 do
  sl[i] := sl[i] + StringOfChar(' ',strtoint(copy(sl4[sl4.Count-1],0,100))+1-Length(sl[i]))+'#';

  ListBox1.Items.Text := sl.Text;

  sl4.Clear;

  for i := 0 to sl.Count -1 do
  begin
    sl1.Clear;
    if pos('#', sl[i]) > 0 then 
    begin
    ExtractStrings(['#','#'], [], PChar(sl[i]),sl1);

    sl_1.Add(sl1[0]);
    sl_2.Add(sl1[1]);
    sl_3.Add(sl1[2]);
    end;
  end;

  //----------------------------------------------------------------------------
  x := 0;
  for  i := sl_1.Count-1 downto 0 do
  begin
   if copy(sl_1[i],0,1) = ' ' then inc(x);
   if copy(sl_1[i],0,1) = ' ' then sl_1.Delete(i);
  end;

  for i := 1 to x do sl2.add('');

  ListBox2.Items.Text := sl2.Text + sl_1.Text;

  for i := 0 to ListBox2.Items.Count -1 do
  sl4.Add(inttostr(length(ListBox2.Items[i])));

  sl4.Sorted := True;

  for i := 0 to ListBox2.Items.Count -1 do
  ListBox2.Items[i] := ListBox2.Items[i] + StringOfChar(' ',strtoint(copy(sl4[sl4.Count-1],0,100))+1-Length(ListBox2.Items[i]))+'#';

  sl2.Clear;
  sl4.Clear;

  //----------------------------------------------------------------------------
  x := 0;
  for  i := sl_2.Count-1 downto 0 do
  begin
   if copy(sl_2[i],0,2) =  '  ' then inc(x);
   if copy(sl_2[i],0,2) =  '  ' then sl_2.Delete(i);
  end;

  for i := 1 to x do sl2.add('');

  sl3.Text := sl2.Text + sl_2.Text;

  for i := 0 to sl3.Count -1 do
  sl4.Add(inttostr(length(sl3[i])));

  sl4.Sorted := True;

  for i := 0 to sl3.Count -1 do
  sl3[i] := sl3[i] + StringOfChar(' ',strtoint(copy(sl4[sl4.Count-1],0,100))+1-Length(sl3[i]))+'#';

  for i := 0 to ListBox2.Items.Count -1 do
  ListBox2.Items[i] := ListBox2.Items[i] + sl3[i];

  sl2.Clear;
  sl4.Clear;

  //----------------------------------------------------------------------------
  x := 0;
  for  i := sl_3.Count-1 downto 0 do
  begin
   if copy(sl_3[i],0,2) =  '  ' then inc(x);
   if copy(sl_3[i],0,2) <> '  ' then sl_3[i] := sl_3[i];
  end;

  for i := 1 to x do sl2.add('');

  sl3.Text := sl2.Text + sl_3.Text;

  for i := 0 to sl3.Count -1 do
  sl4.Add(inttostr(length(sl3[i])));

  sl4.Sorted := True;

  for i := 0 to sl3.Count -1 do
  sl3[i] := sl3[i] + StringOfChar(' ',strtoint(copy(sl4[sl4.Count-1],0,100))+1-Length(sl3[i]))+'#';

  for i := 0 to ListBox2.Items.Count -1 do
  ListBox2.Items[i] := ListBox2.Items[i] + sl3[i];

  sl.Free;
  sl1.Free;
  sl2.Free;
  sl3.Free;
  sl4.Free;

  sl_1.Free;
  sl_2.Free;
  sl_3.Free;

Oki poradziłem a teraz wezmę rady Olesia

Nie wiem co Ty za "potworki" tworzysz. Pokazywałem już Tobie moim poprzednim kodem. W jaki sposób można między innymi posortować poprzez CustomSort elementy TStringList. Skorzystaj więc z tego, a nie tworząć 9753637338216432 obiektów TStringList. Wedle mnie wystarczy jeden.

Najpierw Assignujesz itemy ListBoxa do StringListy, a później sortujesz. I w funkcji sortującej poprzez Pos i Delete lub Copy sprawdzasz długośc stringów przez/po # i zwracasz odpowiedni Result w zależności od tego, która długość jest dłuższa lub krótsza od innej. Ewentualnie zliczając napisaną sobie pomocniczą funkcją ile spacji występuje zamiast innego znaku przed lub po separatorze #.

Na koniec Assignujesz Itemy StringListy do ListBoxa. I gotowe :) Tak przynajmniej ja bym pokombinował. Konkretnego kodu nie napisze, bo muszę zaraz wychodzić do pracy. Ale nie widzisz pierwszy raz Obiektowego Pascala na oczy, to powinieneś sam to ogarnąć.

Tutaj jedynym sensownym rozwiązaniem jest CustomSort, z własną funkcją porównującą, więc cały podany kod należy skasować i napisać go od nowa, tym razem z głową;

@Bruno(M) - poza tym wstaw podane zawartości komponentu w znaczniki <code>, aby było widać od razu ile każda linia ma znaków.

Na ile ja rozumiem coś w tym stylu:

function Parse(var Str:String;const Delimeter:String):String;
var P:Integer;
begin
  P:=Pos(Delimeter,Str);
  if P>0 then
  begin
    Result:=Copy(Str,1,P-1);
    Delete(Str,1,P+Length(Delimeter)-1);
  end
  else
  begin
    Result:=Str;
    SetLength(Str,0);
  end;
end;

function Invert(Str:String):String;
var L,R:Integer;
var Ch:Char;
begin
  Result:=Str;
  L:=1;
  R:=Length(Str);
  while L<R do
  begin
    Ch:=Result[L];
    Result[L]:=Result[R];
    Result[R]:=Ch;
    Inc(L);
    Dec(R);
  end;
end;


procedure MoveDown(Lst:TStrings);
var I,L,R:Integer;
var Str,Upr,Tmp:String;
begin
  I:=Lst.Count-1;
  L:=I;
  R:=I;
  while L>=0 do
  begin
    Str:=Lst[L];
    if Length(Trim(Parse(Str,'#')))>0 then Break;
    Dec(L);
  end;
  while R>=0 do
  begin
    Str:=Lst[R];
    Parse(Str,'#');
    Parse(Str,'#');
    if Length(Trim(Str))>0 then Break;
    Dec(R);
  end;
  while I>=0 do
  begin
    if (L>=0)and(L<I) then
    begin
      Str:=Lst[I];
      Upr:=Lst[L];
      Tmp:=Parse(Upr,'#');
      Upr:=Parse(Str,'#')+'#'+Upr;
      Str:=Tmp+'#'+Str;
      Lst[L]:=Upr;
      Lst[I]:=Str;
    end;
    if (R>=0)and(R<I) then
    begin
      Str:=Invert(Lst[I]);
      Upr:=Invert(Lst[R]);
      Tmp:=Parse(Upr,'#');
      Upr:=Parse(Str,'#')+'#'+Upr;
      Str:=Tmp+'#'+Str;
      Lst[R]:=Invert(Upr);
      Lst[I]:=Invert(Str);
    end;
    Dec(R);
    Dec(L);
    Dec(I);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  MoveDown(ListBox1.Items);
end;

Uwaga, pisano z palca