furious programming
2019-12-05 03:37

Kolejny wpis na temat bazgrołów graficznych w Lazarusie, bo dawno nic na ten temat nie pisałem. :)

Powoli kończę prace nad narzędziem do organizowania i wygodnego przeprowadzania stacjonarnych mistrzostw w Tetrisa. Obecnie finalizuję implementację animowanego banera, który u dołu okna podglądu będzie wyświetlał różne teksty i adresy kont w serwisach społecznościowych (małą próbkę pokazałem w wątku Łączenie dwóch obrazów w jeden na podstawie zadanego poziomu – można sobie zobaczyć o co chodzi). Aby użytkownik mógł sobie konfigurować zawartość i zachowanie takiego banera, potrzebny jest interfejs do modyfikowania jego ustawień, z jednoczesnym podglądem końcowego efektu. I małą część tego interfejsu przedstawię w tym wpisie.


Renderowanie dwukolorowego tekstu

Niektóre etykiety banera służą do wyświetlania tekstu, którego fragmenty mogą być malowane używając jednego z dwóch zadanych kolorów – w celu wizualnego podziału linijki tekstu na fragmenty ”godne uwagi”, coby nie cudować z interpunkcją. Czyli w skrócie: mamy linijkę tekstu, w tym tekście wstawione są znaki określające ”swap” bieżącego koloru (tym znakiem jest |), mamy współrzędne określające pozycję docelową tekstu i mamy dwa kolory (startowy i dodatkowy). Wynikiem działania ma być dwukolorowy tekst wyrenderowany na zadanym płótnie.

procedure DrawTextStriped(ACanvas: TCanvas; AX, AY: Integer; AColorA, AColorB: TColor; const AText: String);
var
  Stripes: TStringList;
  Stripe: String;
var
  StripeColors: array [Boolean] of TColor;
  StripeColorIndex: Boolean = False;
begin
  Stripes := TStringList.Create();
  try
    if ExtractStrings(['|'], [], PChar(AText), Stripes, True) > 0 then
    begin
      StripeColors[False] := AColorA;
      StripeColors[True] := AColorB;

      for Stripe in Stripes do
      begin
        ACanvas.Font.Color := StripeColors[StripeColorIndex];
        ACanvas.TextOut(AX, AY, Stripe);

        AX += ACanvas.TextWidth(Stripe);
        StripeColorIndex := not StripeColorIndex;
      end;
    end;
  finally
    Stripes.Free();
  end;
end;

Procedurka bardzo prosta w działaniu. Do pomocniczej listy łańcuchów wypakowujemy fragmenty tekstu, rozdzielone według znaku markera (koniecznie z zachowaniem białych znaków, dlatego drugi parametr otrzymuje pusty zbiór). Kolory pakujemy do macierzy indeksowanej wartością logiczną (bo najłatwiej odwrócić indeks bieżącego koloru – wystarczy prosta negacja) i ustawiamy indeks bieżącego koloru na pierwszą komórkę (o indeksie False). Następnie w pętli renderujemy bieżący fragment, inkrementujemy pozycję horyzontalną o pikselową szerokość fragmentu i odwracamy (negujemy) indeks koloru. To wszystko.

Przykładowe wykorzystanie powyższej procedury do namalowania tekstu na płótnie formularza, w zdarzeniu OnPaint okna:

procedure TMainForm.FormPaint(ASender: TObject);
begin
  Canvas.Brush.Color := clWindow;
  Canvas.FillRect(ClientRect);

  Canvas.Font.Name := 'Gotham Black';
  Canvas.Font.Size := 19;

  DrawTextStriped(Canvas, 16, 16, clWindowText, clHighlight, 'LOREM IPSUM |DOLOR SIT| AMET');
end;

Efekt działania:

0.png

Fajnie, możemy już malować ”pasiasty” tekst, no ale użytkownik musi go jakoś wprowadzać i widzieć podgląd w kontrolkach, a nie na gołym płótnie okna – dlatego czas na przygotowanie interfejsu.


Renderowanie podglądu w komponencie

Do podglądu etykiety skorzystamy z kontrolki typu TPaintBox, bo służy do malowania różnych pierdół i przy okazji nie obsługuje focusa. Jakie tło wybrać? Przecież jednolite będzie wyglądać brzydko, w przypadku gdy kolor tła będzie inny niż komponentu nadrzędnego (lub okna). Do wprowadzania tekstu wykorzystamy zwykły TEdit, więc idąc za ciosem, niech nasz paintbox też wygląda jak pole edycyjne.

No dobrze, ale jak namalować obramowanie pola edycyjnego w paintbox? W końcu nie wiadomo jakich kolorów używa system… Tu z pomocą przychodzi obiekt ThemeSevices z modułu Themes. ;)

Jego użycie jest banalne – wystarczy pobrać ”detale” za pomocą metody GetElementDetails, podając enum określający interesujący nas element. Tak pozyskane detale następnie należy podać metodzie DrawElement, razem z uchwytem płótna oraz obszarem docelowym:

procedure DrawBannerBackground(ACanvas: TCanvas; ARect: TRect);
var
  Details: TThemedElementDetails;
begin
  Details := ThemeServices.GetElementDetails(teEditTextNormal);
  ThemeServices.DrawElement(ACanvas.Handle, Details, ARect);
end;

Tej procedurki używamy wewnątrz zdarzenia OnPaint kontrolki paintbox:

procedure TMainForm.CBannerPaintBoxPaint(ASender: TObject);
var
  PaintBox: TPaintBox absolute ASender;
begin
  DrawBannerBackground(PaintBox.Canvas, PaintBox.ClientRect);
end;

W rezultacie na ekranie zobaczymy jedno pole, które faktycznie jest edycyjnym (górne) oraz drugie, które służy tylko do podglądu (dolne):

1.png

Tło mamy z głowy – teraz ostatnia rzecz, czyli namalowanie tekstu wewnątrz niby-edita.


Renderowanie tekstu etykiety

Procedurkę do renderowania pasiastego tekstu już mamy, więc pozostało wyznaczyć odpowiednią pozycję tekstu i go namalować. Ale tym razem wyrenderujemy go wyśrodkowanego w poziomie i z odpowiednio wypozycjonowanego w pionie, aby zachować równe odstępy od krawędzi. No to machnijmy drugą procedurę:

procedure DrawBannerLabel(ACanvas: TCanvas; ARect: TRect; AColorA, AColorB: TColor; const AText: String);
var
  Text: String;
  TextWidth, TextLeft, TextTop: Integer;
begin
  ACanvas.Font.Name := 'Gotham Black';
  ACanvas.Font.Size := 19;
  ACanvas.Brush.Style := bsClear;

  Text := AText.Trim();
  TextWidth := ACanvas.TextWidth(StringReplace(Text, '|', '', [rfReplaceAll]));

  TextLeft := ARect.Left + (ARect.Width - TextWidth) div 2;
  TextTop := ARect.Top + 3;

  DrawTextStriped(ACanvas, TextLeft, TextTop, AColorA, AColorB, Text);
end;

Tutaj trochę magii. Nie możemy centrować surowego tekstu z parametru, dlatego że ten zawiera znaki markera, które nie będą renderowane na ekranie. Dlatego przed zmierzeniem szerokości tekstu, najpierw należy z niego usunąć te znaki – stąd użycie StringReplace. Wywołanie przygotowanej procedury należy dodać do zdarzenia OnPaint i tak samo jak wcześniej określić parametry, ale zamiast gołego tekstu, należy przekazać zawartość pola edycyjnego:

procedure TMainForm.CBannerPaintBoxPaint(ASender: TObject);
var
  PaintBox: TPaintBox absolute ASender;
begin
  DrawBannerBackground(PaintBox.Canvas, PaintBox.ClientRect);
  DrawBannerLabel(PaintBox.Canvas, PaintBox.ClientRect, clWindowText, clHighlight, CBannerEdit.Text);
end;

To wszystko – teraz wystarczy wywołać Invalidate paintboxa w zdarzeniu OnChange pola edycyjnego i można cieszyć oko kontrolką pokazującą na żywo końcowy efekt. Normalnie technologia WYSIWYG. ;)

2.png

Dzięki wykorzystaniu tła systemowej kontrolki oraz kolorów zgodnych ze skórką, zawartość paintboxa zawsze będzie wyglądać dobrze, nieważne na jakim systemie i konfiguracji. Ba, nawet jeśli użytkownik zmieni schemat podczas działania programu, to jego okna zostaną odmalowane po takiej zmianie, a więc i komponenty dostosują swój wygląd do nowych ustawień.

3.png


Podsumowanie

Jak widać roboty niewiele, a efekt końcowy całkiem przyzwoity. Oczywiście to co opisałem wyżej do tylko wierzchołek góry lodowej – w swoim projekcie wykorzystuję znacznie bardziej zaawansowane renderowanie banera (tekst z ikonkami, opcjonalnie gradientowe tło), a także podobną technikę stosuję do renderowania podglądu profilu gracza, zawierającego najróżniejszy tekst, separator, flagę i ”naklejki” ze specjalnymi osiągnięciami. Natomiast systemowe kolory wykorzystywane są nie tylko do tekstu, ale też do barwienia półprzezroczystych grafik naklejek, a podczas wprowadzania danych, aktywny element jest renderowany w kolorze zaznaczenia. Ale to już inna bajka – więcej na jej temat już niebawem.

To co podałem wyżej powinno wystarczyć do prostych zastosowań, nakreślić sposób wykorzystania ”renderera” systemowych komponentów oraz skłonić do tworzenia programów desktopowych w taki sposób, aby zachować kompatybilność z ustawioną przez użytkownika skórką. ;)

#fpc #free-pascal #lazarus

cerrato

Spójrz na to inaczej - ci, którzy do czegoś doszli w realnym życiu, mają lepsze zajęcia, niż siedzenie 24/7 na forum. Czyli ludzie z największą aktywnością to są po prostu przegrywy, których jedynym życiowym osiągnięciem jest duża ilość postów na 4P :P

furious programming

@Pepe: to że jestem zalogowany przez 12h dziennie, wcale nie oznacza, że przez tyle czasu przeglądam forum. A tak naprawdę, gdyby policzyć, na faktycznym czytaniu i pisaniu na forum nie spędzam więcej niż godzinę dziennie. ;)

Niektórzy z Was naprawdę się przykładają do swojej roli (a przecież w tym czasie moglibyście tworzyć coś komercyjnego, lub cokolwiek)...

Jeśli o mnie chodzi to większość technicznych wpisów na blogu zawiera informacje i źródła wyciągnięte z opracowywanych projektów. Np. ostatnie kilka wpisów dotyczą bieżącego projektu, czyli narzędzia do Tetrisa (renderowanie, łatanie bugów kontrolki CheckListBox, półprzezroczysty Splash Screen itp.).

Z chęcią bym napisał coś więcej, opisał implementację konkretnego edytorka (używanego w głównym projekcie, bo te są znacznie bardziej zaawansowane), ale trwało by to dość długo, a po drugie, musiałbym pisać na raty i porozbijać całość na kilka wpisów (bo te mają ograniczenie długości), co zjadłoby jeszcze więcej czasu. Doba musiała by mieć 30 godzin.

furious programming
2019-07-22 17:06

Dawno nie pisałem o różnych ciekawych bazgrołach graficznych, związanych z programowaniem komponentów dla aplikacji okienkowych. Od ostatniego wpisu minęły prawie dwa lata, więc dziś kolejny w tej tematyce. Ale nie o komponentach będzie – tym razem pobawimy się oknem i jego właściwościami. ;)


Splash Screen z półprzezroczystą grafiką

Wiele programów podczas rozruchu wyświetla tzw. splash screen, czyli okienko wizytówki, najczęściej z logotypem programu, kilkoma informacjami i czasem z postępem ładowania danych. Z reguły są to prostokątne okienka bez obramowania, zawierające w sobie jedynie obraz ładowany z zasobów. W końcu służy głównie do tego, aby pokazać użytkownikowi że program startuje i musi poczekać.

Ale niektóre aplikacje mają bardziej skomplikowaną wizytówkę, o nieregularnym kształcie, z tłem w postaci obrazu wykorzystującego półprzezroczystość (jako kanał alpha w 32-bitowej grafice) i antialiasing. Dzięki temu możliwe jest wyświetlenie okna, które nie tylko charakteryzuje się gładkimi, rozmytymi krawędziami, ale też może rzucać cień na zawartość znajdującą się pod oknem. Efekt jest taki, jakby półprzezroczystą grafikę po prostu namalować na płótnie pulpitu.

Jak to zrobić? Jak sprawić, aby okno przyjęło kształt grafiki, w dodatku o nieregularnym kształcie? Jak zmusić je do wykorzystywania fragmentów płótna pulpitu znajdującego się pod oknem? I jak sprawić, aby można je było przesuwać, cały czas używając odpowiedniego obszaru tła w miejscach półprzezroczystych?


1. Przygotowanie obrazu tła

Żeby móc sprawdzić czy okno wizytówki spełnia wszystkie założenia, wykorzystamy grafikę charakteryzującą się fragmentami całkiem przezroczystymi, półprzezroczystymi i nieprzezroczystymi. Aby nakładanie półprzezroczystych pikseli na zawartość pod oknem było dobrze widoczne, użyjemy grafiki wykorzystującej antialiasing krawędzi, z dodatkowym cieniem całości.

Żeby długo nie szukać, wejźmy logo 4programmers i je trochę podrasujmy:

0.png

Obraz powinien wspierać kanał alpha, dlatego posłużę się zwykłą, 32-bitową grafiką PNG (choć BMP też by się nadał).


2. Przygotowanie formularza

Do stworzenia takiej wizytówki wystarczy zwykły formularz bez żadnej zawartości. Aby wyświetlał się zawsze na środku ekranu, należy ustawić Position na poScreenCenter (nie poDesktopCenter, bo w przypadku stanowiska wielomonitorowego może się wyświetlić w połowie na jednym i w połowie na drugim ekranie, i niestety sporo programów tak robi…). Aby nie miał obramowania, wystarczy ustawić BorderStyle na bsNone, a żeby wizówka podczas ładowania danych programu nie przepadła w natłoku okien, można ustawić FormStyle na fsSystemStayOnTop.

Goły formularz o dowolnych rozmiarach, nic więcej:

1.png

Rozmiar okna może być zgodny z rozmiarem obrazu tła wizytówki, ale można go dostosować po załadowaniu grafiki do pamięci – dzięki temu nie trzeba będzie dotykać kodu źródłowego, jeśli zechcemy użyć innego, większego lub mniejszego obrazu.

Warto ustalić treść dla tytułu okna, bo choć nie jest ono w nim wyświetlane (jego obramowanie jest wyłączone), to system wykorzystuje je np. podczas przełączania aplikacji za pomocą klawiatury (w popupie po wciśnięciu Alt+Tab). Zapewne też w wielu innych miejscach.


2. Ładowanie obrazu tła do pamięci

W tym przykładzie posłużę się sposobem najbardziej uniwersalnym i najłatwiejszym do testowania, czyli załadowaniem obrazu z pliku znajdującego się obok pliku wykonywalnego programu. Nic nie stoi na przeszkodzie, aby załadować go z zasobów pliku wykonywalnego czy biblioteki DLL, ale tu niech będzie prosto.

Przyda się więc pole do przechowywania grafiki w pamięci, także kontruktor i destruktor do zadbania o pamięć:

type
  TSplashForm = class(TForm) 
  private
    FLogo: TPortableNetworkGraphic;
  private
    procedure InitLogo();
    procedure DoneLogo();
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  end;

{..}

constructor TSplashForm.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  InitLogo();
end;

destructor TSplashForm.Destroy();
begin
  DoneLogo();
  inherited Destroy();
end;

procedure TSplashForm.InitLogo();
begin
  FLogo := TPortableNetworkGraphic.Create();
  FLogo.LoadFromFile('logo.png');
end;

procedure TSplashForm.DoneLogo();
begin
  FLogo.Free();
end;

3. Aktualizacja właściwości okna

Po załadowaniu obrazu do pamięci, najpierw należy dostosować rozmiar okna do wymiarów grafiki. Dodajmy nową metodę i dorzućmy jej wywołanie do kontruktora klasy okna:

type
  TSplashForm = class(TForm)
  private
    procedure InitForm();
  {..}
  end;

{..}

procedure TSplashForm.InitForm();
begin
  SetBounds(Left, Top, FLogo.Width, FLogo.Height);
end;

Teraz, skoro już obraz znajduje się w pamięci i formularz ma odpowiedni rozmiar, można się zabrać za aktualizację właściwości okna. Jednak zamiast samemu kombinować z ręcznym pobieraniem obszaru płótna pulpitu i renderowaniem zawartości gdzieś w metodzie Paint czy WMPaint, można nakazać systemowi, aby sam zajął się wszystkim – niech się w końcu do czegoś przyda. Dzięki temu okno nie tylko będzie posiadało odpowiedni kształt (zgodny z zawartością obrazu tła), ale też system zajmie się odpowiednim odmalowywaniem jego zawartości. Rozwiązanie krótkie i wygodne.

Aby było to możliwe, należy skorzystać z funkcjonalności wielowarstwowych okien, czyli ze stylu WS_EX_LAYERED. Do samej aktualizacji wielowarstwowego okna służy funkcja UpdateLayeredWindow, dostępna już w Windows 2000. Niestety Lazarus jak zwykle nie posiada importu tej funkcji w module Windows, więc trzeba ją sobie dociągnąć samemu:

function UpdateLayeredWindow(
  hWnd: HWND;
  hdcDst: HDC;
  pptDst: PPOINT;
  psize: PSIZE;
  hdcSrc: HDC;
  pptSrc: PPOINT;
  crKey: COLORREF;
  pblend: PBLENDFUNCTION;
  dwFlags: DWORD
): BOOL; stdcall; external 'user32.dll';

Teraz wystarczy dodać sobie kolejną metodę, która zaktualizuje styl i właściwości wielowarstwowego okna:

type
  TSplashForm = class(TForm)
  private
    procedure UpdateForm();
  {..}
  end;

{..}

procedure TSplashForm.UpdateForm();
var
  WindowExStyle: LONG;
var
  LogoBlend: BLENDFUNCTION;
  LogoLocation: POINT;
  LogoSize: SIZE;
begin
  WindowExStyle := GetWindowLong(Handle, GWL_EXSTYLE);

  if WindowExStyle and WS_EX_LAYERED = 0 then
    SetWindowLong(Handle, GWL_EXSTYLE, WindowExStyle or WS_EX_LAYERED);

  LogoBlend.BlendOp := AC_SRC_OVER;
  LogoBlend.BlendFlags := 0;
  LogoBlend.SourceConstantAlpha := 255;
  LogoBlend.AlphaFormat := AC_SRC_ALPHA;

  LogoLocation := Windows.POINT.Create(0, 0);
  LogoSize := Windows.SIZE.Create(FLogo.Width, FLogo.Height);

  UpdateLayeredWindow(Handle, 0, nil, @LogoSize, FLogo.Canvas.Handle, @LogoLocation, 0, @LogoBlend, ULW_ALPHA);
end;

Najpierw pobieramy styl okna i sprawdzamy czy jest wielowarstwowe – jeśli nie to ustawiamy mu odpowiedni styl za pomocą SetWindowLong, podając nowy zestaw flag. Następnie wypełniamy strukturę dotyczącą sposobu obsługi przezroczystości grafiki, określamy rozmiar i lokalizację grafiki i na koniec wołamy funkcję aktualizującą, podając wszystkie dane w parametrach.


4. Efekt działania kodu

Powyższy kod działa jak należy, tworzy okno zgodnie z zawartością obrazu tła (tu: o nieregularnym kształcie, z całkowicie przezroczystymi obszarami wewnątrz i na zewnątrz) i dobrze obsługuje przezroczystość:

2.png

Ale jest jeden problem – o ile rozmyte krawędzie okna są półprzezroczyste, to niektóre piksele źle łączą się z tłem pod oknem, tworząc brzydką, jasną obwódkę. Najlepiej jest to widoczne na kolorowym tle, bo na jasnym (albo wręcz białym) można nie zauważyć i klienci będą się turlać ze śmiechu:

3.png

Trzeba więc to naprawić.


5. Przemnożenie składowych pikseli

Aby pozbyć się niechcianego defektu, należy ręcznie przemnożyć składowe wszystkich pikseli przez odpowiadającą im wartość kanału alpha. Do tego celu jak zwykle można skorzystać z właściwości ScanLine i zaktualizować dane obrazu bezpośrednio modyfikując dane w bloku pamięci, w którym zapisane są wartości kanałów.

Pocukrujmy trochę składnię, implementując ten algorytm w postaci metody helpera dla klasy obrazu:

type
  TPortableNetworkGraphicHelper = class helper for Graphics.TPortableNetworkGraphic
  public
    procedure PremultiplyChannels();
  end;

{..}

procedure TPortableNetworkGraphicHelper.PremultiplyChannels();
type
  PPNGLine = ^TPNGLine;
  TPNGLine = packed array [UInt16] of packed record B, G, R, A: UInt8; end;
var
  Line: PPNGLine;
  LineIndex, PixelIndex: Integer;
begin
  BeginUpdate();
  try
    for LineIndex := 0 to Height - 1 do
    begin
      Line := ScanLine[LineIndex];

      for PixelIndex := 0 to Width - 1 do
        with Line^[PixelIndex] do
          if (A > 0) and (A < 255) then
          begin
            R := R * (A + 1) shr 8;
            G := G * (A + 1) shr 8;
            B := B * (A + 1) shr 8;
          end;
    end;
  finally
    EndUpdate();
  end;
end;

Samą aktualizację wartości składowych przeprowadza się tylko na półprzezroczystych pikselach. Tych całkowicie przezroczystych i całkowicie nieprzezroczystych ruszać nie trzeba. Metodę tę najlepiej jest wywołać tuż po załadowaniu obrazu do pamięci, aby mieć pewność, że faktycznie jest wywoływana:

procedure TSplashForm.InitLogo();
begin
  FLogo := TPortableNetworkGraphic.Create();
  FLogo.LoadFromFile('logo.png');
  FLogo.PremultiplyChannels();
end;

Po tych wszystkich poprawkach okno nareszcie wygląda tak jak powinno – nie ma żadnych glitchy:

4.png


6. Końcowy kod

Pełny kod modułu wrzucam na Pastebin. Dodałem do niego obsługę lewego przycisku myszy, tak aby można było złapać okno i je przesuwać po ekranie, co było bardzo przydatne podczas szukania najlepszego rozwiązania.

Zaletą tego rozwiązania jest fakt, iż nawet jeśli ładowanie danych nie będzie synchronizowane, system i tak zadba o odmalowywanie okna. Czyli ogólnie pisząc, jeśli splash będzie zamrożony, to przesunięcie nad nim innego okna nie spowoduje zglitchowania jego zawartości.


Podsumowanie

Po długim a ciężkim, wizytówka wygląda super. Użyte rozwiązanie sprawuje się świetnie, przy relatywnie niedużej liczbie linijek kodu do napisania. Co prawda można zrobić to inaczej, np. obsługując komunikat WM_ERASEBKGND, jednak sposób ten zmusza do ręcznego pobierania obszaru tła i jest wrażliwy na przemieszczanie okien pod oknem wizytówki. Poza tym komunikat ten nie jest wysyłany przez system podczas przesuwania okna, więc trzebaby taką sytuację wymuszać, co nie jest proste. Oczywiście nie w przypadku wizytówki, bo taka funkcja nie jest jej potrzebna, ale nie tylko do wizytówek wykorzystuje się półprzezroczystość okna.

Teraz każdy z Was może w prosty sposób zrobić w swoim programie wizytówkę wyglądają profesjonalnie. Pamiętam jak dawno temu urzekł mnie splash screen komunikatora AQQ, w postaci właśnie półprzezroczystego logotypu – robił wrażenie. Nie zajmowałem się wtedy programowaniem, więc długo zastanawiałem się jak oni to zrobili. No a teraz już nie muszę. :]

#free-pascal #lazarus

Azarien

@furious programming: czy przyglądałeś się funkcji WinAPI AlphaBlend? bo wydaje mi się że mniej-więcej do tego służy.

furious programming

Tak, ale czytałem pobieżnie i szybko zainteresowałem się innymi. Jednak wybrałem to co wybrałem, dlatego że potrzebowałem szybkiego i sprawdzonego rozwiązania, bo i tak straciłem na to okienko za dużo czasu.

furious programming
2019-07-19 23:53

No to kolejny wpis, bo widzę że bugów i niedoróbek związanych z kontrolką TCheckListBox wyłania się coraz więcej. Im dłużej rozwijam program wykorzystujący te kontrolki, tym coraz to nowsze błędy mnie nękają… :/


W poprzednim wpisie pokazałem co mi wyszło z redefiniowania obsługi komunikatów dotyczących lewego przycisku myszy i ogólnie z łatania bugów i bubli w kodzie tego komponentu. Ucieszyłem się, że w końcu kontrolka zachowuje się przyzwoicie i przedstawia dane w odpowiedni sposób. Ale żeby nie było zbyt dobrze, niedługo po napisaniu tego wpisu zauważyłem, że w niektórych przypadkach komponent zachowuje się inaczej niż przed moimi modyfikacjami.

Ogólnie rzecz ujmując, subclassingiem nadpisałem całą obsługę pojedynczego wciśnięcia lewego przycisku myszy, czyli obsługę komunikatu LM_LBUTTONDOWN. Jak się okazało, przez ten zabieg kilka standardowych funkcji lewego przycisku przestało działać. Np. w zdarzeniu OnMouseDown komponentu miałem kod, który w momencie wciśnięcia przycisku myszy sprawdzał koordynaty kursora i jeśli pod kursorem nie było żadnego itema, ustawiał bieżący indeks na -1, co owocowało odznaczeniem wszystkich zaznaczonych pozycji (jeśli takowe istniały).

No i po moich poprawkach kod tego zdarzenia przestał działać – nagle metoda ItemAtIndex zaczęła zawsze zwracać wartość inną niż -1, czyli mój kod w rezultacie przestał spełniać swoje założenie. Klikając w puste miejsce komponentu, automatycznie zaznaczana jest ostatnia pozycja. Nie będę tego poprawiać – trudno, niech komponent działa tak jak standardowy.


Podpiąłem więc logikę do kontrolek i przetestowałem wszystkie funkcje – dodawanie danych, edycję, usuwanie zaznaczonych, blokowanie edycji i usuwania pozycji zablokowanych. Wszystko było w najlepszym porządku. Oczywiście do czasu – dziś sprawdziłem jak kontrolka się zachowa na większej liczbie danych. No i dostałem w twarz czymś takim:

0.png

Dlaczego tekst znów wyłazi poza obszar dla niego przeznaczony?!

Dodanie pozycji do listy wymusza automatyczne obliczenie jej rozmiaru, czyli pośrednio wołane jest zdarzenie OnMeasureItem, w którym wykonywany jest mój kod przeprowadzający obliczenia wysokości dla itema, na bazie danych które ma wyświetlać (pochodzą z zewnętrznej, generycznej listy obiektów). To tak w dużym skrócie.

W momencie wypełniania komponentu danymi, ten nie wie, że wszystkie pozycje nie zmieszczą się w jego obszarze, a więc nie wie, że jak trzeba będzie wyświetlić pionowy scrollbar, to szerokość itemów będzie mniejsza. Widać nie wie tego, bo podczas dodawania danych, jego funkcja ItemRect zwraca obszar itema bez uwzględnienia szerokości scrollbara. Mój kod liczy wysokość na pełnym obszarze, komponent wyświetlany jest na ekranie, przeliczana jest łączna wysokość itemów i dodawany jest pionowy scrollbar. Ponowna rekalkulacja wysokości itemów po wyświetleniu scrollbara nie jest wykonywana, więc wszystkie itemy są zgliczowane.

Zacząłem więc kombinować i za pomocą funkcji z WinAPI sprawdzać czy w momencie wykonywania mojego kodu obliczającego wysokość itema scrollbar jest widoczny – GetWindowLong się kłania. Okazuje się, że jest widoczny. Idę dalej, skoro jest widoczny, to pobieram jego szerokość funkcją GetSystemMetrix i zmniejszam offset prawej krawędzi obszaru itema – to powinno załatwić sprawę. No i załatwiło:

1.png

Jeszcze większa kupa niż wcześniej… Teraz item jest zbyt wąski, a tekst wyłazi jeszcze bardziej poza jego obszar…


Na całe szczęście można ten problem rozwiązać wykorzystując to co mam, czyli subclassing i metodę Changed, która woła metodę wymuszającą rekalkulację wysokości itemów. W poprzednim wpisie ten kod znajdował się jeszcze w metodzie ChangeBounds, ale sobie go wydzieliłem do osobnej metody i zrobiłem ją publiczną, bo używam jej obecnie w kilku miejscach. Ale nie można tej metody wywołać w konstruktorze formularza, bo niczego to nie zmieni. Trzeba to zrobić później – wybrałem zdarzenie OnShow, nareszcie wszystko gra:

2.png


Niestety aby komponenty TCheckListBox (z moimi poprawkami rzecz jasna) zachowywały się prawidłowo przez cały czas życia aplikacji, za każdym razem gdy zmienia się wyświetlane w nich dane, trzeba dodatkowo wywołać tę cholerną metodę Changed, bo inaczej itemy zaczną się glitchować. Podejrzewam, że w dalszych testach wylezą następne problemy z tymi komponentami. Im więcej tym lepiej – będzie o czym pisać.

#free-pascal #lazarus #lazabug

Silv

Ech, i nici z mojego szukania bugów.

furious programming

Miałbyś szansę co nieco znaleźć, bo aplikacja jest pisana w pośpiechu – bez projektowania. Może nie bugi, ale niezabezpieczone kawałki kodu, wykonujące jakieś egzotyczne operacje czy te wykonywane w awaryjnych sytuacjach.

Jeśli użytkownik nie będzie majstrował ręcznie przy plikach to się nic nie wysypie, bo wszystkie operacje do których daje użytkownikowi interfejs są odpowiednio zabezpieczone i nawet jeśliby bardzo chciał, to klikaniem niczego nie zepsuje.

furious programming
2019-07-18 17:22

Wczoraj pisałem o walce z poprawną obsługą dynamicznie mierzonych itemów w komponentcie TCheckListBox oraz z naprawieniem kodu odpowiedzialnego za obsługę lewego kliknięcia myszą w obrębie itema, w celu zmiany stanu checkboxa. Dzisiejsze testy ostatecznie potwierdziły poprawność działania moich łatek, a przy okazji sprawdziłem też czy mój kod odpowiedzialny za renderowanie itemów działa prawidłowo – działa elegancko.

Pomyślałem więc, że zamiast dodawać kolejne zrzuty do tamtego wpisu, który i tak już jest dość krowiasty, wzamian napiszę nowy. Ale nie tylko po to, aby pokazać co mi z tego wyszło – jest jeszcze jedna rzecz, która psuła interfejs mojego programu. Ale tym razem nie z winy błędów w LCL, a w związku ze specyfiką działania komponentów z rodziny ListBox.

Tak więc końcowy efekt przedstawia się następująco, na trzech głównych systemach Windows:

0.png

Kilka pierwszych itemów jest zablokowanych, co oznacza, że checkbox w nich nie może zmieniać zaznaczenia – nie da się tego zrobić ani za pomocą myszy, ani klawiatury. Samo blokowanie robi się za pomocą właściwości ItemEnabled. Założenie jest takie, że x wbudowanych pozycji nie może być usuniętych, a mechanizm usuwania itemów bazuje właśnie na stanie checkboxów.


Itemy w komponencie zachowują się poprawnie, zawartość itemów renderowana jest prawidłowo, zaznaczanie i odznaczanie checkboxów za pomocą myszy działa perfekcyjnie (co do piksela). Ale jest jeden haczyk – podczas rozciągania komponentu, system nie wysyła do niego komunikatów nakazujących przekalkulowanie wysokości itemów, gdy użyty jest styl lbOwnerDrawVariable. To powoduje, że rozciągnięty komponent posiada itemy o wysokość ustalonej podczas dodawania pozycji i albo tekst wyjeżdża pod obszar dla tekstu (gdy kontrolka została ”skurczona” w poziomie), albo pozostają brzydkie, puste pola (gdy została rozciągnięta w poziomie):

1.png

Aby rozwiązać ten problem, należy zmusić komponent do rekalkulacji wysokości itemów w trakcie rozciągania komponentu. I tutaj z pomocą przychodzi metoda ChangeBounds, która jest wywoływana za każdym razem, gdy rozmiar lub położenie kontrolki zmieni się choćby o piksel. Przykładowo, płynne rozciągnięcie komponentu np. o 20px w poziomie oznacza wywołanie tej metody dwadzieścia razy. Pozwala to wykonywać dany kod na bieżąco podczas modyfikacji obszaru komponentu – i tego właśnie potrzebujemy.

Wczoraj zmuszony zostałem do subclassowania TCheckListBox, aby połatać buble w jego kodzie, więc skorzystamy z tej klasy do nadpisania metody ChangeBounds i zdefiniowania kodu forsującego rekalkulację wysokości pozycji. Wiele kodu pisać nie trzeba:

type
  TCheckListBox = class(CheckLst.TCheckListBox)
  protected
    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: Integer; AKeepBase: Boolean); override;
  end;

{..}

procedure TCheckListBox.ChangeBounds(ALeft, ATop, AWidth, AHeight: Integer; AKeepBase: Boolean);
var
  ControlItemIndex: Integer;
  ControlItemHeight: Integer;
begin
  inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, AKeepBase);

  if Style = lbOwnerDrawVariable then
    for ControlItemIndex := 0 to Items.Count - 1 do
    begin
      MeasureItem(ControlItemIndex, ControlItemHeight);
      Windows.SendMessage(Handle, LB_SETITEMHEIGHT, ControlItemIndex, ControlItemHeight);
    end;
end;

Najpierw wołamy bazową metodę za pomocą inherited, która wykona aktualizację położenia i rozmiaru komponentu. Następnie sprawdzamy czy komponent posiada ustawiony styl lbOwnerDrawVariable i jeśli tak, w pętli wykonujemy obliczenia. Klasa TCheckListBox posiada publiczną metodę MeasureItem, która pośrednio wywołuje zdarzenie OnMeasureItem, czyli wykonuje nasz kod przeprowadzający obliczenia. Po pobraniu nowej wysokości wysyłany jest komunikat do komponentu, w którym dostarczamy indeks pozycji oraz nową jego wysokość.

To wszystko – od tej pory komponent automatycznie dba o to, aby pozycje posiadały poprawnie dopasowaną wysokość do swojej zawartości:

2.png


Pozostaje jeszcze zabezpieczyć jedną rzecz. Zawartość wszystkich itemów komponentu może być modyfikowana. W przypadku tych zablokowanych, zmienić można niektóre dane (w tym tytuł i treść itema), ale pozycje te nie mogą być usunięte.

Aby komponent dopasował rozmiar pozycji po aktualizacji danych, wystarczy wywołać metodę ChangeBounds, podając w parametrach bieżącą pozycję i rozmiar komponentu. W ten sposób wymusi się rekalkulację wysokości itemów, bez zmiany obszaru zajmowanego przez komponent. Można też napisać sobie dedykowaną metodę do tego celu, tak aby utrzymać czytelność kodu.

Oczywiście należy też pamiętać, że modyfikacja treści wyświetlanej przez pozycje też musi wymuszać ponowne obliczenie obszaru itemów i dodatkowo jeszcze przemalowanie komponentu. W przeciwnym razie znów będziemy mieli do czynienia z pustymi przestrzeniami lub tekstem nie mieszczącym się w obrębie obszaru itema, a brak odmalowania kontrolki będzie powodował zglitchowanie interfejsu.

#free-pascal #lazarus

winuser

Widze kogos tu zablolalo, klasyczne spiecie goscia ktory potrafi tylko klepac w pascalu (lol). Sam o tym wspominales, ze pracujesz nad nieduzym narzedziem z niewielka iloscia danych raptem kilkadziesiat rekordow. Cos poszlo nie tak w Twojej sieci neuronowej i zapomniales?

furious programming

Może dla ciebie program na 10k linijek jest duży – dla mnie nie. I może dla ciebie liczba rekordów w bazie jest wyznacznikiem wachlarzu funkcjonalności i rozmiaru kodu źródłowego programu – dla mnie nie. Coś poszło nie tak w twojej sieci neuronowej i nie pomyślałeś? Pytanie retoryczne – idź trollować gdzieś indziej.

furious programming
2019-07-17 21:55

Ostatnio pisałem o trzech problemach i bugach związanych z biblioteką komponentów i ogólnie Lazarusem, i niestety czas na kolejny. Jak tak dalej pójdzie to wpisów poruszających takie tematy będzie dużo, więc korzystając z okazji wszystkie będę tagował na wzór wpisów kolegi @several (dotyczących środowiska Visual Studio), tak aby łatwo było je wyfiltrować. Wybrałem sobie tag #lazabug – był wolny i dobrze oddaje istotę sprawy.

No, to czas na właściwą treść – miłej lektury.


Dzisiejszy wpis dotyczyć będzie komponentu klasy TCheckListBox i można go traktować jako kontynuację poprzedniego wpisu na temat ręcznego renderowania zawartości itemów. Nowy problem też dotyczy checkboxów, ale nie ich renderowania – tym razem chodzi o obsługę myszy.

Komponent TCheckListBox to zwykły TListBox – posiada proste itemy w postaci prostokątów z tekstem, ale dodatkowo ma redefiniowany kod odpowiedzialny za renderowanie itemów oraz wyposażony jest w dodatkowe dane. Dane te służą do przechowywania stanu checkboxów (dalej będę je nazywał przyciskami, dla ułatwienia), a metody pozwalają manipulować nimi. Tak więc nie ma żadnych fizycznych kontrolek osadzonych w itemach – to tylko wizualny efekt. Można to poznać po tym, że przyciski te nie reagują na kursor (nie podświetlają się).

Wiemy już, że przycisków tam nie ma. Aby możliwe było ich zaznaczanie myszą, przyjęło się, że cała lewa strona itemu (obszar obok ramki tła zaznaczenia) do tego służy. Cały ten obszar, nie tylko ten na którym maluje się przycisk. Przy wysokich itemach (np. jeśli wysokość każdego z nich ustalamy samemu w zdarzeniu OnMeasureItem) może to być pomocne, bo można kliknąć byle gdzie i przycisk zmieni stan. Może być, bo równie dobrze taka obsługa myszy może mylić użytkownika – w końcu skoro nie klikamy w checkbox, to nie powinien zmieniać stanu. Dla mnie jest to mylące.

Teraz kluczowa sprawa. Kilka komponentów typu TCheckListBox wykorzystuję do przedstawiania różnych danych, z reguły dłuższego tekstu lub wieloliniowych tekstowych wartości, odpowiednio sformatowanych. Te z bardziej skomplikwaną zawartością posiadają ustawiony styl lbOwnerDrawVariable i ustalam itemom wysokość na podstawie zawartości. To pozwala stworzyć wygodny interfejs, dobrze przedstawiający dane użytkownikowi.


WTF na dzień dobry – komponent klasy TCheckListBox nie posiada zdarzenia OnMeasureItem w sekcji published, więc nie da się go wygenerować z poziomu inspektora obiektów, a więc informacje na temat tego zdarzenia nie są przechowywane w pliku formularza (czyli w pliku .lfm). Ktoś widać zapomniał go podbić z sekcji public przy pisaniu kodu końcowej klasy komponentu. :/

Skoro nie można tego zdarzenia wygenerować, trzeba napisać sobie metodę samemu i ją ręcznie podpiąć gdzieś w konstruktorze formularza. Paskudne rozwiązanie, tym bardziej że tych metod musiałbym pisać wiele, co mi zrobi bajzel w kodzie. Wolałem więc dodać brakującą właściwość w kodzie LCL, skompilować tę bibliotekę i przebudować środowisko. No i mam zdarzenie, oczywiście do czasu aktualizacji IDE, bo wtedy moje poprawki zostaną nadpisane i nie będzie się dało skompilować projektu. Ale to tylko chwilowe – byle bym mógł wypuścić release programu, potem się coś pomyśli. Albo odbiorę sobie życie – zastanowię się jeszcze.


Siadam więc do pisania kodu mojego zdarzenia OnMeasureItem, bo czas na renderowanie zawartości itemów. WTF numer dwa – pomimo wybrania stylu lbOwnerDrawVariable i wygenerowania zdarzeń, OnMeasureItem wywoływane jest tylko raz i tylko dla pierwszego itema, przez co wszystkie pozycje mają taką wysokość, jaka zostanie obliczona dla pierwszej pozycji listy. Krew się gotuje…

Zwęszyłem problem – flagi dotyczące stylu itemów są hardkodowane w metodzie CreateParams komponentu, i oczywiście wykorzystywana jest flaga LBS_OWNERDRAWFIXED, która oznacza jednakowy rozmiar wszystkich pozycji:

procedure TCustomCheckListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := (Params.Style and not LBS_OWNERDRAWVARIABLE) or LBS_OWNERDRAWFIXED;
end;

Rozwiązać to można poprzez subclassing, nadpisanie tej metody i redefiniowanie zestawu flag:

type
  TCheckListBox = class(CheckLst.TCheckListBox)
  protected
    procedure CreateParams(var AParams: TCreateParams); override;
  end;

{..}

procedure TCheckListBox.CreateParams(var AParams: TCreateParams);
begin
  inherited CreateParams(AParams);

  if Style = lbOwnerDrawVariable then
    AParams.Style := (AParams.Style and not LBS_OWNERDRAWFIXED) or LBS_OWNERDRAWVARIABLE;
end;

Całe szczęście, że w momencie wywołania tej metody, właściwość Style komponentu jest już ustawiona na wartość wczytaną z zasobów, czyli w prostych słowach na tę zdefiniowaną w oknie inspektora obiektów. Działa – teraz kontrolka pozwala na ustalanie różnych wysokości itemów:

0.png

To co widać na zrzucie to efekt działania własnych metod renderujących zawartość. Póki co malowane jest tło pozycji (białe), przycisk (zawsze w lewym górnym rogu itema) oraz tło dla tekstu (białe lub w kolorze, według stanu zaznaczenia).

Już po problemie? Gdzie tam, zabawa dopiero się zaczyna…


Ucieszyłem się poprawną wysokością itemów, obliczaną w zdarzeniu OnMeasureItem, ale szybko się okazało, że jest kolejny błąd w kodzie tego komponentu. Jak wcześniej wspomniałem, obszar umożliwiający zmianę stanu zaznaczenia checkboxów za pomocą myszy znajduje się po lewej stronie (na zrzucie wyżej jest to obszar po lewej stronie niebieskiej ramki zaznaczenia). Klikając w obrębie obszaru przeznaczonego dla zawartości (głównie tekstu), stan przycisku nie powinien się zmieniać – to logiczne i tak było w VCL dla Delphi 7.

A jak jest w LCL? A no tak, że obszar ten bywa znacznie szerszy niż sam przycisk… Mało tego, im wyższy jest item, tym jest szerszy! W przypadku gdy item jest bardzo wysoki (lub wyższy niż szerszy), większość jego powierzchni przeznaczona jest do zmiany stanu przycisku za pomocą kliknięcia. Sobie wyobraź, że kliknięcie w tekst powoduje nie tylko podświetlenie pozycji, ale też odwrócenie zaznaczenia checkboxa – użytkownik na pewno doceni ten ficzer… fajna łamigłówka… :/

Kod odpowiedzialny za skopane obliczenia znajduje się w czeluściach widgetsetu, dokładniej w module Win32WSCheckLst, w którym to w sekcji implementation znajduje się funkcja CheckListBoxWndProc. Jest to dodatkowy handler komunikatów, rejestrowany podczas tworzenia uchwytu kontrolki. W nim reaguje się na komunikaty dotyczące lewego przycisku myszy (wciśnięcie oraz dwuklik) i odpalana jest lokalna dla tej funkcji procedura CheckListBoxLButtonDown, która waliduje pozycję kursora podczas wciśnięcia przycisku myszy i odwraca zaznaczenie checkboxa, jeśli kursor znajduje się w odpowiednim obszarze. A obszar odpowiedzialny za zmianę zaznaczenia przycisku obliczany jest takim kwiatuszkiem:

if TCheckListbox(WindowInfo^.WinControl).UseRightToLeftAlignment then
  ItemRect.Left := ItemRect.Right - ItemRect.Bottom + ItemRect.Top
else
  ItemRect.Right := ItemRect.Left + ItemRect.Bottom - ItemRect.Top;

Wygląda znajomo? Tak, wynikiem jest kwadrat. Zawsze. A w przypadku kwadratowego itema, obszar checkboxa przykrywa całą pozycję, więc nie da się podświetlić itema nie zmieniając automatycznie stanu jego checkboxa. Na zrzucie niżej zaznaczyłem je czerwonymi ramkami:

1.png

Genialne, w końcu kto by przypuszczał, że wysokość itemów może być inna niż standardowa…

Rozwiązanie jest proste – korzystając z już i tak używanego subclassingu, wystarczy nadpisać kolejną metodę, tym razem WndProc. Ona odpowiedzialna jest za obsługę wszystkich komunikatów komponentu, więc tam można samemu obsłużyć m.in. WM_LBUTTONDOWN, a dla pozostałych wywołać metodę bazową. Więc sobie taką na(d)pisałem – wykorzystałem oryginalny kod, ale użyłem własnych obliczeń obszaru przycisku (szukaj komentarza):

type
  TCheckListBox = class(CheckLst.TCheckListBox)
  protected
    {..}
    procedure WndProc(var AMessage: TLMessage); override;
  end;

{..}

procedure TCheckListBox.WndProc(var AMessage: TLMessage);
var
  WindowInfo: PWin32WindowInfo;
  ControlItemRect: Windows.Rect;
  ControlItemIndex: Integer;
var
  CursorPos: Windows.Point;
begin
  if (AMessage.msg = LM_LBUTTONDOWN) or (AMessage.msg = LM_LBUTTONDBLCLK) then
  begin
    WindowInfo := GetWin32WindowInfo(Handle);

    if WindowInfo^.WinControl <> nil then
    begin
      CursorPos.X := GET_X_LPARAM(AMessage.lParam);
      CursorPos.Y := GET_Y_LPARAM(AMessage.lParam);

      for ControlItemIndex := 0 to Windows.SendMessage(Handle, LB_GETCOUNT, 0, 0) - 1 do
      begin
        Windows.SendMessage(Handle, LB_GETITEMRECT, ControlItemIndex, PtrInt(@ControlItemRect));

        if Controller.UserInterface.ListBox.PointInCheckBoxRect(ControlItemRect, CursorPos) then // ło tu
        begin
          if ControlItemIndex < TCheckListBox(WindowInfo^.WinControl).Items.Count then
            if TCheckListBox(WindowInfo^.WinControl).ItemEnabled[ControlItemIndex] then
            begin
              TCheckListBox(WindowInfo^.WinControl).Toggle(ControlItemIndex);

              AMessage.msg := LM_CHANGED;
              AMessage.wParam := ControlItemIndex;

              DeliverMessage(WindowInfo^.WinControl, AMessage);
            end;

          Exit;
        end;
      end;
    end;
  end
  else
    inherited WndProc(AMessage);
end;

Uradowany kompiluję projekt, odpalam i… szlag mnie trafia – moja obsługa komunikatów jest wykonywana, ale i tak domyślny handler robi swoje (choć w ogóle nie powinien być używany, skoro go nadpisałem). Nie mam pojęcia o co chodzi. Z tego co można wywnioskować po kodzie LCL, procedura obsługi komunikatów sama w sobie jest subclassowana, przez co cuda się dzieją z tymi komunikatami. Nie dałem rady zablokować domyślnych mechanizmów…

Zamiast męczyć się z mechanizmami komponentu i dodatkowo z Windows API, zaremowałem fragment kodu domyślnego handlera, który odpowiedzialny jest za zmianę stanu checkboxów. Po prostu. Skoro nie można normalnie obsługiwać komunikatów, to walić kod widgetsetu.


Od tej pory komponent zachowuje się tak jak powinien. Mało tego, moje modyfikacje powodują, że myszą można zmienić stan zaznaczenia checkboxa tylko jeśli kliknie się w przycisk. Kliknięcie w puste pole wokół checkboxa tylko podświetla pozycję. Takie zachowanie komponentu nie jest zgodne z założeniami, ale za to jest zgodne z tym co widzi użytkownik na ekranie, więc w mojej ocenie jest lepsze, bo intuicyjne.

Gdybym miał na to czas, to dorzuciłbym sobie jeszcze obsługę hovera, tak aby checkboxy ładnie się podświetlały po najechaniu nań kursorem, czyli aby zachowywały się tak samo jak zwykłe checkboxy. Ale nie mam na to czasu – deadline się zbliża wielkimi krokami.

Całe szczęście, że kod biblioteki komponentów jest dostarczony wraz ze środowiskiem i każdy ma pełny dostęp do niego, a tym samym każdy może sobie poprawić czy dodać to co jest mu potrzebne. Albo połatać bugi… Gdybym używał Delphi, tym bardziej wersji CE, to byłbym w czarnej dupie.

#free-pascal #lazarus #lazabug

furious programming

Jutro (po testach) dorzucę zrzuty z konkretną zawartością, zrobione na trzech wersjach Windows.

furious programming

Nowy wpis (ze zrzutami) znajduje się tutaj – Wczoraj pisałem o walce z po.... ;)

furious programming
2019-07-14 02:07

Dziś nowy wpis na temat dostosowywania komponentu do systemowego wyglądu. Pierwszy wpis był na temat kontrolki TCheckListBox i ręcznego malowania itemów, a dziś co nieco na temat TTreeView.


Program operuje na zbiorze grafik, znajdującym się w podkatalogu graphics\grounds\. Oprócz wykorzystywania stałego zbioru ponad dwudziestu obrazów, możliwe jest dodawanie nowych i używanie ich w programie. W takim przypadku grafiki użytkownika muszą się znaleźć w tym podkatalogu, bezpośrednio lub zgrupowane w kolejnych podkatalogach (poziom zagłębienia dowolny). Muszą się znaleźć w tym podkatalogu, dlatego że program jest w wersji portable, stąd katalog użytkownika odpada. Drugie wymaganie jest takie, że biblioteka obrazów musi się składać wyłącznie z obrazów w formacie PNG o rozdzielczości 1280×720 pikseli, czyli zgodnych z rozdzielczością 720p. Kolejne założenia są dość niestandardowe.

Okno do wyboru pliku z dysku zawsze musi się pojawiać w przewidzianym miejscu na ekranie (najlepiej wycentrowane w stosunku do okna wywołującego). Musi i koniec. Dlatego też zmuszony byłem do stworzenia własnego okna dialogowego, dlatego że OpenDialog pojawia się tam gdzie system to uzna za stosowne – czyli raz tu, raz tam. Z tego co mi wiadomo, nie da się w 100% kontrolować jego pozycji, tak samo jak systemowego okna typu MessageBox (którego swoją drogą też zreprodukowałem).

Aby użytkownik mniej więcej orientował się w strukturze plików składających się na bibliotekę obrazów, skorzystamy z komponentu typu TTreeView. I tu jest drugie niestandardowe założenie. Drzewo plików musi zawierać wszystkie pliki PNG zawarte wewnątrz katalogu graphics\grounds\, ale jednocześnie nie pokazywać innych podkatalogów folderu graphics\ i ich zawartości. Dlatego też dwa pierwsze węzły drzewa będą stałe – korzeniem będzie węzeł graphics, a jego dzieckiem grounds. Wszystkie nazwy plików muszą więc być zawarte wewnątrz węzła grounds, bezpośrednio lub pośrednio.


Do wypełnienia komponentu danymi, czyli stworzenia drzewa zawartości ww. katalogu, wystarczy kilka prostych metod, w tym jedna rekurencyjna. Ale od początku – najpiew metoda tworząca ścieżkę węzłów:

function TGroundsListDialog.AddGroundNodes(const APath: String): TTreeNode;
var
  NodeNames: TStringList;
  NodeName: String;
  NodePath: String = '';
begin
  Result := nil;

  NodeNames := TStringList.Create();
  try
    if ExtractStrings(AllowDirectorySeparators, [' '], PChar(APath), NodeNames) > 0 then
      for NodeName in NodeNames do
      begin
        Result := AddGroundNode(Result, NodePath, NodeName, True);
        NodePath += NodeName + '\';
      end;
  finally
    NodeNames.Free();
  end;
end;

