paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 01:00:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL/CheckListBox: Implement Header[] property for Windows. Issue #39873, patch by Don Siders.

Browse Source
This commit is contained in:
wp_xyz 2022-09-01 16:59:10 +02:00
parent e886d9a126
commit 2199a763c6
3 changed files with 81 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
lcl/interfaces/win32/win32listsl.inc
View File

@ -451,6 +451,14 @@ begin
Result := Data^.Enabled;
end;
function TWin32CheckListBoxStrings.GetHeader(Index: Integer): Boolean;
var
Data: PWin32CheckListBoxItemRecord;
begin
Data := GetItemRecord(Index, false);
Result := Data^.Header;
end;
function TWin32CheckListBoxStrings.GetItemRecord(const Index: Integer;
const CreateNew: boolean): PWin32CheckListBoxItemRecord;
begin
@ -476,6 +484,15 @@ begin
SetItemRecord(Index, ItemRecord);
end;
procedure TWin32CheckListBoxStrings.SetHeader(Index: Integer; AValue: Boolean);
var
ItemRecord: PWin32CheckListBoxItemRecord;
begin
ItemRecord := GetItemRecord(Index, true);
ItemRecord^.Header := AValue;
SetItemRecord(Index, ItemRecord);
end;
procedure TWin32CheckListBoxStrings.SetItemRecord(const Index: Integer;
ItemRecord: PWin32CheckListBoxItemRecord);
begin

4
lcl/interfaces/win32/win32listslh.inc
View File

@ -99,6 +99,7 @@ Type
TheObject: TObject;
State: TCheckBoxState;
Enabled: Boolean;
Header: Boolean;
end;
{ TWin32CheckListBoxStrings }
@ -108,9 +109,11 @@ Type
FDefaultItem: TWin32CheckListBoxItemRecord;
function GetEnabled(Index: Integer): Boolean;
function GetState(Index: Integer): TCheckBoxState;
function GetHeader(Index: Integer): Boolean;
function GetItemRecord(const Index: Integer; const CreateNew: boolean): PWin32CheckListBoxItemRecord;
procedure SetEnabled(Index: Integer; const AValue: Boolean);
procedure SetItemRecord(const Index: Integer; ItemRecord: PWin32CheckListBoxItemRecord);
procedure SetHeader(Index: Integer; AValue: Boolean);
procedure SetState(Index: Integer; const AValue: TCheckBoxState);
protected
function GetObject(Index: Integer): TObject; override;
@ -125,6 +128,7 @@ Type
procedure Delete(Index: Integer); override;
procedure Move(CurIndex, NewIndex: Integer); override;
property Enabled[Index: Integer]: Boolean read GetEnabled write SetEnabled;
property Header[Index: Integer]: Boolean read GetHeader write SetHeader;
property State[Index: Integer]: TCheckBoxState read GetState write SetState;
end;

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

