Autor Téma: Netransparentní checkbox  (Přečteno 203 krát)

Offline ShaneZB

  • Nováček
  • *
  • Příspěvků: 15
  • Karma: 0
  • HJ-SOFT s.r.o.
    • Verze Delphi: Delphi 10
Netransparentní checkbox
« kdy: 05-02-2018, 09:08:55 »
Zdar všem.
Migruju projekt z D7 na D10. Na mnoha místech mám vlastní CheckBox (dědí z TCustomCheckBox) položený na TBevel (zapnutí/vypnutí skupiny hodnot). V D7 ten CheckBox překrývá tu část čáry, která leží pod ním - v D10 je čára pod Caption vidět. Jak nejsnadněji přidám vlastnost do CheckBoxu (Transparent asi), abych dosáhl chování jako v D7?

Offline Delfin

  • Guru
  • *****
  • Příspěvků: 610
  • Karma: 27
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Re:Netransparentní checkbox
« Odpověď #1 kdy: 05-02-2018, 10:42:58 »
Zdar všem.
Migruju projekt z D7 na D10. Na mnoha místech mám vlastní CheckBox (dědí z TCustomCheckBox) položený na TBevel (zapnutí/vypnutí skupiny hodnot). V D7 ten CheckBox překrývá tu část čáry, která leží pod ním - v D10 je čára pod Caption vidět. Jak nejsnadněji přidám vlastnost do CheckBoxu (Transparent asi), abych dosáhl chování jako v D7?

Pominu-li VCL Styles, pak bys mohl zkusit napr. nasledujici (barva pozadi se bere z property Color v pripade nastaveni Transparent na False):

Kód: Delphi [Vybrat]
  1. type
  2.   TMyCheckBox = class(TCustomCheckBox)
  3.   private
  4.     FTransparent: Boolean;
  5.     procedure SetTransparent(Value: Boolean);
  6.     procedure CNCtlColorStatic(var Msg: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
  7.   public
  8.     constructor Create(AOwner: TComponent); override;
  9.   published
  10.     property Transparent: Boolean read FTransparent write SetTransparent default True;
  11.   end;
  12.  
  13. implementation
  14.  
  15. constructor TCheckBox.Create(AOwner: TComponent);
  16. begin
  17.   inherited;
  18.   FTransparent := True;
  19. end;
  20.  
  21. procedure TCheckBox.SetTransparent(Value: Boolean);
  22. begin
  23.   if FTransparent <> Value then
  24.   begin
  25.     FTransparent := Value;
  26.     Invalidate;
  27.   end;
  28. end;
  29.  
  30. procedure TCheckBox.CNCtlColorStatic(var Msg: TWMCtlColorStatic);
  31. var
  32.   Brush: HBRUSH;
  33. begin
  34.   if FTransparent then
  35.     inherited
  36.   else
  37.   begin
  38.     Brush := CreateSolidBrush(ColorToRGB(Color));
  39.     try
  40.       FillRect(Msg.ChildDC, ClientRect, Brush);
  41.     finally
  42.       DeleteObject(Brush);
  43.     end;
  44.     Msg.Result := GetStockObject(NULL_BRUSH);
  45.   end;
  46. end;

Tedy, puvodne byla zprava WM_CTLCOLORSTATIC urcena k tomu aby uzivatel vratil "drzak na stetec" (handle brush) ktery se pouzije k vyplni pozadi. To vsak neplati v pripade vyuziti temat.
« Poslední změna: 05-02-2018, 10:51:31 od Delfin »
I'm a soldier, so don't panic!

Offline Delfin

  • Guru
  • *****
  • Příspěvků: 610
  • Karma: 27
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Re:Netransparentní checkbox
« Odpověď #2 kdy: 05-02-2018, 12:48:55 »
Excellent
Rated 2 times
Jeste mala uprava (odstranil jsem paranoidni try..finally blok a pridal do podminky vychoziho chovani stav kdy neni komponenta kreslena tematem). Jinak jsem udelal chybu pri kopirovani (ve skutecnosti jsem pouzil intercepted class, takze se trida u me jmenuje TCheckBox namisto TMyCheckBox, coz jsem omylem zkopiroval do implementacni sekce):

Kód: Delphi [Vybrat]
  1. procedure TCheckBox.CNCtlColorStatic(var Msg: TWMCtlColorStatic); // ← melo tu byt TMyCheckBox
  2. var
  3.   Brush: HBRUSH;
  4. begin
  5.   if not ThemeControl(Self) or FTransparent then // ← pokud neni komponenta kreslena tematem nebo je zapnuta pruhlednost...
  6.     inherited // ← zavolame puvodni implementaci handleru zpravy
  7.   else
  8.   begin // ← komponenta se kresli tematem a zaroven je vypnuta pruhlednost
  9.     Brush := CreateSolidBrush(ColorToRGB(Color)); // ← vytvorime stetec s barvou Color
  10.     FillRect(Msg.ChildDC, ClientRect, Brush); // ← vyplnime klientsky obsah vytvorenym stetcem
  11.     DeleteObject(Brush); // ← uvolnime stetec
  12.     Msg.Result := GetStockObject(NULL_BRUSH); // ← vratime prazdny stetec aby Windows obsah neprekreslily
  13.   end;
  14. end;
« Poslední změna: 05-02-2018, 12:56:42 od Delfin »
I'm a soldier, so don't panic!

Offline ShaneZB

  • Nováček
  • *
  • Příspěvků: 15
  • Karma: 0
  • HJ-SOFT s.r.o.
    • Verze Delphi: Delphi 10
Re:Netransparentní checkbox
« Odpověď #3 kdy: 05-02-2018, 15:00:08 »
Moc díky. Úspěšně implementováno.

Offline Delfin

  • Guru
  • *****
  • Příspěvků: 610
  • Karma: 27
  • SW konzultant
    • Verze Delphi: 2009, Tokyo
Re:Netransparentní checkbox
« Odpověď #4 kdy: 05-02-2018, 15:01:47 »
Moc díky. Úspěšně implementováno.

Neni zac! ;)
I'm a soldier, so don't panic!

 

S rychlou odpovědí můžete používat BB kódy a emotikony jako v běžném okně pro odpověď, ale daleko rychleji.

Jméno: E-mail:
Ověření:
Kolik je šest plus čtyři (slovem):