Kłopot z uzyskaniem oczekiwanych rezultatów przy AlphaSort ListView'a.

Cześć.

Całą noc siedziałem i kodziłem, więć już ciężko myśle. A i poza tym małe doświadczenie z sortowaniami. Dlatego proszę bardziej doświadczonych o pomoc. Moja metoda sortujące dla ListView z ustawionym SortType = stData (bo chyba tak powinno być, ale moge się mylić) poniżej.

Dla kolumn od 0 do 2 włącznie sorotwanie jest ok, tak jak chcę. Jednak dodatkowo chciałbym żeby jeżeli wybierzemy do sortowania kolumnę o indeksie 3, sortowanie dla kolumny wyglądało następująco. Rosnąco tak jak wygląda mój typ, który reprezentuje zmienna RecordingStatus, czyli:

  TRecordingStatus = (rsInProgress, rsAwaiting, rsDone, rsWasError);

Malejąco wiadomo odwrotnie. I tak jest, ale jeżeli będziemy mieli kilka takich samych wartości dla RecordingStatus to mają one zostać posortowane Alfabetycznie zawsze rosnąco według tego co siedzi w Item1.Caption oraz Item2.Caption. Teraz niestety mam wpis na literę "C" przed wpisem zaczynającym się od "4". Także nie ogarniam co jest nie tak. Prosił bym o przykladowe kody. Rozwiązanie pewnie jest banalne, ale nie na mój niewyspany TBrain ;) Z góry dziękuję.

procedure TMainForm.RecordingsLVCompare(Sender : TObject; Item1, Item2 : TListItem; Data : Integer; var Compare : Integer);
var
  S1, S2 : string;
  I1, I2 : integer;
  Dt1, Dt2 : TDateTime;
  RD1, RD2 : TRecordingData;
begin
  S1 := Item1.Caption;
  S2 := item2.Caption;
  RD1 := TRecordingData(Item1.Data);
  RD2 := TRecordingData(Item2.Data);
  case FSortColumn of
    0 :
      begin
        Compare := AnsiCompareStr(S1, S2);
      end;
    1 :
      begin
        Dt1 := RD1.Begins;
        Dt2 := RD2.Begins;
        if Dt1 < Dt2 then
          Compare := -1
        else
          if Dt1 > Dt2 then
            Compare := 1
          else
            Compare := 0;
      end;
    2 :
      begin
        Dt1 := RD1.TheEnd;
        Dt2 := RD2.TheEnd;
        if Dt1 < Dt2 then
          Compare := -1
        else
          if Dt1 > Dt2 then
            Compare := 1
          else
            Compare := 0;
      end;
    3 :
      begin
        I1 := Integer(RD1.RecordingStatus);
        I2 := Integer(RD2.RecordingStatus);
        if I1 < I2 then
          Compare := -1
        else
          if I1 > I2 then
            Compare := 1
          else
            Compare := AnsiCompareStr(S1, S2);
      end;
  end;
  if FSortOrder = soDescending then
  begin
    Compare := -Compare;
  end;
end;

I1 := Integer(RD1.RecordingStatus);
I2 := Integer(RD2.RecordingStatus);

Nie musisz wykorzystywać rzutowania - możesz wykonać bezpośrednie rzutowanie zmiennych typu TRecordingData TRecordingStatus;

Twój kod najgorzej nie wygląda, ale zauważ, że przydałaby się nawet lokalna funkcja porównująca dwie daty i zwracająca wynik z przedziału -1 .. 1 - podobnie jak ma to miejsce w przypadku funkcji CompareValue; W sumie dwa razy wykonujesz ten sam kod (dwa porównania dat), tyle że daty pochodzą z innych pól/właściwości TRecordingData (nie znam tego typu); Dzięki temu można go skrócić i zwiększyć czytelność, tym samym zachowując zasadę DRY;

I tak jest, ale jeżeli będziemy mieli kilka takich samych wartości dla RecordingStatus to mają one zostać posortowane Alfabetycznie zawsze rosnąco według tego co siedzi w Item1.Caption oraz Item2.Caption. Teraz niestety mam wpis na literę "C" przed wpisem zaczynającym się od "4". Także nie ogarniam co jest nie tak.

To brzmi niepokojąco, bo w drabince warunków porównujesz dwa RecordingStatus i w momencie, gdy są sobie równe wywołujesz funkcję AnsiCompareStr i ona zwraca wynik porównania; W takim przypadku winna zamieszania jest funkcja porównująca, bo zwraca błędny winik - C w kodzie ASCII jest większe od 4, więc skoro wynik jest odwrotny to coś faktycznie z nią nie tak;

Sugeruję sprawdzić zmienne w debugerze i jeśli możesz prześledzić kod funkcji AnsiCompareStr, bo na pierwszy rzut oka zwraca błędne wyniki.

TRecordingData to prosta klasa dziedzicząca po TObject. Nie bardzo wychodzi mi debug w Delphi, poza tym teraz nie mam dostępu do kodu. Mam jednak prośbę czy możesz spróbować stworzyć ListView chociaż z dwoma kolumnami i zerowa będzie zawierać jakieś teks a w tej o indeksie 1 niech będą typy sk reprezentowane jako string z nazwą typu. I teraz chodzi o to że mając kilka typów na przykład skDone przy sortowaniu rosnącym wpisy mają o tym samym typie, być posortowane wedle alfabetu pod względem kolumny zerowe. I pokaż kod, jeśli będzie działał. Ja spróbuje takie coś przygptować ale to dopiero wieczorem, dziękuje z góry za wszelką pomoc.

Ja bym tego nie rzutował na Integer tylko użył funkcji Ord

Chwile nie było mnie na forum, dlatego nie odpisywałem;

@olesio @kAzek - typy wyliczeniowe (tak jak w przypadku TRecordingStatus) można porównywać bezpośrednio, nie trzeba ani Ord ani rzutowania na typ całkowitoliczbowy; Napisałem to na początku mojego posta; Wyliczenia to nic innego jak liczby typu co najmniej Byte (nowsze środowiska pewnie dają większy zakres i większą paletę wartości) tylko posiadają swoją nazwę;

Co do testu - dziś niestety nie dam rady, ale postaram się znaleźć chwilkę by pomóc; Mniej więcej rozumiem o co chodzi, więc jutro napiszę czy mi się udało czy nie :]

Ok, dzięki. Nie ma pośpiechu. Jutro zajrzę z pracy. Bo do popołudnia i całą noc siedziałem nad tym kodem żeby program działał. A że sortowanie tego jak nalezy potrzebne mi do szczęścia jest tylko po to aby całość była jak najlepiej zakodowana, to mogę poczekać. Ponieważ i tak będę pewnie musiał aktualizować mój kod.

@olesio - jest sukces, znalazłem rozwiązanie testując je na przykładowej, uboższej aplikacji;

Tak jak prosiłeś program ma dwie kolumny - w pierwszej tekst, w drugiej status; Pierwsza kolumna zawiera zwykły łańcuch, druga zaś posiada Caption o takiej nazwie, jak typ wyliczeniowy, a we właściwości Data posiada zrzutowany typ TRecordingStatus, który u siebie będziesz musiał zamienić na instancję klasy TRecordingData;

Nieco kombinacji odchodziło, ponieważ dawno nie korzystałem z TListView i zapomniałem na jakiej zasadzie w ogóle działa sortowanie; Utworzyłem w klasie formularza pole FColumnToSort, którego wartość ustalana jest w zdarzeniu OnColumnClick:

procedure TForm1.lvRecordingsColumnClick(Sender: TObject; Column: TListColumn);
begin
  FColumnToSort := Column.Index;
  (Sender as TCustomListView).AlphaSort();
end;

Po przypisaniu do pola indeksu kolumny wywołana zostaje metoda AlphaSort - o tym wyczytałem na StackOverflow; Następnie zostaje jedynie oprogramowanie zdarzenia OnCompare, w którym sprawdzany zostaje indeks kolumny, przechowywany w polu FColumnToSort i na jego podstawie zostaje wykonane porównanie albo teksty z pierwszej kolumny, albo statusu z pola Data:

procedure TForm1.lvRecordingsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);

  function CompareStatus(AFirst, ASecond: TRecordingStatus): Integer;
  begin
    if AFirst < ASecond then
      Result := -1
    else
      if AFirst > ASecond then
        Result := 1
      else
        Result := 0;
  end;

begin
  case FColumnToSort of
    0: Compare := CompareStr(Item1.Caption, Item2.Caption);
    1: Compare := CompareStatus(TRecordingStatus(Item1.Data), TRecordingStatus(Item2.Data));
  end;
end;

Jeśli kliknięto na pierwszą kolumnę - wynik porównania uzyskowany jest z rezultatu funkcji CompareStr, a jeżeli kliknięto w drugą kolumnę - lokalna funkcja CompareStatus zwraca wynik porównania statusów zawartych w polach Data argumentów Item1 i Item2; Wyniki działania sortowania przedstawiają poniższe zrzuty - z lewej po kliknięciu na pierwszą kolumnę, z prawej po kliknięciu drugiej kolumny:

Jak widać działa prawidłowo; W drugiej kolumnie wyświetlone etykiety odpowiadają faktycznym statusom zawartym we właściwościach Data itemów; Komponent uzupełniam w konstruktorze następującym kodem:

procedure TForm1.FormCreate(Sender: TObject);
const
  ITEMS_COUNT = Integer(4);
  STATES_COUNT = Integer(4);
const
  ITEMS_CAPTIONS: array [0 .. ITEMS_COUNT - 1] of AnsiString = ('0', '1', 'a', 'b');
  ITEMS_NUM_STATES: array [0 .. ITEMS_COUNT - 1] of TRecordingStatus = (rsInProgress, rsAwaiting, rsDone, rsWasError);
  ITEMS_STR_STATES: array [0 .. ITEMS_COUNT - 1] of AnsiString = ('rsInProgress', 'rsAwaiting', 'rsDone', 'rsWasError');
var
  lvItem: TListItem;
  intStateIdx, intItemIdx: Integer;
begin
  FColumnToSort := 0;

  for intStateIdx := 0 to STATES_COUNT - 1 do
  begin
    for intItemIdx := 0 to ITEMS_COUNT - 1 do
    begin
      lvItem := lvRecordings.Items.Add();
      lvItem.Caption := ITEMS_CAPTIONS[intItemIdx];
      lvItem.SubItems.Add(ITEMS_STR_STATES[intStateIdx]);
      lvItem.Data := Pointer(ITEMS_NUM_STATES[intStateIdx]);
    end;
  end;
end;

Zawartość macierzy ITEMS_CAPTIONS uzupełniona jest celowo takimi danymi, aby sprawdzić poprawność porównania zarówno liczbowych etykiet, jak i tekstowych; Jak widać itemy z liczbowymi Caption po posortowaniu według nazwy zostają poprawnie poukładane (czyli funkcja CompareStr działa prawidłowo), przy czym statusy także są w odpowiedniej kolejności;

Trzeba także zaznaczyć, że właściwość SortType nie ma znaczenia, bo jeśli oprogramuje się zdarzenie OnCompare to bez względu na jej wartość sortowanie i tak przebiegnie dokładnie tak, jak jest oprogramowane w zdarzeniu (właściwość ta nie będzie w niczym przeszkadzać); Tak przynajmniej wynika z testów;

Kod kompilowałem pod Delphi7 bo wiem, że z niego korzystasz i pod nim ma wszystko działać; Projekt testowej aplikacji dołączam w załączniku (bez pliku wykonywalnego).

Ok, dziękuje bardzo. Dokładniej sprawdzę to jutro wieczorem będąc w domu. A i mam nadzieję, że jak sobie odwróce sortowanie kolumn, bo taką możliwość mam teraz przy klikaniu na kolumny, nie skopie się sortowanie w niepożądany sposób.

olesio napisał(a)

A i mam nadzieję, że jak sobie odwróce sortowanie kolumn, bo taką możliwość mam teraz przy klikaniu na kolumny, nie skopie się sortowanie w niepożądany sposób.

@olesio - nie ma problemu; Choć mój kod z poprzedniego posta tego nie uwzględnia - wystarczy dodać nowe pole do klasy formularza, np. FSortDirection i w zdarzeniu OnColumnClick ustawić nie tylko indeks kolumny, ale także kierunek; Zakładając, że pole FSortDirection może przyjmować wartość 1 dla sortowania rosnącego i -1 dla malejącego, można to wykonać w poniższy sposób:

procedure TForm1.lvRecordingsColumnClick(Sender: TObject; Column: TListColumn);
begin
  if FColumnToSort = Column.Index then
    FSortDirection := -FSortDirection
  else
  begin
    FSortDirection := 1;
    FColumnToSort := Column.Index;
  end;

  TListView(Sender).AlphaSort();
end;

Dzięki temu gdy klikniemy kolumnę, według której nie było ustawione sortowanie - zawartość komponentu zostanie posortowana zawsze najpierw rosnąco, a po ponownym kliknięciu tej samej dopiero malejąco;

Kolejnym i ostatnim krokiem jest zmodyfikowanie kodu zdarzenia OnCompare tak, aby uwzględniało kierunek sortowania:

procedure TForm1.lvRecordingsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);

  function CompareCaption(const AFirst, ASecond: AnsiString): Integer;
  begin
    Result := CompareStr(AFirst, ASecond) * FSortDirection;
  end;

  function CompareStatus(const AFirst, ASecond: TRecordingStatus): Integer;
  begin
    Result := (Byte(AFirst) - Byte(ASecond)) * FSortDirection;
  end;

begin
  case FColumnToSort of
    0: Compare := CompareCaption(Item1.Caption, Item2.Caption);
    1: Compare := CompareStatus(TRecordingStatus(Item1.Data), TRecordingStatus(Item2.Data));
  end;
end;

To wszystko; Dodałem lokalną funkcję CompareCaption, która porównuje tekst z pierwszej kolumny i wynik wywołania funkcji CompareStr mnożony jest przez kierunek, czyli dla sortowania rosnąco wynik mnożony jest przez 1 (pozostaje bez zmian), a dla malejącego przez -1, czyli odwraca jego wartość; Należy także pamiętać o zainicjowaniu pól indeksu kolumny i kierunku np. w konstruktorze klasy formularza;

Przystosowaną do obustronnego sortowania aplikację umieszczam w załączniku; Kod działa poprawnie, więc wystarczy, że przystosujesz go do swojego kodu.

Dzięki za przykłady. Ogarnałem i wszystko w moim projekcie działa jak należy. Potwierdziłem Twoje rozwiązanie i dodałem plusiki dla Ciebie :)