Данный пост является развитием предыдущего. Будем сортировать один TStringList -другие же приводить в соответствие с переставленными элементами.
|
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 |
Исходные данные у меня точно такие же. Не буду переписывать часть поста сюда.Изменился только алгоритм сортировки, так как теперь в соответствие нужно привести не один, а несколько списков.
Компараторы
|
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 |
//--------------------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 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
procedure TfSomeSort.SortOneOrderManyStringLists( SLToSort:TStringList; SLToChangeOrderObjectList:TObjectList; DataType:string; // string integer tdatetime IsAscending:boolean ); var SLToSortAdressesBeforeSort: TStringList; SLToSortAdressesAfterSort: TStringList; BufferSL: TStringList; address: longword; i: Integer; BufferSLObjectList: TObjectList; j: Integer; NewIndex: Integer; begin //Creation BufferSL:=TStringList.Create; SLToSortAdressesBeforeSort:=TStringList.Create; SLToSortAdressesAfterSort:=TStringList.Create; // Adresses before Sort for i := 0 to SLToSort.Count-1 do begin address := longword(Pointer(SLToSort[i])); SLToSortAdressesBeforeSort.Add(address.ToString); end; //Other String Lists Before Sort BufferSLObjectList:=TObjectList.Create; for i := 0 to SLToChangeOrderObjectList.Count-1 do begin BufferSLObjectList.Add(TStringList.Create); TStringList(BufferSLObjectList.Items[i]).Assign( TStringList(SLToChangeOrderObjectList.Items[i])); end; //------------------------------Sorting... if AnsiLowerCase(DataType)='string' then if IsAscending=true then SLToSort.CustomSort(CompareStringAscending) else SLToSort.CustomSort(CompareStringDescending); if AnsiLowerCase(DataType)='integer' then if IsAscending=true then SLToSort.CustomSort(CompareIntegersAsc) else SLToSort.CustomSort(CompareIntegersDesc); if AnsiLowerCase(DataType)='tdatetime' then if IsAscending=true then SLToSort.CustomSort(CompareDateTimeAsc) else SLToSort.CustomSort(CompareDateTimeDesc); //------------------------------ //-------------Getting Adresses After Sort--------------------- for i := 0 to SLToSort.Count-1 do begin address := longword(Pointer(SLToSort[i])); SLToSortAdressesAfterSort.Add(address.ToString); end; //----------------------------------------------------------- //--------------Updating order in other columns--------------------- for j := 0 to BufferSLObjectList.Count-1 do begin for i := 0 to TStringList(BufferSLObjectList[j]).Count-1 do begin NewIndex:=SLToSortAdressesAfterSort.IndexOf( SLToSortAdressesBeforeSort[i]); if NewIndex<>-1 then TStringList(SLToChangeOrderObjectList[j])[NewIndex]:= TStringList(BufferSLObjectList[j])[i];// else // TStringList(SLToChangeOrderObjectList[j])[NewIndex]:=''; end; end; //---------------------------------------------------------------- //Destroying FreeAndNil(BufferSL); FreeAndNil(BufferSLObjectList); FreeAndNil(SLToSortAdressesBeforeSort); FreeAndNil(SLToSortAdressesAfterSort); 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 |
procedure TfSomeSort.bSortOneOrderManyListsClick(Sender: TObject); var OtherStringListsObjectList:TObjectList; begin // OtherStringListsObjectList:=TObjectList.Create; OtherStringListsObjectList.OwnsObjects:=False; OtherStringListsObjectList.Add(FRandomListIntegers); OtherStringListsObjectList.Add(FRandomListIntegers2); OtherStringListsObjectList.Add(FRandomListDateTimes); SortOneOrderManyStringLists( FRandomListIntegers, OtherStringListsObjectList, 'integer', true ); ListView.Items.Clear; ListView.Items.Count:=5; ListView.UpdateItems(0,ListView.Items.Count); FreeAndNil(OtherStringListsObjectList); end; |
До сортировки
После сортировки
Также, этот алгоритм решил проблему с одинаковыми данными. Теперь, благодаря тому, что мы отслеживаем не сами значения а адреса памяти данных, мы избавились от зависимости от самих данных. Вот пример…
До сортировки
