Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.04.01;
Скачать: [xml.tar.bz2];

Вниз

сортировка в ListBox   Найти похожие ветки 

 
pasha star   (2007-03-09 12:53) [0]

ListBox1.Sorted := True; // <- не подходит..

нужно что бы некоторые символы были выше чем сортируются с sorted:=true;

допустим сейчас он сортирует так:

+aaa
%bbb
@ccc
~ddd
aaaa
bbba
cccc

а нужно что бы было так:

~ddd
@ccc
%bbb
+aaa
aaaa
bbba
cccc

как изменить эту сортировку ?


 
Сергей М. ©   (2007-03-09 12:56) [1]

ListBox.Items.CustomSort(..)


 
S@shka ©   (2007-03-09 12:56) [2]

Либо все сам сортируешь как надо.
Либо ListBox1.Sorted;
а потом все равно до первой "a" - сортируешь самостоятельно.


 
Рамиль ©   (2007-03-09 12:58) [3]

Написать свою сортировку.


 
pasha star   (2007-03-09 13:50) [4]

const
 CRANKING = "+%@&~";

function CustomCompare(List: TStringList; Index1, Index2: Integer): Integer;
var
 s1, s2: string;
 r1, r2: char;
begin
 s1 := List[index1];
 s2 := List[index2];
 r1 := s1[1];
 r2 := s2[1];
 Delete(s1, 1, 1);
 Delete(s2, 1, 1);
 if Pos(r1, CRANKING) > Pos(r2, CRANKING) then Result := -1 else
 if Pos(r1, CRANKING) < Pos(r2, CRANKING) then Result := 1 else
 Result := AnsiCompareText(s1, s2);
end;

procedure make_sort;
var sl: TStringList;
begin
 sl := TStringList.Create;
 try
   sl.Assign(Form1.ListBox1.Items);
   sl.CustomSort(CustomCompare);
   Form1.ListBox1.Items.Assign(sl);
 finally
   sl.Free
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add(Edit1.Text);
make_sort;
end;

ну для первой добавки всех Items"ов этот код норм.. но.. если добавить новый Items, то происходит сортировка всего listbox"а и сбрасывается позиция scrollbar"a и выбронный item.. а если стоит listbox1.sorted:=true; (с //make_sort;) то всё ок.. как это исправить ?


 
pasha star   (2007-03-09 14:56) [5]

no idea ?


 
Сергей М. ©   (2007-03-09 15:02) [6]


> а если стоит listbox1.sorted:=true;


Тебе нужна собственная сортировка, т.е. сортировка по своим критериям сравнения !

Ну и причем здесь Sorted = True ?

Нипричем.

Дорабатывай алгоритм ф-ции CustomCompare() таким образом, чтобы он удовлетворял всем твоим требованиям. Св-во Sorted при этом забудь.


 
Рамиль ©   (2007-03-09 16:01) [7]


> Сергей М. ©   (09.03.07 15:02) [6]

Так у него не из-за метода сортировки сбрасывается скрол, а из-за Form1.ListBox1.Items.Assign(sl);

А метод CustomSort у TListbox.Items недоступен


 
fd979 ©   (2007-03-09 16:36) [8]

Предлагаю:
Const
 A : Array[1..n] = ("+", "%", "@", "~", ..., n); //обязательно в том порядке в каком нужно сортировать!! Вместо n поставь количество этих символов...
....

 Var
 S1: TStringList;
 S  : String;
 I, J   : Integer;
...
begin
 S1 := TStringList.Create;
 S1.Sorted := False;
 S1 := Listbox1.Items;

 for i := 0 to S1.Count - 1 do
 begin
   S := S1.Strings[i];
   for j := 1 to n do
      S := StringReplace(S, A[j], IntToStr(j), [rfReplaceAll, rfIgnoreCase]);
   S1.Strings[i] := S;
 end;

 S1.Sorted := True;

 for i := 0 to S1.Count - 1 do
 begin
   S := S1.Strings[i];
   for j := 1 to n do
      S := StringReplace(S, IntToStr(j), A[j], [rfReplaceAll, rfIgnoreCase]);
   S1.Strings[i] := S;
 end;
 
 ListBox1.Items := S1;
end;


Писал прямо сюда. Так что проверь...


 
fd979 ©   (2007-03-09 16:38) [9]

Ой нет... Только что посмотрел внимательнее... Не будет правильно работать, если в превоначальной строке есть цифры...


 
pasha star   (2007-03-09 17:35) [10]

error:

S1 := Listbox1.Items;
Incompitable types: "TStringList" and "TStrings"


 
pasha star   (2007-03-09 17:56) [11]

fixed by: S1.Assign(ListBox1.Items);

но сортировка не пашет..


 
fd979 ©   (2007-03-09 22:51) [12]

Исправлено:
procedure TForm1.Button1Click(Sender: TObject);
Var
S1: TStringList;
S  : String;
I, J   : Integer;
begin
S1 := TStringList.Create;
S1.Sorted := False;
S1.Text := Listbox1.Items.Text;