Nic trudnego. Podział łańcucha ścieżki według separatora, następnie iteracyjne stworzenie węzłów i nadpisywanie referencji bieżącego. Teraz metoda odpowiedzialna za stworzenie węzła, wypełnienie danymi wejściowymi i dodanie go do drzewa:

function TGroundsListDialog.AddGroundNode(AParentNode: TTreeNode; const APath, AName: String; AIsFolder: Boolean): TTreeNode;
begin
  if AParentNode = nil then
    Result := FForm.CGroundsTreeView.Items.AddFirst(nil, AName)
  else
    Result := FForm.CGroundsTreeView.Items.AddChild(AParentNode, AName);

  {..}
end;

Nie wszystkie parametry są użyte, ale napiszę o tym później. Teraz metoda rekurencyjna, przeszukująca zawartość dysku:

procedure TGroundsListDialog.ListGroundPictures(AParentNode: TTreeNode; const APath: String);
var
  FoundItem: TSearchRec;
  FolderNode: TTreeNode;
begin
  if FindFirst(APath + '*', faAnyFile, FoundItem) = 0 then
  try
    repeat
      if (FoundItem.Name = '.') or (FoundItem.Name = '..') then Continue;

      if FoundItem.Attr and faDirectory = faDirectory then
      begin
        FolderNode := AddGroundNode(AParentNode, APath, FoundItem.Name, True);
        ListGroundPictures(FolderNode, APath + FoundItem.Name + '\');
      end
      else
        if LowerCase(ExtractFileExt(FoundItem.Name)) = '.png' then
          AddGroundNode(AParentNode, APath, FoundItem.Name, False);
    until FindNext(FoundItem) <> 0;
  finally
    FindClose(FoundItem);
  end;
end;

Też nic skomplikowanego. Dla każdego znalezionego obiektu w danej lokalizacji sprawdzane jest czy znaleziono katalog i jeśli tak, dodawany jest do drzewa węzeł i następuje rekurencyjne jego uzupełnienie. A jeśli znaleziono plik to waliduje się rozszerzenie i jeśli jest to plik odpowiedniego formatu, zostaje dodany do bieżącego węzła. Ostatnia metoda posłuży do wygenerowania kompletnego drzewa, używając tych powyższych:

procedure TGroundsListDialog.FillControls();
var
  GroundNode: TTreeNode = nil;
begin
  FForm.CGroundsTreeView.Items.BeginUpdate();
  try
    GroundNode := AddGroundNodes('graphics\grounds\');
    ListGroundPictures(GroundNode, 'graphics\grounds\');
  finally
    FForm.CGroundsTreeView.Items.EndUpdate();
    FForm.CGroundsTreeView.FullExpand();
  end;
end;

I gotowe – teraz można się cieszyć wspaniałym drzewkiem reprezentującym strukturę biblioteki obrazów:

0.png

No dobra, o ile zawartość drzewa jest poprawna, to wygląda prymitywnie, więc trzeba dodać ikonki. Ale nie byle jakie ikonki – pozyskamy je z systemu. Aby to wykonać, możemy skorzystać z systemowej funkcji SHGetFileInfo, która służy do pobierania różnych danych na temat pliku, nie tylko ikonki. Rozwińmy więc kod metody AddGroundNode o pobieranie tych danych:

function TGroundsListDialog.AddGroundNode(AParentNode: TTreeNode; const APath, AName: String; AIsFolder: Boolean): TTreeNode;
var
  FilePath: WideString;
  FileInfo: SHFileInfoW;
  FileIcon: TIcon;
begin
  {..}

  Result.ImageIndex := Ord(not AIsFolder);
  Result.SelectedIndex := Result.ImageIndex;
  Result.StateIndex := Result.ImageIndex;

  if AIsFolder and (FForm.CGroundsListImageList.Count > 0) then Exit;
  if not AIsFolder and (FForm.CGroundsListImageList.Count > 1) then Exit;

  FilePath := UTF8ToUTF16(APath + AName);
  SHGetFileInfoW(PWideChar(FilePath), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON or SHGFI_SMALLICON);

  FileIcon := TIcon.Create();
  try
    FileIcon.Handle := FileInfo.hIcon;
    FForm.CGroundsListImageList.AddIcon(FileIcon);
  finally
    FileIcon.Free();
  end;
end;

Te dwa dziwne warunki z Exitami służą do tego, aby do ImageList nie były dodawane duplikaty. Sama lista nie posiada metod sprawdzających czy obraz już w niej się znajduje (zapewne ze względu na jej wewnętrzny postprocessing związany ze skalowaniem itp.), więc te instrukcje warunkowe służą do pomijania pobierania ikon z systemu, jeśli wcześniej dana ikonka została już pobrana.

No i gotowe, możemy się cieszyć systemowymi ikonkami:

1.png

O ile kogokolwiek cieszą takie z paskudnym, czarnym tłem, którego być nie powinno… :/

Problem leży gdzieś w systemie i można to naprawić używając systemowej funkcji ImageList_ReplaceIcon, wywołując ją zaraz po dodaniu ikony do listy. Tyle że ona w pierwszym parametrze przyjmuje uchwyt ImageList, którego klasa listy nie publikuje w postaci właściwości… Obejściem tego problemu jest namalowanie ikonki na bitmapie i dodanie bitmapy do ImageList – przezroczystość nie zostanie utracona:

function TGroundsListDialog.AddGroundNode(AParentNode: TTreeNode; const APath, AName: String; AIsFolder: Boolean): TTreeNode;
var
  FileBitmap: TBitmap;
begin
  {..}

  FileIcon := TIcon.Create();
  FileBitmap := TBitmap.Create();
  try
    FileIcon.Handle := FileInfo.hIcon;

    FileBitmap.SetSize(FileIcon.Width, FileIcon.Height);
    FileBitmap.Canvas.Brush.Style := bsSolid;
    FileBitmap.Canvas.Brush.Color := FForm.CGroundsListImageList.BkColor;
    FileBitmap.Canvas.FillRect(0, 0, FileBitmap.Width, FileBitmap.Height);
    FileBitmap.Canvas.Draw(0, 0, FileIcon);

    FForm.CGroundsListImageList.Add(FileBitmap, nil);
  finally
    FileIcon.Free();
    FileBitmap.Free();
  end;
end;

Teraz ikonki wyglądają prawidłowo, zachowując oryginalną przezroczystość:

2.png


Niestety Lazarus nie posiada komponentu drzewa plików/katalogów, który by wyglądał jak systemowy i obsługiwał systemowe menu kontekstowe, dlatego trzeba było zrobić swoją kontrolkę i napisać trochę kodu. Szkoda, bo takie Delphi 7 miało ich masę, każda nie tylko przedstawiała nazwy plików czy lokalizacji, ale też sama dbała o pobieranie ikon z systemu. Czasem tęsknię za starym dobrym VCL.

#free-pascal #lazarus #lazabug

Silv

Tzn. w dokumentacji. :P

Silv

Wygląda na to, że za kompozycję uważa się zarówno kompozycję kolorów, jak i stylów okien... Trochę mało przejrzysty taki podział (tzn. jego brak).

furious programming
2019-07-09 23:24

Chwilowo pracuję nad aplikacją okienkową dla systemów Windows, której interfejs zbudowany jest ze standardowych komponentów, wyglądających tak jak reszta systemu. Ale posiada ona kilka komponentów klasy TCheckListBox, służących do przedstawiania pewnych informacji. Listy te mają być docelowo wyższe niż standardowe i zawierać tekst formatowany – co nieco pogrubione, co nieco wieloliniowe, niektóre z bitmapami. Aby to wykonać, wystarczy zmienić styl komponentu np. na lbOwnerDrawFixed i obsużyć zdarzenie OnDrawItem. Niby nic trudnego, jednak zmiana stylu komponentu powoduje, że checkboxy przestają być malowane:

before.png

Z jednej strony trochę mnie to zdziwiło – kiedyś coś podobnego robiłem w Delphi 7 (zrzuty powinny być gdzieś w starym wątku na forum) i tam checkboxy były i tak malowane przez wewnętrzne mechanizmy, a tylko tekst i tło pod nim trzeba było namalować samemu (przekazywany w parametrze obszar itemka nie uwzględniał checkboxa). Z drugiej strony, nawet to logiczne – w końcu skoro sami mamy malować pozycje to w całości, a nie tylko tekst.

Tylko jak tu namalować checkboxa, tak aby wyglądał tak jak systemowy i skąd wziąć jego rozmiary… hmm… ;)


Rozwiązanie nie jest skomplikowane – trzeba skorzystać z magicznego obiektu ThemeServices, który komunikuje się z systemem, pozwala na pobranie ”detali” systemowych kontrolek oraz na ich renderowanie. Zakładając że cały kod renderujący znajduje się w zdarzeniu OnDrawItem, najpierw trzeba wypełnić item kolorem tła komponentu – nic nadzwyczajnego:

var
  ListBox: TCheckListBox absolute AControl;

{..}

ListBox.Canvas.Brush.Color := Windows.GetSysColor(COLOR_WINDOW);
ListBox.Canvas.FillRect(ARect);

Następnie należy pobrać detale checkboxa za pomocą metod obiektu ThemeServices, następnie pobrać jego wymiary i wyznaczyć dla niego obszar, w którym będzie renderowany i go namalować. Tutaj jest nieco więcej roboty, ale też nic skomplikowanego:

const
  CHECKBOX_STATE: array [TCheckBoxState, Boolean] of TThemedButton = (
    (tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedNormal),
    (tbCheckBoxCheckedDisabled, tbCheckBoxCheckedNormal),
    (tbCheckBoxMixedDisabled, tbCheckBoxMixedNormal)
  );
var
  CheckBoxDetails: TThemedElementDetails;
  CheckBoxSize: TSize;
  CheckBoxEnabled: Boolean;
var
  CheckBoxRect: TRect;

{..}

CheckBoxEnabled := ListBox.Enabled and ListBox.ItemEnabled[AIndex];
CheckBoxDetails := ThemeServices.GetElementDetails(CHECKBOX_STATE[ListBox.State[AIndex], CheckBoxEnabled]);

CheckBoxSize := ThemeServices.GetDetailSize(CheckBoxDetails);
CheckBoxRect := Bounds(ARect.Left + 4, ARect.Top + (ARect.Height - CheckBoxSize.Height) div 2, CheckBoxSize.Width, CheckBoxSize.Height);

ThemeServices.DrawElement(ListBox.Canvas.Handle, CheckBoxDetails, CheckBoxRect);

Następnie należy wyznaczyć obszar dla tekstu, który nie będzie zawierał obszaru zajmowanego przez checkbox (plus dodatkowy odstęp):

var
  TextRect: TRect;

{..}

TextRect := ARect;
TextRect.Left := CheckBoxRect.Right + 4;

Skoro już wiadomo gdzie znajdować się będzie tekst, należy sprawdzić czy item jest podświetlony i jeśli tak, namalować tło w odpowiednim kolorze:

if odSelected in AState then
begin
  ListBox.Canvas.Brush.Color := Windows.GetSysColor(COLOR_HIGHLIGHT);
  ListBox.Canvas.FillRect(TextRect);
end;

Teraz czas na tekst. Ten przykład dotyczy prostego tekstu, jednoliniowego, wyśrodkowanego w pionie. Do tego celu trzeba pobrać właściwości tekstu i ustawić wyrównanie wertykalne. Kolorów i stylu fontu nie trzeba samemu ustawiać – tym zajmują się wewnętrzne mechanizmy komponentu, wystarczy go po prostu namalować w zadanym obszarze:

var
  TextStyle: TTextStyle;

{..}

TextStyle := ListBox.Canvas.TextStyle;
TextStyle.Layout := tlCenter;

ListBox.Canvas.Brush.Style := bsClear;
ListBox.Canvas.TextRect(TextRect, TextRect.Left + 4, TextRect.Top, ListBox.Items[AIndex], TextStyle);

I to wszystko. No prawie, bo jest jeszcze jedna rzecz – ramka fokusa…

System renderuje itemki w taki sposób, aby ta ramka obejmowała tylko obszar tekstu. Zmiana stylu komponentu i ręczne renderowanie itemków powoduje, że ramka obejmuje cały obszar pozycji, od lewej do prawej. Dziwne jest to, że pomimo własnego zdarzenia malowania pozycji, ramka fokusa i tak jest malowana (kolejna różnica w stosunku do VCL z Delphi 7). Dlatego trzeba się pozbyć tej rysowanej niezależnie od nas. Łatwo to zrobić – ramka ta renderowana jest metodą DrawFocusRect, a ona sama jest zwykłym xorem kolorów pikseli pod nią. Sam xor jest z natury przemienny, więc aby usunąć ramkę, wystarczy ją… namalować drugi raz. ;)

Tak więc aby namalować ramkę fokusa w odpowiednim miejscu, najpierw zamowywujemy tę domyślną, a następnie renderujemy własną, tylko w obszarze zajmowanym przez tekst (ten sam obszar co dla kolorowego tła, gdy item jest zaznaczony):

if odFocused in AState then
begin
  ListBox.Canvas.DrawFocusRect(ARect);
  ListBox.Canvas.DrawFocusRect(TextRect);
end;

I to wszystko – teraz mamy wygląd teł i checkboxów zgodny z bieżącym schematem systemu, ale własnoręcznie wyrenderowany tekst. Końcowy efekt dla kilku wersji Windowsa poniżej (pierwsza pozycja w moim programie zawsze ma być renderowana fontem pogrubionym):

after.png

Pełny kod zdarzenia renderującego pozycje wrzucam niżej dla zainteresowanych:

procedure TMyForm.CMyListBoxDrawItem(AControl: TWinControl; AIndex: Integer; ARect: TRect; AState: TOwnerDrawState);
const
  CHECKBOX_STATE: array [TCheckBoxState, Boolean] of TThemedButton = (
    (tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedNormal),
    (tbCheckBoxCheckedDisabled, tbCheckBoxCheckedNormal),
    (tbCheckBoxMixedDisabled, tbCheckBoxMixedNormal)
  );
var
  ListBox: TCheckListBox absolute AControl;
var
  CheckBoxDetails: TThemedElementDetails;
  CheckBoxSize: TSize;
  CheckBoxEnabled: Boolean;
var
  CheckBoxRect, TextRect: TRect;
  TextStyle: TTextStyle;
begin
  ListBox.Canvas.Brush.Color := Windows.GetSysColor(COLOR_WINDOW);
  ListBox.Canvas.FillRect(ARect);

  CheckBoxEnabled := ListBox.Enabled and ListBox.ItemEnabled[AIndex];
  CheckBoxDetails := ThemeServices.GetElementDetails(CHECKBOX_STATE[ListBox.State[AIndex], CheckBoxEnabled]);

  CheckBoxSize := ThemeServices.GetDetailSize(CheckBoxDetails);
  CheckBoxRect := Bounds(ARect.Left + 4, ARect.Top + (ARect.Height - CheckBoxSize.Height) div 2, CheckBoxSize.Width, CheckBoxSize.Height);

  ThemeServices.DrawElement(ListBox.Canvas.Handle, CheckBoxDetails, CheckBoxRect);

  TextRect := ARect;
  TextRect.Left := CheckBoxRect.Right + 4;

  if odSelected in AState then
  begin
    ListBox.Canvas.Brush.Color := Windows.GetSysColor(COLOR_HIGHLIGHT);
    ListBox.Canvas.FillRect(TextRect);
  end;

  TextStyle := ListBox.Canvas.TextStyle;
  TextStyle.Layout := tlCenter;

  if AIndex = 0 then
    ListBox.Canvas.Font.Style := [fsBold];

  ListBox.Canvas.Brush.Style := bsClear;
  ListBox.Canvas.TextRect(TextRect, TextRect.Left + 4, TextRect.Top, ListBox.Items[AIndex], TextStyle);

  if odFocused in AState then
  begin
    ListBox.Canvas.DrawFocusRect(ARect);
    ListBox.Canvas.DrawFocusRect(TextRect);
  end;
end;

#free-pascal #lazarus #lazabug

cerrato

Ale odstęp się nie przeskaluje, bo jest na stałe wpisany na 4 :P

furious programming

@cerrato: sprawdź na msdn i pytaj twórców LCL dlaczego używają stałych offsetów.

Mój kod jest jedynie portem metody z widgetsetu. ;)

