Standardowy TListView z przezroczystym paskiem zaznaczenia.

Cześć.

Kombinuję i kombinuję, lecz sam za wiele wykombinować nie umiem, a chcę uzyskać efekt podobny do tego jaki posiadają TListView/Box w Total Commanderze. Wiem, że tam autor posłużył się zamiast TListView własnymi komponentami o klasie TMyListBox, więc pewnie mozolnie zakodował rysowanie kolumn, wyłączanie nagłowków, zmianę kolorów kolumn i rysowanie ikonek plików oraz pozostałe bajery. Pewnie kodem źródłowym się nie podzieli, a mi zależy tylko na jednym prostym efekcie. Takim jak na screenie poniżej, czyli aby pasek którym wybieramy wiersz był przezroczysty. Ale jednocześnie aby móc mieć narysowane SubItemy. Celowo dałem żarówiasty kolor czerwony żeby było to lepiej widać niż przy niebieskawym tle. Zaznaczane elementy mają pojawiać się na zółto. I tak poniższy kod dla zdarzenia AdvancedCustomDrawItem:

//...
procedure TSelectFilesForm.FilesLVAdvancedCustomDrawItem(
  Sender : TCustomListView; Item : TListItem; State : TCustomDrawState;
  Stage : TCustomDrawStage; var DefaultDraw : Boolean);
var
  S : string;
  BRect : TRect;
begin
  DefaultDraw := False;
  S := Item.Caption;
  if (Item.Selected) and (not Item.Focused) then
  begin
    Sender.Canvas.Brush.Color := DefaultBackgroundcolor;
    Sender.Canvas.FillRect(BRect);
    Sender.Canvas.Font.Color := Default_Selection_color;
    Sender.Canvas.TextRect(Item.DisplayRect(drLabel), Item.Position.x, Item.Position.Y, S);
  end;
  if Item.Focused then
  begin
    Sender.Canvas.Brush.Color := clWhite;
    Sender.Canvas.FrameRect(Item.DisplayRect(drLabel));
  end
  else
  begin
    Sender.Canvas.Brush.Color := DefaultBackgroundcolor;
    Sender.Canvas.FillRect(BRect);
    Sender.Canvas.Font.Color := clWhite;
    Sender.Canvas.TextRect(Item.DisplayRect(drLabel), Item.Position.x, Item.Position.Y, S);
  end;
end;
//...

Daje taki efekt i to tylko dzięki temu, że zastosowaliśmy DefaultDraw := False;.

Bez tej zmiennej lub jeśli ustawimy ją na True efekt będzie taki:

I tutaj pytanie i prośba do Was. Jak można uzyskać ładny efekt wyświetlenia kilku kolumn z podświetleniem wszystkich tekstów i z przezroczystym paskiem wyboru na całą szerokośc z ustawioną własnością RowSelect na True? Ma ktoś jakiś pomysł? Może ktoś z Was rzeźbił coś podobnego i móglby podzielić się kodem albo wskazówkami? Dodam, że użycie CustomDrawItem oraz CustomDrawSubItem odnosi identyczny skutek, w zależności od parametru DefaultDraw. Googlowałem na wiele sposobów, ale nic konkretnego się nie doszukałem. Z góry dziękuję za wszelką pomoc.

Czy mógłbyś dać (w postaci obrazka) co chcesz osiągnąć. Np przerób w paint'cie.