for i := 0 to S1.Count - 1 do
begin
  S := S1.Strings[i];
  for j := 1 to n do
     S := StringReplace(S, A[j], IntToStr(j), [rfReplaceAll, rfIgnoreCase]);
  S1.Strings[i] := S;
end;

S1.Sorted := True;
S1.Sorted := False;

for i := 0 to S1.Count - 1 do
begin
  S := S1.Strings[i];
  for j := 1 to n do
     S := StringReplace(S, IntToStr(j), A[j], [rfReplaceAll, rfIgnoreCase]);
  S1.Strings[i] := S;
end;

ListBox1.Items := S1;
end;


 
pasha star   (2007-03-10 13:47) [13]

после сортировки происходит сброс scrollbar и сброс выделенного item..


 
pasha star   (2007-03-10 13:48) [14]

p.s: а сортерует круто ! thanks! но как быть исправить сброс scrollbar и выделенный item ?


 
pasha star ©   (2007-03-10 14:04) [15]

а сортирует круто ! thanks!
но как исправить сброс scrollbar и выделенный item ?


 
RASkov   (2007-03-10 15:41) [16]

> [15] pasha star ©   (10.03.07 14:04)

Попробуй так (немного доработанный [12]):

Const
A : Array[1..4] of Char = ("+", "%", "@", "~");

procedure TForm1.Button1Click(Sender: TObject);
Var
S1: TStringList;
S  : String;
I, J, Ind : Integer;
begin
 ListBox1.Items.BeginUpdate;
 Ind:=ListBox1.TopIndex;
 ListBox1.Items.Objects[ListBox1.ItemIndex]:=self;
try
 S1 := TStringList.Create;
 S1.Sorted := False;
 S1.Assign(Listbox1.Items);

 for i := 0 to S1.Count - 1 do begin
  S := S1.Strings[i];
  for j := 1 to High(A) do S := StringReplace(S, A[j], IntToStr(j), [rfReplaceAll, rfIgnoreCase]);
  S1.Strings[i] := S;
 end;

 S1.Sorted := True;
 S1.Sorted := False;

 for i := 0 to S1.Count - 1 do begin
  S := S1.Strings[i];
  for j := 1 to High(A) do S := StringReplace(S, IntToStr(j), A[j], [rfReplaceAll, rfIgnoreCase]);
  S1.Strings[i] := S;
 end;
 ListBox1.Items.Assign(S1);
finally
 ListBox1.ItemIndex:=ListBox1.Items.IndexOfObject(self);
 ListBox1.Items.Objects[ListBox1.ItemIndex]:=nil;
 ListBox1.TopIndex:=Ind;
 ListBox1.Items.EndUpdate;
end;
end;

И нужно учитывать [9]...


 
pasha star ©   (2007-03-10 16:06) [17]

работает !! супер ! big big big thanks !


 
pasha star ©   (2007-03-10 16:23) [18]

ListBox1.Items.Objects[ListBox1.ItemIndex]:=self;
ListBox1.ItemIndex:=ListBox1.Items.IndexOfObject(self);

слово self , чем его можно заменить? иначе не получается создать функцию или процедуру, что бы её везде использовать..


 
pasha star ©   (2007-03-10 16:26) [19]

все получилсаяь..


Const
A : Array[1..5] of Char = ("~", "&", "@", "%", "+");

function update_listbox(lb:TListBox):integer;
Var
S1: TStringList;
S  : String;
I, J, Ind : Integer;
begin
lb.Items.BeginUpdate;
Ind:=lb.TopIndex;
lb.Items.Objects[lb.ItemIndex]:=lb;
try
S1 := TStringList.Create;
S1.Sorted := False;
S1.Assign(lb.Items);

for i := 0 to S1.Count - 1 do begin
 S := S1.Strings[i];
 for j := 1 to High(A) do S := StringReplace(S, A[j], IntToStr(j), [rfReplaceAll, rfIgnoreCase]);
 S1.Strings[i] := S;
end;

S1.Sorted := True;
S1.Sorted := False;

for i := 0 to S1.Count - 1 do begin
 S := S1.Strings[i];
 for j := 1 to High(A) do S := StringReplace(S, IntToStr(j), A[j], [rfReplaceAll, rfIgnoreCase]);
 S1.Strings[i] := S;
end;
lb.Items.Assign(S1);
finally
lb.ItemIndex:=lb.Items.IndexOfObject(lb);
lb.Items.Objects[lb.ItemIndex]:=nil;
lb.TopIndex:=Ind;
lb.Items.EndUpdate;
end;
Result:=1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Add(Edit1.Text);
update_listbox(ListBox1);
end;



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.04.01;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.039 c
15-1173602438
$Pl@Sh
2007-03-11 11:40
2007.04.01
Где скачать?


9-1145118671
Sulim
2006-04-15 20:31
2007.04.01
Шуйдеры


2-1173422964
Spnal
2007-03-09 09:49
2007.04.01
Мишина Поста ... plz


3-1168422376
nomadminded
2007-01-10 12:46
2007.04.01
асинхронное соединение с MySQL


1-1170835673
Krants
2007-02-07 11:07
2007.04.01
TTreeView, убрать выделение





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский