Systemowe kolory - pozyskanie odcieni

Piszę mały edytor, który chciałbym przystosować pod kolorystykę wizualnego stylu systemu; W nim mam zaimplementowane własnoręczne rysowanie itemów w takich kontrolkach jak: TMainMenu, TPopupMenu, TCheckListBox, TComboBox itd.; Rysowanie tła pozycji jest takie samo dla wszystkich kontrolek - pobieram systemowy kolor clHighlight i na jego bazie ustalam jaśniejszy odcień dla tła itema, oraz ciemniejszy dla ramki itema (wszystkiego nie potrzeba opisywać - nie w tym rzecz); Dzięki temu przynajmniej większość stylów w systemie będzie obsłużona poprawnie; Efekt przedstawia poniższy zrzut - jeden algorytm malujący dla trzech wizualnych stylów WinXP: odpowiednio Domyślny (niebieski), Oliwkowozielony oraz Srebrny:

Podczas inicjalizacji modułu z silnikiem aplikacji tworzę obiekt silnika, po czym ustalam wszelkie kolory, które będą pomocne przy malowaniu itemów w programie; Wykorzystuje do tego krótką funkcję pozyskującą odcień podanego w argumencie koloru według wartości podanej w drugim parametrze; Kod algorytmu:

function _ChangeLightness(BaseColor: TColor; const LightingLevel: SmallInt): TColor;
begin
  with TBitmap.Create() do
    try
      PixelFormat := pf24bit;
      Width := 1;
      Height := 1;

      Canvas.Pixels[0, 0] := BaseColor;
      BaseColor := Canvas.Pixels[0, 0];

      Result := RGB(Min(Max(GetRValue(BaseColor) + LightingLevel, 0), 255),
                    Min(Max(GetGValue(BaseColor) + LightingLevel, 0), 255),
                    Min(Max(GetBValue(BaseColor) + LightingLevel, 0), 255));
    finally
      Free();
    end;
end;

wywołanie:

Fill := _ChangeLightness(clHighlight, 15);
Frame := _ChangeLightness(clHighlight, -15);

Jednak nie jestem z niego zadowolony, ponieważ aby móc obliczyć dowolny odcień muszę tworzyć bitmapę, zamalować piksel na kolor, następnie pobrać z powrotem ten kolor do argumentu i odpowiednio dekrementować/inkrementować wartość każdej z trzech składowych co jest niepoprawne według mnie; Niestety jak do tej pory nie udało mi się tego zrobić inaczej;

Domyślam się, że np. stała clHighlight jest niejaką maską, którą łączy się z innym kolorem w bliżej nieokreślony sposób i tak powstaje dany kolor, jednak nie wiem w jaki sposób konkretnie jest to wykonywane (oczywiście jeśli to jest prawda);

Pytanie: W jaki sposób wyciągnąć prawdziwy kolor ze stałej clHighlight by móc wykonać powyższe czynności bez wykorzystania bitmapy?

function _ChangeLightness(BaseColor: TColor; const LightingLevel: SmallInt): TColor;
begin
  BaseColor := ColorToRGB(BaseColor);
  Result := RGB(Min(Max(GetRValue(BaseColor) + LightingLevel, 0), 255),
                Min(Max(GetGValue(BaseColor) + LightingLevel, 0), 255),
                Min(Max(GetBValue(BaseColor) + LightingLevel, 0), 255));
end;

No i wszystko gra, dziękuję @pelsta ;)

A moglbys pokazac nam swoj sposob np na malowanie ikon w comboboxie - jestem ciekaw moze wymysliles cos fajnego?

A moglbys pokazac nam swoj sposob np na malowanie ikon w comboboxie [...] ?

procedure TPreferencesForm.cbFontNameDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  FONTS_LIST_ICON_INDEX = 35;
var
  Combo: TComboBox;
  iFontHeight: Integer;