furious programming
2019-06-19 02:14

Przed chwilą znów Lazarus rzucił wyjątkiem o wszystkomówiącej treści Access Violation.


Tym razem moja ulubiona funkcja tego IDE (czyli randomowe wykrzaczenie) uruchomiła się w designerze, podczas cofania wprowadzonych zmian. Na formularzu miałem poustawiane komponenty, w tym etykietę z tekstem wieloliniowym (kilka paragrafów, wiersze zawijane, dopasowanie rozmiaru do treści). Pospinałem komponenty za pomocą Anchor Editor (świetne narzędzie swoją drogą), tak aby podczas rozciągania okna ”same” się odpowiednio przesuwały (przydatne, jeśli niektóre komponenty zmieniają swój rozmiar). Wszystko było cacy.

Aż tu nagle przez przypadek przesunąłem tę wieloparagrafową etykietę, która zaczęła wariować – włączony AutoSize w połączeniu z ustawionymi kotwicami spowodował, że komponent zaczął zmieniać rozmiar, totalnie wyjeżdżając poza obszar okna. Puściłem więc LPM i zacząłem cofać zmiany z poziomu klawiatury, licząc na to, że rozmiar i położenie komponentu wrócą do poprzednich wartości. Ale nie – designer rzucił wyjątkiem.

I w sumie bardzo dobrze że tak zrobił, bo pół godziny bym przywracał układ komponentów. A że zanim etykieta się rozjechała, projekt miałem zapisany, więc wystarczyło kliknąć przycisk Abort w oknie z informacją o wyjątku i IDE zostało ubite, następnie otworzyć je ponownie, załadować projekt i gotowe – układ kontrolek przywrócony, więc wyjątek w końcu się do czegoś przydał.


Dlaczego o tym piszę? Bo komponent TLabel to jakaś parodia… Jakiś geniusz wpadł na pomysł, aby dać możliwość tworzenia etykiet jednoliniowych i wieloliniowych (z zawijaniem wierszy lub nie), ale do dostosowywania rozmiaru komponentu dać cholerną jedną właściwość – AutoSize.

Do jasnej cholery! Taki problem jest rozbić ją na dwie – AutoWidth i AutoHeight – tak aby można było wybrać w jaki sposób ma się etykieta zachowywać? Czy lepiej cudować z automatycznymi mechanizmami bazującymi na kotwicach, które w zależności od wymagań mogą być różnie ustawione? A może kompatybilność z Delphi jest ważniejsza? Hmm?!


Już wam napiszę jak to wygląda. Domyślnie AutoSize jest włączony, WordWrap nie. Włączenie WordWrap nic nie daje – wpisując kolejne słowa w Caption, kontrolka rozciąga się w poziomie, cały czas będąc jednoliniową. Aby zmusić ją do zawijania wierszy, należy dodatkowo wyłączyć AutoSize – wtedy wiersze zaczną się zawijać, ale rozmiar nie będzie dostosowywany do zawartości (logiczne). Wpisujemy więc do Caption tekst (np. kilka paragrafów) i akceptujemy. Jak teraz zmusić komponent do tego, aby dopasował swoją wysokość do wieloliniowej zawartości? Logiczne, że trzeba włączyć AutoSize, robimy to i dup – etykieta znów jest jednoliniowa, szlag trafił ustaloną szerokość…

Jak więc tę cholerę dopasować? Nie zgadniecie… Najpierw trzeba wyłączyć AutoSize, ustalić wymaganą szerokość i wpisać swój wieloliniowy tekst, tak aby mieć podgląd na zawartość. Następnie trzeba włączyć obie horyzontalne kotwice i dopiero wtedy włączyć AutoSize – wtedy komponent nie zmieni swojej szerokości, ale dopasuje swoją wysokość – o to od początku chodziło. Teraz możemy dopisywać tekst do Caption i jedynie wysokość będzie się zmieniała.

Dobrze jest? Ta, to teraz zrób w ten sposób etykietę, która podczas rozciągania okna nie będzie zmieniać swojej szerokości. Wyłącz prawą kotwicę to etykieta znów będzie jednoliniowa i szlag trafi wszystko co do tej pory zrobiłeś… Tylko nie cofaj zmian – bo designer może walnąć wyjątkiem… Wyłącz AutoSize, wyłącz prawą kotwicę, ręcznie ustal rozmiar, włącz prawą kotwicę i z powrotem włącz AutoSize.

Masz jeszcze nerwy? To włącz Anchor Editor i spróbuj pospinać kontrolki, tak aby spełniały założenia… :/


Nie mam pojęcia jak, ale ”udało się” wyklikać wszystko. W jednym oknie – teraz morduje drugie… z dziesięciu… :|

#lazarus #wtf #lazabug

Paweł Dmitruk

Myślę, że kompatybilność z Delphi jest ważniejsza - takie odniosłem wrażenie przeglądając forum Lazarusa. Co do labela, to przy Label1.Autosize:=True; ustawiasz maksymalną szerokość kontrolki Label1.Constraints.MaxWidth:=200; i wtedy masz AutoHeight. Oczywiście musi być zaznaczony WordWrap.
Możesz też wpisując tekst do labela sam zawijać tekst dodając znaki końca linii ;-)