@ -51,6 +51,10 @@ type
const AIndex: integer; const AEnabled: Boolean); override;
class procedure SetState(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AState: TCheckBoxState); override;
class function GetHeader(const ACheckListBox: TCustomCheckListBox;
const AIndex: Integer): Boolean; override;
class procedure SetHeader(const ACheckListBox: TCustomCheckListBox;
const AIndex: Integer; const AHeader: Boolean); override;
end;
@ -180,7 +184,7 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
{cbGrayed } (tbCheckBoxMixedDisabled, tbCheckBoxMixedNormal)
);
var
Enabled, Selected: Boolean;
Enabled, Selected, Header: Boolean;
ARect, TextRect: Windows.Rect;
Details: TThemedElementDetails;
TextFlags: DWord;
@ -191,16 +195,24 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
begin
Selected := (Data^.itemState and ODS_SELECTED) > 0;
Enabled := CheckListBox.Enabled and CheckListBox.ItemEnabled[Data^.itemID];
Header := CheckListBox.Header[Data^.itemID];
ARect := Data^.rcItem;
TextRect := ARect;
if CheckListBox.UseRightToLeftAlignment then
TextRect.Right := TextRect.Right - TextRect.Bottom + TextRect.Top - 4
else
TextRect.Left := TextRect.Left + TextRect.Bottom - TextRect.Top + 4;
// fill the background
if Selected then
// adjust text rectangle for check box items
if not Header then
begin
if CheckListBox.UseRightToLeftAlignment then
TextRect.Right := TextRect.Right - TextRect.Bottom + TextRect.Top - 4
else
TextRect.Left := TextRect.Left + TextRect.Bottom - TextRect.Top + 4;
end;
if Header then
// TODO: use TCheckListBox.HeaderBackground when implemented
Windows.FillRect(Data^._HDC, ARect, GetSysColorBrush(SysColorToSysColorIndex(clInfoBk)))
else if Selected then
begin
Windows.FillRect(Data^._HDC, Rect(ARect.Left, ARect.Top, TextRect.Left, ARect.Bottom), CheckListBox.Brush.Reference.Handle);
Windows.FillRect(Data^._HDC, TextRect, GetSysColorBrush(COLOR_HIGHLIGHT));
@ -209,31 +221,38 @@ class procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
Windows.FillRect(Data^._HDC, ARect, CheckListBox.Brush.Reference.Handle);
// draw checkbox
if CheckListBox.UseRightToLeftAlignment then
ARect.Left := ARect.Right - ARect.Bottom + ARect.Top
else
ARect.Right := ARect.Left + ARect.Bottom - ARect.Top;
if not Header then
begin
if CheckListBox.UseRightToLeftAlignment then
ARect.Left := ARect.Right - ARect.Bottom + ARect.Top
else
ARect.Right := ARect.Left + ARect.Bottom - ARect.Top;
Details := ThemeServices.GetElementDetails(ThemeStateMap[CheckListBox.State[Data^.ItemID], Enabled]);
sz := ThemeServices.GetDetailSize(Details);
sz.cx := MulDiv(sz.cx, CheckListBox.Font.PixelsPerInch, ScreenInfo.PixelsPerInchX);
sz.cy := MulDiv(sz.cy, CheckListBox.Font.PixelsPerInch, ScreenInfo.PixelsPerInchY);
ARect := Bounds((ARect.Left + ARect.Right - sz.cx) div 2, (ARect.Top + ARect.Bottom - sz.cy) div 2,
sz.cx, sz.cy);
OffsetRect(ARect, 1, 1);
ThemeServices.DrawElement(Data^._HDC, Details, ARect);
Details := ThemeServices.GetElementDetails(ThemeStateMap[CheckListBox.State[Data^.ItemID], Enabled]);
sz := ThemeServices.GetDetailSize(Details);
sz.cx := MulDiv(sz.cx, CheckListBox.Font.PixelsPerInch, ScreenInfo.PixelsPerInchX);
sz.cy := MulDiv(sz.cy, CheckListBox.Font.PixelsPerInch, ScreenInfo.PixelsPerInchY);
ARect := Bounds((ARect.Left + ARect.Right - sz.cx) div 2, (ARect.Top + ARect.Bottom - sz.cy) div 2,
sz.cx, sz.cy);
OffsetRect(ARect, 1, 1);
ThemeServices.DrawElement(Data^._HDC, Details, ARect);
end;
// draw text
if CheckListBox.UseRightToLeftAlignment then begin
TextRect.Right := TextRect.Right - 2;
TextFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or DT_RIGHT or DT_RTLREADING;
end
else begin
else
begin
TextRect.Left := TextRect.Left + 2;
TextFlags := DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX;
end;
OldBkMode := Windows.SetBkMode(Data^._HDC, TRANSPARENT);
if not Enabled then
if Header then
// TODO: use TCheckListBox.HeaderColor when implemented
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(SysColorToSysColorIndex(clInfoText)))
else if not Enabled then
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(COLOR_GRAYTEXT))
else
if Selected then
@ -295,6 +314,12 @@ begin
GetWin32WindowInfo(Handle)^.List := Result;
end;
class function TWin32WSCustomCheckListBox.GetHeader(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): Boolean;
begin
Result := TWin32CheckListBoxStrings(ACheckListBox.Items).Header[AIndex];
end;
class function TWin32WSCustomCheckListBox.GetItemEnabled(
const ACheckListBox: TCustomCheckListBox; const AIndex: integer): Boolean;
begin
@ -323,6 +348,20 @@ begin
Windows.InvalidateRect(Handle, @SizeRect, False);
end;
class procedure TWin32WSCustomCheckListBox.SetHeader(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer; const AHeader: Boolean);
var
SizeRect: Windows.RECT;
Handle: HWND;
begin
TWin32CheckListBoxStrings(ACheckListBox.Items).Header[AIndex] := AHeader;
// redraw control
Handle := ACheckListBox.Handle;
Windows.SendMessage(Handle, LB_GETITEMRECT, AIndex, LPARAM(@SizeRect));
Windows.InvalidateRect(Handle, @SizeRect, False);
end;
class procedure TWin32WSCustomCheckListBox.SetState(
const ACheckListBox: TCustomCheckListBox; const AIndex: integer;
const AState: TCheckBoxState);