paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 21:18:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL/CheckListbox: Add new properties HeaderBackgroundColor and HeaderColor and implement them for win32 WS. Issue #39874, patch by Don Siders.

Browse Source
This commit is contained in:
wp_xyz 2022-09-02 00:49:45 +02:00
parent 2199a763c6
commit cf2aa0649b
2 changed files with 45 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
lcl/checklst.pas
View File

@ -36,6 +36,8 @@ type
TCustomCheckListBox = class(TCustomListBox)
private
FAllowGrayed: Boolean;
FHeaderBackgroundColor: TColor;
FHeaderColor: TColor;
FItemDataOffset: Integer;
FOnClickCheck : TNotifyEvent;
FOnItemClick: TCheckListClicked;
@ -49,6 +51,8 @@ type
procedure SendItemHeader(const AIndex: Integer; const AHeader: Boolean);
procedure DoChange(var Msg: TLMessage); message LM_CHANGED;
procedure SetHeader(AIndex: Integer; const AValue: Boolean);
procedure SetHeaderBackgroundColor(AValue: TColor);
procedure SetHeaderColor(AValue: TColor);
procedure SetItemEnabled(AIndex: Integer; const AValue: Boolean);
procedure SetState(AIndex: Integer; const AValue: TCheckBoxState);
protected
@ -75,6 +79,8 @@ type
property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
property Header[AIndex: Integer]: Boolean read GetHeader write SetHeader;
property HeaderBackgroundColor: TColor read FHeaderBackgroundColor write SetHeaderBackgroundColor default clInfoBk;
property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clInfoText;
property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
property State[AIndex: Integer]: TCheckBoxState read GetState write SetState;
property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
@ -100,6 +106,8 @@ type
property ExtendedSelect;
property Enabled;
property Font;
property HeaderBackgroundColor;
property HeaderColor;
property IntegralHeight;
property Items;
property ItemHeight;
@ -208,6 +216,8 @@ begin
inherited Create(AOwner);
FCompStyle := csCheckListBox;
FItemDataOffset := inherited GetCachedDataSize;
FHeaderBackgroundColor := clInfoBk;
FHeaderColor := clInfoText;
end;
function TCustomCheckListBox.CalculateStandardItemHeight: Integer;
@ -367,6 +377,20 @@ begin
PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^.Header := AValue;
end;
procedure TCustomCheckListBox.SetHeaderBackgroundColor(AValue: TColor);
begin
if FHeaderBackgroundColor = AValue then Exit;
FHeaderBackgroundColor := AValue;
Invalidate;
end;
procedure TCustomCheckListBox.SetHeaderColor(AValue: TColor);
begin
if FHeaderColor = AValue then Exit;
FHeaderColor := AValue;
Invalidate;
end;
class procedure TCustomCheckListBox.WSRegisterClass;
begin
inherited WSRegisterClass;

30
lcl/interfaces/win32/win32wschecklst.pp
View File

@ -192,15 +192,25 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
OldBkMode: Integer;
sz: TSize;
WideBuffer: widestring;
HdrBg, HdrTxt: TColor;
BgBrush: Windows.HBRUSH;
begin
Selected := (Data^.itemState and ODS_SELECTED) > 0;
Enabled := CheckListBox.Enabled and CheckListBox.ItemEnabled[Data^.itemID];
Header := CheckListBox.Header[Data^.itemID];
if Header then
begin
HdrBg := CheckListBox.HeaderBackgroundColor;
if HdrBg = clDefault then HdrBg := clInfoBk;
HdrTxt := CheckListBox.HeaderColor;
if HdrTxt = clDefault then HdrTxt := clInfoText;
end;
ARect := Data^.rcItem;
TextRect := ARect;
// adjust text rectangle for check box items
// adjust text rectangle for check box and padding
if not Header then
begin
if CheckListBox.UseRightToLeftAlignment then
@ -209,9 +219,13 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
TextRect.Left := TextRect.Left + TextRect.Bottom - TextRect.Top + 4;
end;
// fill the background
if Header then
// TODO: use TCheckListBox.HeaderBackground when implemented
Windows.FillRect(Data^._HDC, ARect, GetSysColorBrush(SysColorToSysColorIndex(clInfoBk)))
begin
BgBrush := Windows.CreateSolidBrush(ColorToRGB(HdrBg));
Windows.FillRect(Data^._HDC, ARect, BgBrush);
Windows.DeleteObject(BgBrush);
end
else if Selected then
begin
Windows.FillRect(Data^._HDC, Rect(ARect.Left, ARect.Top, TextRect.Left, ARect.Bottom), CheckListBox.Brush.Reference.Handle);
@ -249,13 +263,11 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
TextFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
end;
OldBkMode := Windows.SetBkMode(Data^._HDC, TRANSPARENT);
if Header then
// TODO: use TCheckListBox.HeaderColor when implemented
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(SysColorToSysColorIndex(clInfoText)))
else if not Enabled then
if not Enabled then
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(COLOR_GRAYTEXT))
else
if Selected then
else if Header then
OldColor := Windows.SetTextColor(Data^._HDC, ColorToRGB(HdrTxt))
else if Selected then
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(COLOR_HIGHLIGHTTEXT))
else
begin