begin
  Combo := TComboBox(Control);

  with Combo.Canvas do
    begin
      case odSelected in State of
        True:  begin
                 Pen.Color := engOpiser.AppColors.Background.Hot.Frame;
                 Brush.Color := engOpiser.AppColors.Background.Hot.Fill;
                 Font.Color := engOpiser.AppColors.Font.Hot;
               end;
        False: begin
                 Pen.Color := engOpiser.AppColors.Background.NormalOrDisabled.Frame;
                 Brush.Color := engOpiser.AppColors.Background.NormalOrDisabled.Fill;
                 Font.Color := engOpiser.AppColors.Font.Normal;
               end;  
      end;

      Rectangle(Rect);
      Draw(Rect.Left + 2, Rect.Top + 2, aFormIcons[FONTS_LIST_ICON_INDEX + Byte(odSelected in State)]);

      Font.Name := Combo.Items[Index];
      Font.Size := 10;

      iFontHeight := TextHeight(Font.Name);
      TextOut(Rect.Left + 32, Rect.Top + ((24 - iFontHeight) div 2) + 2, Font.Name);

      if odFocused in State then
        begin
          Pen.Color := Pen.Color xor $FFFFFF;
          DrawFocusRect(Rect);
        end;
    end;
end;

cbFontName (preferencje programu):

lbNotesList (lista zapisych opisów):

lbFiles i edtPath (okno dialogowe do wyboru pliku/lokalizacji):

Program udostępnię jako OpenSource jak skończę;

furious programming napisał(a):

Program udostępnię jako OpenSource jak skończę;

Mógłbyś wydać na Lazarusa, chętnie bym się zainteresował takimi komponentami, a mógłbyś w sumie wydać jako package to nawet jest szansa że by dodali do Lazarusa czy innego CodeTyphoona.

-123oho napisał(a)

Mógłbyś wydać na Lazarusa, chętnie bym się zainteresował takimi komponentami

Spróbuję przekonwertować na Lazarusa, jednak nie jestem pewny czy to mi się uda; W całym programie nie korzystam z jakichś swoich kontrolek, więc import na Lazarusa powinien przebiec bez większych modyfikacji;

Projekt całkowicie przerabiam - napisałem całość kilka miesięcy temu, ale jak niedawno spojrzałem na kod to aż mnie otrzepało - trzeba zmodyfikować większość elementów żeby działało szybciej oraz wyeliminować kilka bugów (obsługa kolorystyki systemu oraz kompatybilność z WinVista i Win7);

Te kontrolki, które widać na zrzutach nie zostały utworzone osobno - ich obsługa zawarta jest w unicie odpowiedzialnym za dany formularz; Zrobiłem to w ten sposób, ponieważ każda z kontrolek (oprócz menu głównego i kontekstowych) jest użyta tylko w jednym formularzu, stąd nie było potrzeby tworzyć własnych komponentów dziedziczących po standardowych; Do tego dochodzi jeszcze problematyczna obsługa zestawu ikon z zewnętrzych plików, więc trzeba by zmodyfikować bardzo dużo rzeczy, żeby wystarczyło jedynie położyć kontrolkę na formularz i gotowe; Mam w planach utworzyć osobne kontrolki (np. do wyboru pliku z zawartością danego katalogu), ale nie wiem czy jeszcze będzie mi się chciało bawić w takie rzeczy; Wcześniejsza wersja była niezbyt poprawnie napisana, stąd trzeba by wiele zmienić by wszystko miało profesjonalny wygląd;

Menu jak menu - oprogramowane są tylko zdarzenia OnMeasureItem i OnDrawItem; Lista opisów to zwykły TCheckListBox i uzupełnione zdarzenia OnMeasureItem i OnDrawItem + reakcja na klawisze i klikanie - to samo jeśli chodzi o listę z zawartością katalogu; Żadnych jakichś profesjonalnych kontrolek; Jeśli będzie mi się jeszcze chciało to napiszę gotowe kontrolki by można było wielu ich instancji używać z jedną obsługą - zobaczę jeszcze; Jedyny kłopot sprawia wymyślona obsługa zestawu ikon;

niezle, jak bedzie opensource to sie pisze na przetestowanie pod delphi.

Wtedy jak pisałem ten program to byłem trochę niepoważny, bo nie zaprojektowałem jego sobie tylko na bieżąco wymyślałem nowe funkcjonalności i dodawałem do programu jak leci - teraz ciężko dojść do ładu chcąc wprowadzić jakiekolwiek modyfikacje by zoptymalizować całość...

Azarien napisał(a)

Ładnie to wygląda.

Dzięki :] Trochę było kombinowania żeby jakiś ciekawy efekt uzyskać (m.in. trzy stany ikon - Normal, Hot i Disabled), ale trzeba zmodyfikować wykorzystywanie ikon - teraz wygląda to tak, że mam utworzony własnym programem plik z zestawem ikon, one są podczas tworzenia formularza wczytywane do prywatnej macierzy klasy (uwzględniając macierz indeksów, których się nie obsługuje) i podczas malowania np. itema w menu wykorzystywana jest ikona z macierzy o indeksie takim, jaki jest Tag itema - do tego jeszcze dochodzi sprawdzenie czy jest to pierwszy, ostatni czy środkowy item po to, by zrobić taką śmieszną śmieszną ramkę (dla pierwszego itema rysowana jest górna linia, a dla ostatniego dolna); Trochę jest pieprzenia się, ale w silniku programu mam kilka funkcji, które wykorzystuję w całym projekcie:

• do wczytywania ikon do prywatnej macierzy z danego pliku,
• do ustalenia rozmiaru itema sekcji menu,
• do ustalenia rozmiaru itema z listy danej sekcji,
• do namalowania itema sekcji menu,
• do namalowania itema z listy danej sekcji,

jest tego trochę, ale napisane jest raz, a wykorzystywane wielokrotnie we wszystkich formularzach, które zawierają dane kontrolki; Jednak żeby kod wyglądał bardziej profesjonalnie pasowałoby utworzyć własne kontrolki dziedziczące po standardowych i przerobić obsługę własnych ikon oraz zestawu kolorów;

Lazarus raczej nie potrzebuje wielkich zmian w stosunku do Delphi, a jak zrobisz {$MODE DELPHI} to jeszcze mniej.

Przecież jest konwerter projektów który nie tylko doda tą deklarację, ale też zmieni część nazw które się zmieniły, przetworzy plik tak żeby wygenerować projekt Lazarusa i zrobi masę innych rzeczy które są potrzebne żeby część projektów się uruchomiła bez/z małymi zmianami.
Nie wiedzą, ale mówią, trochę szkoda że takie 'porady' słychać od osób które wszakże się znają, ale nie na Lazarusie... Dlatego proponuję radzić gdy się wie nieco więcej niż to co powiedziałem. Bo tak to twoje porady może i nie są błędne, ale raczej nie mają większego sensu...

Wtedy jak pisałem ten program to byłem trochę niepoważny, bo nie zaprojektowałem jego sobie tylko na bieżąco wymyślałem nowe funkcjonalności i dodawałem do programu jak leci - teraz ciężko dojść do ładu chcąc wprowadzić jakiekolwiek modyfikacje by zoptymalizować całość...

Tja, znam to :P . Jeżeli nie znajdziesz czasu ogarnąć tego żeby miało ręce i nogi to niestety nie sądzę żeby ktoś z tego skorzystał, no ale to twój wybór czy chcesz mieć FuriousControls czy wolisz się zająć czymś innym ;p . Tak czy siak, zgodzić się trzeba że kontrolki fajne.

Furious Programming napisał(a)

Spróbuję przekonwertować na Lazarusa, jednak nie jestem pewny czy to mi się uda; W całym programie nie korzystam z jakichś swoich kontrolek, więc import na Lazarusa powinien przebiec bez większych modyfikacji;

Nom, wspomniałem, że wykorzystam moduł importu projektów z Delphi - inaczej wolę się za to nie zabierać;

-123oho napisał(a)

Jeżeli nie znajdziesz czasu ogarnąć tego żeby miało ręce i nogi to niestety nie sądzę żeby ktoś z tego skorzystał, no ale to twój wybór czy chcesz mieć FuriousControls czy wolisz się zająć czymś innym ;p .

Ale ja chcę skończyć program, który wykorzystuje przedstawione kontrolki, nie tworzyć paczkę takich kontrolek; Projekt i tak skończę i udostępnię - może komuś się przyda a nawet będzie chciał go rozwijać, jednak to nie problem stworzyć paczkę z dokładnie takimi kontrolkami - jeśli będę miał czas to być może stworzę taką paczkę i oczywiście podziele się nią :)

To co teraz jest zaimplementowane ma ręce i nogi - działa bez zarzutu tak, jak to sobie życzyłem, jednak nie widzę potrzeby tworzyć gotowych do położenia na formularzu kontrolek tylko dlatego, żeby było fajniej; I tak w tym projekcie przedstawione listy istnieją tylko po jednym egzemplarzu, więc wolałbym zostawić to tak jak jest; Jeżeli potrzeba będzie stworzyć własne kontrolki to trzeba będzie zmodyfikować cały system obsługi paczek ikon z zewnętrznych plików, a to chwilę zajmie; Jak dla mnie to ten system jest prosty, łatwy do zrozumienia a tym użytkownikom, dla których stworzyłem ten program raczej nie będzie zależało na kontrukcji kodu i wykorzystanych elementach języka (zważywszy na to, że pewnie żaden z nich nie widzi różnicy między interfejsem a mikserem...);