Ma to wyglądać tak jak pod Total Comanderem, czyli mamy przezroczysty pasek na przykład tylko z białą obwódką i widoczny kolor taki jaki jest dla TListView ustawiony. Efekt taki pokazuje obrazek 1.jpg ale bez wyświetlania zawartości innych niż pierwsza kolumna oraz bez rozciągania ramki na pozostałe kolujmny (jak widać obramowanie sięga tylko końca pierwszej kolumny. Przykłądowy wycinek, który to obrazuje.jak to wygląda w Total Commanderze pokazuje poniższy obrazek, z tym że mi nie zależy już na rysowaniu ikonek obok plików. Wybrany jest plik MFMWarp.exe.

Można taki efekt osiągnąć wykorzystując jedynie zdarzenie OnDrawItem:

procedure TMainForm.lvFilesDrawItem(Sender: TCustomListView; Item: TListItem;
                                    Rect: TRect; State: TOwnerDrawState);
var
  iDirOffset: Word;
begin
  with TListView(Sender).Canvas do
    begin
      { COLORS }
      Brush.Color := clBlue;

      case odFocused in State of
        True:  Pen.Color := clWhite;
        False: Pen.Color := clBlue;
      end;

      case odSelected in State of
        True:  Font.Color := clYellow;
        False: Font.Color := clWhite;
      end;

      { BACKGROUND }
      Rectangle(Rect);

      { FILE NAME }
      TextOut(Rect.Left + 4, Rect.Top + 2, Item.Caption);
      { DIRECTORY }
      iDirOffset := TListView(Sender).Column[0].Width + 4;
      TextOut(Rect.Left + iDirOffset, Rect.Top + 2, Item.SubItems[0]);
    end;
end;

Co da np. taki efekt:

czyli item zaznaczony ma żółtą czcionkę, niezaznaczony - białą; Ramka koloru białego tylko przy odFocused, tło zawsze o takim samym kolorze; Aby odpowiednio narysować tekst subitema wystarczy znać szerokość pierwszej kolumny i odpowiednio ustawić ofset dla tekstu z drugiej kolumny (i analogicznie dla kolejnych); Oczywiście RowSelect działa znakomicie, także MultiSelect;

Nie wiem czy piszesz tą aplikację w WinAPI, czy pod VCL (choć wydaje się, że to VCL) więc nie wiem, czy takie rozwiązanie będzie Ci pasowało;

Ewentualnie jeśli chcesz się bawić w malowanie każdej komórki z osobna - sprawdź w której kolumnie znajduje się komórka i maluj obramowanie osobno; W ten sposób unikniesz linii granicznej komórek; Jedynym minusem jest wzrost długości kodu procedury, co może się przełożyć na szybkość odświeżania listy przy sporej ilości itemów (miganie);

Wielkie dzięki. Dokładnie o takie rozwiązanie mi chodziło i to pod VCL, bo wyjątkowo program po kilku napisanych w czystym WinAPI piszę pod VCL, bo muszę skorzystać z Synapse i HTTPS, ponieważ nie chciało by mi się rzeźbić i tworzyć koło od nowa męcząc się w obsługę SSL przez dllki, które ładnie zaimplementowane ma Synapse. Poza tym docelowy program korzysta z wyrażeń regularnych, a tych również nie chciało by mi się przerabiać na WinAPI albo na złożoną procedurę wycinającą odpowiednie teksty z kodu html stron. Poniżej pokazuje dokładnie rozwiązanie jakie mnie urządziło, to znaczy przy odFocused i odSelected ma nie podświetlać na zółto, bo docelowo to czy jakiś Item jest wybrany będzie wynikało nie z MultiSelect (ta własność będzie ustawiona na False), tylko z własności pól obiektu dodanego jako Dane do Itemów. Oczywiście przy posiadaniu więcej niż dwóch kolumn należy sobie odpowiednio zwiększyć zmienną, którą nazwałeś IDirOffSet, po czym napisać przez TextOut tekst pozostałych SubItemów, ale to nie problem. Jeszcze raz dziękuję :)

//...
procedure TSelectFilesForm.FilesLVDrawItem(Sender : TCustomListView;
  Item : TListItem; Rect : TRect; State : TOwnerDrawState);
var
  IDirOffset : Word;
begin
  with TListView(Sender).Canvas do
  begin
    Brush.Color := DefaultBackgroundColor;
    case odFocused in State of
      True : Pen.Color := clWhite;
      False : Pen.Color := DefaultBackgroundColor;
    end;
    case odSelected in State of
      True : Font.Color := Default_Selection_color;
      False : Font.Color := clWhite;
    end;
    if State = [odSelected, odFocused] then
    begin
      Font.Color := clWhite;
    end;
    Rectangle(Rect);
    TextOut(Rect.Left + 4, Rect.Top + 2, Item.Caption);
    IDirOffset := TListView(Sender).Column[0].Width + 4;
    TextOut(Rect.Left + IDirOffset, Rect.Top + 2, Item.SubItems[0]);
  end;
end;
//...

P.S.: A i pod WinAPI jakby poczytać o ustawianiu kolorów oraz obsłudze customdrawningu choćby na MSDnie to pewnie można też to zrobić. A sam nie wpadłem jak to zrobić, bo rzadko musiałem kolorować w sposób niestandardowy zawartośc ListView, zwykle wystarczył mi tylko kolumny i tło, co na ogół sam jakoś ogarniałem.