furious programming

Z tą kompatybilnością to i tak jest niezła hipokryzja, biorąc pod uwagę to jak bardzo przywiązują do niej wagę, jednocześnie broniąc się przed implementacją wybranych nowości tego języka (jak np. inline'owane deklaracje zmienych). Funkcjonalności implementują wybiórczo, więc nie ma tutaj mowy o jakiejś konkretnej kompatybilności.


Twoja propozycja co do Constraints – no niby tak, tyle że szerokość musiałbym znać już na początku i jej nigdy nie zmieniać. A w trakcie projektowania interfejsu testuję różne warianty, różne układy i rozmiary komponentów i za każdym razem gdy trzeba by poszerzyć etykiety, musiałbym im najpierw usuwać Constraints, aby to było możliwe. A jeśli bym zapomniał z powrotem ustawić tego ograniczenia, to nawet samo przesunięcie etykiety spowoduje zmianę jej rozmiaru, całkowicie ignorując WordWrap.

Co do ręcznego zawijania – nie mogę tak zrobić, bo na różnych systemach są różne fonty i różne ich ustawienia (rozmiary, skalowanie itd.). To powoduje, że u mnie tekst może mieć pięć linii, a na komputerze z innym systemem może być tych linii mniej lub więcej, a one same mogą być krótsze lub dłuższe. Poza tym w trakcie projektowania mogę testować różne kroje fontów i ich style, więc za każdym razem musiałbym poprawiać łamanie linii, co jest bez sensu. Już nie wspominając o wsparciu wielu języków interfejsu.

Dlatego komponent musi sam łamać linie i dopasowywać swoją wysokość, tak aby zawsze wyglądał prawidłowo, wyświetlał swoją pełną zawartość i nie komplikował mi pracy. Natomiast ustawienie kotwic za pomocą Anchor Editor pozwala zrobić stałe odstępy pomiędzy komponentami przy zmiennej ich wysokości, bez dotykania edytora kodu, co jest wygodne. Jedno mi pracę ułatwia, a drugie komplikuje – tak być nie powinno…

furious programming
2019-02-14 17:11

A czy Ty debugujesz swoje programy gamepadem? ;)

Lazarus IDE with Gamepad on Linux

The example below uses the MXK program to map eight buttons from an NES-style gamepad to the key combinations most commonly used during debugging. In addition it has useful mappings for the directional pad, but these are commented out by default since a rogue event source can render a system unusable.

[…]

Linuksiarze są nienormalni…

#free-pascal #lazarus

cerrato

Ciekawe, czemu nie da się tego odpalić na Windowsie...

Azarien

Pad na zdjęciu jest nie od NESa tylko od Super Famicoma, japońskiej wersji SNESa (nie NESa)

furious programming
2019-02-10 03:14

Biorąc pod uwagę odpowiedź kolegi @xxx_xx_x na temat optymalizacji algorytmu renderowania linii skanowania ekranu opisanego przeze mnie na blogu kilka dni temu, skusiłem się na własny komentarz w tej sprawie. Powodem istnienia niniejszego wpisu jest fala niezrozumienia moich słów przez @xxx_xx_x i jego słów przeze mnie (coś nie mogliśmy się dogadać), ale też chęć dokładnego sprawdzenia wszystkich wariantów.

Proszę tego wpisu nie traktować jako ataku personalnego i nie napędzać shit-stormu. ;)


1. Przedmiot testów

W wyniku dyskusji w komentarzach pod moim wpisem łącznie uzbierały się trzy sposoby na obróbkę obrazu źródłowego. Pierwszy to moja propozycja, wykorzystująca iterację piksel po pikselu i modyfikująca składowe za pomocą przesunięcia bitowego. Druga propozycja to iteracja w ten sam sposób, piksel po pikselu, jednak modyfikująca składowe na podstawie predefiniowanej palety wartości. Trzecia propozycja padła z palców @xxx_xx_x i dotyczy iteracji porcjami czterobajtowymi, modyfikując inty za pomocą przesunięcia i alternatywy bitowej.


2. Warunki testu

Aby mieć jakieś dane, posłużę się testową aplikacją konsolową, która sprawdzi efektywność każdej wersji algorytmu. W przypadku sugestii związanej z modyfikacją bitmapy za pomocą czterobajtowych intów, posłużę się wersją bez dopełnienia, co wyjdzie na korzyść @xxx_xx_x. Obrabianą w testach grafiką będzie obraz podany w moim wpisie w punkcie 1., powiększony dwukrotnie (czyli o rozmiarze 1344x768 pikseli) oraz drugi o takim samym rozmiarze, ale składający się z pikseli o losowych kolorach.

Aby mieć pewność co do poprawności działania wszystkich wersji, odpowiednie testy porównujące istnieją w kodzie źródłowym.


3. Który sposób jest szybszy?

Początkowo sprawdziłem działanie wszystkich trzech wersji bezpośrednio w mojej grze i na tej podstawie napisałem jak sprawa wygląda. Z tego też względu w ostatnim komentarzu podałem wyniki w procentach, bo w ten sposób moja gra mierzy zużycie mocy obliczeniowej. Najśmieszniejsze jest to, że te procentowe wyniki dotyczą czasu renderowania klatek w grze, a nie czasu pracy samego filtru renderującego linie skanowania ekranu.

Gra jako aplikacja testowa nie jest zbyt wiarygodna, głównie ze względu na możliwość przekłamania wyników przez inne jej mechanizmy. Mimo wszystko wersja zasugerowana przez @xxx_xx_x wypadła najlepiej, modyfikując bitmapę w najkrótszym czasie.


4. Nieporozumienia i problemy

Pierwszym problemem są poniższe słowa z wpisu.

Spotkała się z krytyką:

  1. Ze względu na brak podzielności bitmapy przez 4 i tym samym brak możliwości użycia kodu w sposób uniwersalny dla każdej bitmapy

Początkowo nie zrozumiałem o co chodzi z tym dopełnieniem, więc uznałem ten sposób za nieuniwersalny. Dopiero później zrozumiałem na jakiej zasadzie ma się odbywać dopełnienie, a tym samym już nie negowałem uniwersalizmu tego rozwiązania.

  1. Rozwiązanie z paletą jest szybsze.

No nie, nie jest. Nie wiem czy te słowa wynikają z niezrozumienia mojego komentarza na ten temat, jednak aby rozwiać wszelkie wątpliwości, napisałem w tym komentarzu od której wersji jest szybsze. A szybsze jest od mojej wersji z przesunięciem bitowym, nie od wersji z intami.

Jednak najważniejszym problemem nie jest wzajemne niezrozumienie, a zgoła inne środowisko testowe. Mój wpis traktuje stricte o algorytmie zaimplementowanym we Free Pascalu, obrabiającym obraz reprezentowany przez obiekt klasy TBitmap. Mój ”oponent” natomiast wykorzystał inny język, inny kompilator i inny, dużo prostszy sposób przechowywania danych obrazu (którego nie da się odzwierciedlić w moim przypadku).

Skoro test przeprowadzany jest w zupełnie innych warunkach, to jego wyniki mogą nie być reprodukowalne.


5. Test w Lazarusie

Żeby wiedzieć jak faktycznie wygląda efektywność poszczególnych rozwiązań, przeprowadziłem własne testy. Aplikacja porównująca napisana jest we Free Pascalu i tak jak w moim wpisie, operuje na obiektach klasy TBitmap. Tester wykorzystuje trzy obiekty bitmap:

  • źródłowy – oryginalna bitmapa, nie podlegająca obróbce,
  • testowy – kopia, podlegająca obróbce za pomocą wszystkich trzech algorytmów,
  • docelowy – kopia, poddana obróbce oryginalnym algorytmem, służąca do walidacji poprawności działania pozostałych rozwiązań.

Aby uzyskać precyzyjne czasy pomiaru, wykorzystałem systemową funkcję QPC i zmierzyłem tylko właściwe pętle, modyfikujące zawartość bitmap. Efektywność wszystkich trzech rozwiązań mierzona jest wielokrotnie. Test przeprowadzony w trybie release, dla wszystkich ustawień optymalizacji. Pełen kod aplikacji testowej znajduje się na Pastebin, a niżej podaję kod samych pętli modyfikujących – dla ogólnego rozeznania.

Oryginalna, używająca przesunięcia bitowego:

for LineIndex := 0 to LinesCount do
begin
  LineTriple := TestFrame.ScanLine[LineIndex];

  for PixelIndex := 0 to PixelsCount do
    with LineTriple^[PixelIndex] do
    begin
      B := B shr 1;
      G := G shr 1;
      R := R shr 1;
    end;
end;

Zaproponowana, używająca predefiniowanej palety wartości:

for LineIndex := 0 to LinesCount do
begin
  LineTriple := TestFrame.ScanLine[LineIndex];

  for PixelIndex := 0 to PixelsCount do
    with LineTriple^[PixelIndex] do
    begin
      B := Palette[B];
      G := Palette[G];
      R := Palette[R];
    end;
end;

Zaproponowana, modyfikująca czterobajtowe bloki:

for LineIndex := 0 to LinesCount do
begin
  LineBlock := TestFrame.ScanLine[LineIndex];

  for PixelIndex := 0 to PixelsCount do
    LineBlock^[PixelIndex] := LineBlock^[PixelIndex] shr UInt32(1) and UInt32($7F7F7F7F);
end;

Rezultaty pomiarów:

typ optymalizacji    brak   -O1    -O2    -O3    -O4

wariant z shiftem    34151  34160  32204  32212  32214
wariant z paletą     33127  33145  33152  33148  33152
wariant z intami     19755  19795  19863  19869  19876

Podsumowanie

Jak widać wersja modyfikująca czterobajtowe bloki jest szybsza, jednak nie trzykrotnie – nawet nie dwukrotnie. Co ciekawe, oryginalne rozwiązanie ładnie poddaje się optymalizacji, wersja z predefiniowaną paletą jest na nią odporna, natomiast efektywność wersji z intami jest w wyniku podnoszenia siły optymalizacji delikatnie obniżana.

Modyfikowanie bloków pamięci jest najlepszym rozwiązaniem – z dopełnieniem czy bez, tutaj znaczącej różnicy nie będzie. Przy czym jeszcze lepszy wynik zapewne można uzyskać wykorzystując 64-bitowe inty w 64-bitowym środowisku.

#free-pascal #lazarus

Bartosz Wójcik

Po prostu przepisz to na SSE2 zamiast używać takich przestarzałych kobył jak StretchBlt.

furious programming

Jednak nie – docelowo wołana jest StretchMaskBlt z widgetsetu. Zastanowię się nad zmianą.