Что делаем?
Есть у нас некоторый TStringList, скажем SLToSort:TStringlist. Нужно его отсортировать – задача элементарная, пишем компараторы для наших данных, включаем CustomSort и всё готово. А что делать, если кроме SLToSort есть просто SomeSL:TStringlist и после сортировки SLToSort – нужно привести его элементы в соответствие с SLToSort, ну то есть так….
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
SLToSort SLToSort BeforeSort AfterSort 0 1 0 3 1 3 1 2 2 2 2 1 ______________________________ SomeSL SomeSL BeforeSort AfterSort 0 1 0 3 1 3 1 0 2 0 2 1 |
Где это может понадобиться?
Случай редкий, но всё же. Я делаю небольшой FTP клиент, который собирает данные о файлах на сервере. В принципе – вся информация уже есть и её хранит ОС, я к тому, что в данном случае вопрос использования БД – это действительно вопрос. Я подумал, что логично, просто собирать эти данные и использовать в FTP клиенте, но возникли нюансы, в частности с сортировкой списков. В SQL одна простая инструкция SortBy, а здесь приходится изобретать, но плюс в том, что программа становится независимой от БД.
Мне казалось, что я вроде сделал это, пока не наткнулся на глюк того, что если элементы одинаковые, то алгоритм работает некорректно. Немного последив за тем, как работает встроенный алгоритм CustomSort, на котором я строил свой алгоритм, я понял, что он меняет местами элементы, даже если они одинаковые. В основе CustomSort лежит QuickSort, если немного раскопать внутренности метода. Но суть не в этом.
Тестовое приложение у меня выглядело примерно так…
TListView, TMemo*2, и кнопка Sort – вот что нам понадобится – остальное лишнее на окне, лень было убирать))
Итак, создадим пару рандомных листов TstringList в FromCreate и заполним их…
|
1 2 3 4 5 6 7 8 9 10 11 |
//Filling Random Data to StringLists FRandomListIntegers:=TStringList.Create; FRandomListIntegers2:=TStringList.Create; for i := 0 to 4 do begin R:=Random(1000); FRandomListIntegers.Add(R.ToString()); // class variable FRandomListIntegers2.Add( ( (R+1).ToString )); // class variable end; |
В onDestroy – уничтожим их
|
1 2 3 4 5 6 7 |
procedure TfSomeSort.FormDestroy(Sender: TObject); begin FreeAndNil(FRandomListIntegers); FreeAndNil(FRandomListIntegers2); end; |
TListView и настроим таким образом в FormCreate
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
ListView.ViewStyle:=vsReport; ListView.GridLines:=true; ListView.OwnerData:=True; lc:=ListView.Columns.Add; lc.Caption:='RandomInteger'; lc.Width:=150; lc:=ListView.Columns.Add; lc.Caption:='RandomInteger2'; lc.Width:=150; ListView.Items.Clear; ListView.Items.Count:=5; |
Поскольку у нас виртуальный режим для TListView, то данные будем выдавать в событии OnData
|
1 2 3 4 5 6 7 8 9 |
procedure TfSomeSort.ListViewData(Sender: TObject; Item: TListItem); begin // item.Caption:=FRandomListIntegers[Item.Index]; item.subitems.add(FRandomListIntegers2[Item.Index]); item.subitems.add(FRandomListDateTimes[Item.Index]); end; |
Далее, собственно сам алгоритм сортировки и переставления в таком же порядке элементов в другом списке. Чтобы избежать проблем с той ситуацией, когда данные одинаковые, я использую обращение к адресам памяти – они-то в одном TStringlist всегда уникальные для его элементов.
Сортировка, которую мы будем делать далее – опирается на компараторы – функции сравнения для разных данных и направлений сортировки
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
//--------------------COMPARATORS--------------------------------------------- function CompareStringAscending(List: TStringList; Index1, Index2: Integer): Integer; begin Result := CompareText(List[Index2], List[Index1]); end; function CompareStringDescending(List: TStringList; Index1, Index2: Integer): Integer; begin Result := CompareText(List[Index2], List[Index1]); end; function CompareIntegersAsc(List: TStringList; Index1, Index2: Integer): Integer; var d1, d2: integer; begin // if d1=d2 then Exit; d1 := List[Index1].ToInteger; d2 := List[Index2].ToInteger; if d1 < d2 then Result := -1 else if d1 > d2 then Result := 1 else Result := 0; end; function CompareIntegersDesc(List: TStringList; Index1, Index2: Integer): Integer; var d1, d2: integer; begin d1 := List[Index1].ToInteger; d2 := List[Index2].ToInteger; if d1 > d2 then Result := -1 else if d1 < d2 then Result := 1 else Result := 0; end; function CompareDateTimeAsc(List: TStringList; Index1, Index2: Integer): Integer; var d1, d2: TDateTime; begin d1 := StrToDateTime(List[Index1]); d2 := StrToDateTime(List[Index2]); if d1 < d2 then Result := -1 else if d1 > d2 then Result := 1 else Result := 0; end; function CompareDateTimeDesc(List: TStringList; Index1, Index2: Integer): Integer; var d1, d2: TDateTime; begin d1 := StrToDateTime(List[Index1]); d2 := StrToDateTime(List[Index2]); if d1 > d2 then Result := -1 else if d1 < d2 then Result := 1 else Result := 0; end; //---------------------------------------------------------------------------- |
Собственно сам алгоритм сортировки и переставления в другом списке в соответствии с тем, который отсортировали
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 |
procedure TfSomeSort.SortListView2( SLToSort:TStringList; SLToChangeOrder:TStringList; DataType:string; // string integer tdatetime IsAsc:boolean ); var BufferSL:TStringList; NewIndex: Integer; i: Integer; BufferSL: TStringList; SLToSortAdressesBeforeSort:TStringList; SLToSortAdressesAfterSort:TStringList; address:DWORD; begin // BufferSL:=TStringList.Create; BufferSL:=TStringList.Create; SLToSortAdressesBeforeSort:=TStringList.Create; SLToSortAdressesAfterSort:=TStringList.Create; SLToSortAdressesBeforeSort.Clear; for i := 0 to SLToSort.Count-1 do begin address := DWord(Pointer(SLToSort[i])); SLToSortAdressesBeforeSort.Add(address.ToString); end; Memo1.Lines.Assign(SLToSortAdressesBeforeSort); //Запоминаем порядок BufferSL.Assign(SLToChangeOrder); //------------------------------Сортировка if AnsiLowerCase(DataType)='string' then if IsAsc=true then SLToSort.CustomSort(CompareStringAscending) else SLToSort.CustomSort(CompareStringDescending); if AnsiLowerCase(DataType)='integer' then if IsAsc=true then SLToSort.CustomSort(CompareIntegersAsc) else SLToSort.CustomSort(CompareIntegersDesc); if AnsiLowerCase(DataType)='tdatetime' then if IsAsc=true then SLToSort.CustomSort(CompareDateTimeAsc) else SLToSort.CustomSort(CompareDateTimeDesc); //------------------------------ SLToSortAdressesAfterSort.Clear; for i := 0 to SLToSort.Count-1 do begin address := longword(Pointer(SLToSort[i])); SLToSortAdressesAfterSort.Add(address.ToString); end; Memo2.Lines.Assign(SLToSortAdressesAfterSort); //Меняем порядок во 2 TStringList for i := 0 to SLToSortAdressesBeforeSort.Count-1 do begin NewIndex:=SLToSortAdressesAfterSort. IndexOf(SLToSortAdressesBeforeSort[i]); if NewIndex<>-1 then SLToChangeOrder[NewIndex]:=BufferSL[i] else SLToChangeOrder[NewIndex]:=''; end; FreeAndNil(SLToSortAdressesBeforeSort); FreeAndNil(SLToSortAdressesAfterSort); // FreeAndNil(BufferSL); FreeAndNil(BufferSL); end; |
Что повесим на кнопку bSort, на OnClick?
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
procedure TfSomeSort.bSortClick(Sender: TObject); begin SortListView2( FRandomListIntegers, FRandomListIntegers2, 'integer', true // <<<Ascending ); ListView.Items.Clear; ListView.Items.Count:=5; ListView.UpdateItems(0,ListView.Items.Count); end; |
В результате всё красиво отсортируется в Ascending порядке. Теперь, если заменить входящие данные, скажем на все одинаковые…
то алгоритм не только отсортирует данные, но и сохранит соответствие между двумя TStringList.
Этот пример можно обобщить , для нескольких TStringList. Скажем, есть 1 список, который нужно отсортировать, а остальные просто привести в соответствие. Это можно сделать при помощи TObjectList. Проделаю это в след. посте.
2 Responses to Delphi. Сортировка TStringList с приведением в соответствие другого TStringList