EDIT: Dzięki informacjom i przykładowemu kodowi ze strony: http://stackoverflow.com/questions/6630354/delphi-bug-when-resizing-columns-of-list-view-on-drawitem poprawiłem powyższy kod i dzięki temu prawidłowo rysują się w szerokości teksty, po zmianach rozmiaru kolum i nie przekraczają ich szerokości. Wklejam, bo może ktoś też będzie szukał i potrzebował tego.

procedure TSelectFilesForm.FilesLVDrawItem(Sender : TCustomListView;
  Item : TListItem; Rect : TRect; State : TOwnerDrawState);
var
  R : TRect;
  S : string;
  LV : TListView;
  I, X1, X2 : integer;
begin
  LV := TListView(Sender);
  with LV.Canvas do
  begin
    Brush.Color := DefaultBackgroundColor;
    case odFocused in State of
      True : Pen.Color := clWhite;
      False : Pen.Color := DefaultBackgroundColor;
    end;
    case odSelected in State of
      True : Font.Color := Default_Selection_color;
      False : Font.Color := clWhite;
    end;
    if State = [odSelected, odFocused] then
    begin
      Font.Color := clWhite;
    end;
  end;
  X1 := 4;
  X2 := 0;
  R := Rect;
  Sender.Canvas.FillRect(Rect);
  for I := 0 to LV.Columns.Count - 1 do
  begin
    X2 := X2 + ListView_GetColumnWidth(LV.Handle, LV.Columns[I].Index);
    R.Left := X1;
    R.Right := X2;
    if i = 0 then
    begin
      S := Item.Caption;
    end
    else
    begin
      S := Item.SubItems[I - 1];
    end;
    DrawText(Sender.Canvas.Handle, PChar(S), Length(S), R,
      DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
    X1 := X2;
  end;
  if odFocused in State then
  begin
    DrawFocusRect(Sender.Canvas.Handle, Rect);
  end;
end;

olesio napisał(a)

Poniżej pokazuje dokładnie rozwiązanie jakie mnie urządziło, to znaczy przy odFocused i odSelected ma nie podświetlać na zółto, bo docelowo to czy jakiś Item jest wybrany będzie wynikało nie z MultiSelect (ta własność będzie ustawiona na False), tylko z własności pól obiektu dodanego jako Dane do Itemów.

Domyślałem się, że tak to będzie wyglądało, ponieważ podczas kliknięcia LPM na dowolny niezaznaczony item bez wciśniętego Ctrl wszystkie zaznaczone itemy zostaną odznaczone, a nie tak jest w listach Total Commander'a;

Mam jeszcze jedną uwagę co do tego kodu:

    case odFocused in State of
      True : Pen.Color := clWhite;
      False : Pen.Color := DefaultBackgroundColor;
    end;

    case odSelected in State of
      True : Font.Color := Default_Selection_color;
      False : Font.Color := clWhite;
    end;

    if State = [odSelected, odFocused] then
    begin
      Font.Color := clWhite;
    end;

ostatni warunek możesz przenieść do drugiego bloku case .. of:

    case odFocused in State of
      True : Pen.Color := clWhite;
      False : Pen.Color := DefaultBackgroundColor;
    end;

    case odSelected in State of
      True : case odFocused in State of
               True: Font.Color := clWhite;
               False: Font.Color := Default_Selection_color;
             end;

      False : Font.Color := clWhite;
    end;

Trochę to podejrzane, że odwołujesz się do zbioru w ten sposób - if State = [odSelected, odFocused] then - trzeba być pewnym, że zbiór ten nie będzie przyjmował jeszcze jednej wartości (ale to tylko suche przypuszczenia, trzeba by to sprawdzić); Jeśli nie będzie w takiej postaci to już czcionka nie otrzyma nowego koloru; Łącząc warunki w ww. przeze mnie sposób unikniesz tego problemu;

Masz rację, czasami może się zdarzyć, że ten zbiór State będzie zawierał jeszcze jakieś wartośći, dlatego poprawiłem tak jak sugerowałeś. Jeszcze raz dziękuję za zainteresowanie i pomoc.

@Furious Programming, ależ ty uwielbiasz ten case, pchasz go wszędzie gdzie się da. Jeszcze trochę a zamiast:

if a<0 then a:=0;

zaczniesz pisać:case a<0 of
true: a:=0;
end;

To można załatwić elegancko:
```delphi
const PenColor:array[Boolean]of TColor=(DefaultBackgroundColor,clWhite);
const FontColor:array[Boolean]of TColor=(Default_Selection_color,clWhite);

Pen.Color := PenColor[odFocused in State];
Font.Color := FontColor[(State and [odSelected,odFocused])<>0];

@_13th_Dragon ma rację, też tak można z tablicami, ale u mnie DefaultBackgroundColor to zmienna ustalana z RGB, także może być jak dla mnie i case, żeby później nie deklarować tablicy jako zmiennej i pamiętać aby ją odpowiednio zainicjowac przykładowo w zdarzeniu OnCreate. Poniżej ostateczny poprawiony kod, bo wcześniej jak mieliśmy puste kolumny od indeksie większym od 0 to następował wyjątek. Poza tym dodany typ klasy, która będzie decydowała o wyborze i wszystko już działa tak jak chciałem. Także jeszcze raz wszystkim dziękuję, mam nadzieję, że nasz wspólne kombinowanie przyda się komuś jeszcze w przyszłości.

procedure TSelectFilesForm.FilesLVDrawItem(Sender : TCustomListView;
  Item : TListItem; Rect : TRect; State : TOwnerDrawState);
var
  R : TRect;
  S : string;
  LV : TListView;
  FD : TFileData;
  I, X1, X2 : integer;
begin
  LV := TListView(Sender);
  with LV.Canvas do
  begin
    Brush.Color := DefaultBackgroundColor;
    case odFocused in State of
      True : Pen.Color := Default_Text_Color;
      False : Pen.Color := DefaultBackgroundColor;
    end;
    case odSelected in State of
      True : case odFocused in State of
          True, False : Font.Color := Default_Text_Color;
        end;
      False : Font.Color := Default_Text_Color;
    end;
    FD := TFileData(Item.Data);
    if FD <> nil then
    begin
      case FD.IsFileSelected of
        True : Font.Color := Default_Selection_color;
        False : Font.Color := Default_Text_Color;
      end;
    end;
  end;
  X1 := 4;
  X2 := 0;
  R := Rect;
  Sender.Canvas.FillRect(Rect);
  for I := 0 to LV.Columns.Count - 1 do
  begin
    X2 := X2 + ListView_GetColumnWidth(LV.Handle, LV.Columns[I].Index);
    R.Left := X1;
    R.Right := X2;
    if i = 0 then
    begin
      S := Item.Caption;
    end
    else
    begin
      if I <= Item.SubItems.Count then
      begin
        S := Item.SubItems[I - 1];
      end
      else
      begin
        S := '';
      end;
    end;
    if S <> '' then
    begin
      DrawText(Sender.Canvas.Handle, PChar(S), Length(S), R,
        DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS);
    end;
    X1 := X2;
  end;
  if odFocused in State then
  begin
    DrawFocusRect(Sender.Canvas.Handle, Rect);
  end;
end;

_13th_Dragon napisał(a)

@Furious Programming, ależ ty uwielbiasz ten case, pchasz go wszędzie gdzie się da.

Wybacz, ale nie wszędzie;

Po prostu używam bloku case .. of zamiast if .. then .. else tylko wtedy, gdy są co najmniej dwie możliwości (znajdź proszę kod, który napisałem wykorzystując blok case .. of obsługujący tylko jedną możliwość - wtedy podyskutujemy); To taki nawyk, dawniej często musiałem stosować kilka if .. then .. else .. if .. then .. else .., zamiast tego stosowałem case .. of, bo przecież do tego służy; Dzięki temu kod stawał się (jak dla mnie) bardziej czytelny i tak zostało; Działanie jest takie samo, a zastosowanie tego bloku pozwala mi szybciej modyfikować warunki; Często jest tak, że zrobię if .. then .. else i jest w porządku, ale przy późniejszej modyfikacji (gdy dojdzie kolejna wartość, a pojedynczy if nie obsłuży trzech możliwości) muszę wszystko przepisywać (w sumie przenosić) do bloku case .. of i tracę na tym czas; A często się tak zdaża;

Myślę, że używanie tego bloku to nie zbrodnia, a na pewno nie zła praktyka; Dla mnie jest to po prostu wygodniejsze; Powtórzę - dla mnie, jeśli komuś to nie pasuje może w każdym momencie zamienić na if .. then .. else; Proszę się mnie więcej nie czepiać, bo taka metoda kodzenia to indywidualne "widzimisie" - każdy ma inny styl pisania kodu i trzeba to uszanować (nie tyczy sie to jednak formatowania kodu, które musi być zawsze stosowane, jakiekolwiek, byle by kod był znacznie czytelniejszy od tego bez użycia klawisza spacji);