Tak więc w programie zostanie tak jak jest, a jeśli będę chciał to stworzę paczkę z tak wyglądającymi kontrolkami i wyposażę je w takie same metody, jak w tym programie (+ kilka właściwości, dzięki którym będzie można dostosować ich wygląd według własnych upodobań);

-123oho napisał(a)

Tak czy siak, zgodzić się trzeba że kontrolki fajne.

Program z nimi wygląda jeszcze fajniej :]

furious programming napisał(a):

function _ChangeLightness(BaseColor: TColor; const LightingLevel: SmallInt): TColor;
begin
  BaseColor := ColorToRGB(BaseColor);
  Result := RGB(Min(Max(GetRValue(BaseColor) + LightingLevel, 0), 255),
                Min(Max(GetGValue(BaseColor) + LightingLevel, 0), 255),
                Min(Max(GetBValue(BaseColor) + LightingLevel, 0), 255));
end;

Ja z kolei wymyśliłem taką oto funkcję (a może gdzieś ją znalazłem?).

function LightUp(Color:TColor; proc{0..1}:Single):TColor;
var
  r1,r2,g1,g2,b1,b2:Byte;
  r,g,b:Byte;
  ToColor:TColor;
begin
  Color:=ColorToRGB(Color);//mogą też być kolory systemowe
  ToColor:=clWhite;
  
  r1:=GetRValue(Color);
  g1:=GetGValue(Color);
  b1:=GetBValue(Color);

  r2:=GetRValue(ToColor);
  g2:=GetGValue(ToColor);
  b2:=GetBValue(ToColor);

  r:=Round(r1+(r2-r1)*proc);
  g:=Round(g1+(g2-g1)*proc);
  b:=Round(b1+(b2-b1)*proc);
  Result:=RGB(r,g,b);
end;

Rozjaśnianie i Przyciemnianie

Widziałem już ten sposób i podobne, jednak przyciemnianie i rozjaśnianie wykorzystuję tylko raz i to w dodatku pakuję wynik do zmiennej (a nie przyciemniam np. jakiejś bitmapy) więc wystarczy mi taki sposób;

Kiedyś jeszcze interesowało mnie rozłożenie koloru na składowe HLS (Heu, Lightness i Saturation) - można to wykonać za pomocą funkcji WinAPI - ColorRGBToHLS; Więcej na ten temat można przeczytać w tym wątku: http://www.digipedia.pl/usenet/thread/21/934150/

O macierzach słyszał? :]

function _LightUp(Color: TColor; Percent: Single): TColor;
type
  TColorElement = (ceR, ceG, ceB);
const
  TO_COLOR = TColor(clWhite);
var
  aColor1, aColor2: array [TColorElement] of Byte;
begin
  Color := ColorToRGB(Color);

  aColor1[ceR] := GetRValue(Color);
  aColor1[ceG] := GetGValue(Color);
  aColor1[ceB] := GetBValue(Color);

  aColor2[ceR] := GetRValue(TO_COLOR);
  aColor2[ceG] := GetGValue(TO_COLOR);
  aColor2[ceB] := GetBValue(TO_COLOR);

  Result := RGB(Round(aColor1[ceR] + (aColor2[ceR] - aColor1[ceR]) * Percent),
                Round(aColor1[ceG] + (aColor2[ceG] - aColor1[ceG]) * Percent),
                Round(aColor1[ceB] + (aColor2[ceB] - aColor1[ceB]) * Percent));
end;

Ciekawy sposób, dzięki za kod :]

function Light(Col: TColor; Percentage: Byte): TColor;
var
  R, G, B: Byte;
begin
  Col := ColorToRGB(Col);
  R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col);
  R := Trunc(255 - Percentage / 100 * (255 - R));
  G := Trunc(255 - Percentage / 100 * (255 - G));
  B := Trunc(255 - Percentage / 100 * (255 - B));
  Result := RGB(R, G, B);
end;

function Dark(Col: TColor; Percentage: Byte): TColor;
var
  R, G, B: Byte;
begin
  Col := ColorToRGB(Col);
  R := GetRValue(Col); G := GetGValue(Col); B := GetBValue(Col);
  R := Trunc(R * Percentage / 100);
  G := Trunc(G * Percentage / 100);
  B := Trunc(B * Percentage / 100);
  Result := RGB(R, G, B);
end;

Percentage - (0 - 100)