lcl, win32: move TCustomCheckListBox WS specific settings to WS implementataion

Other widgetsets use widgets with builtin check support, no need to have
ownerdraw details in the LCL class
+ publish OnMeasureItem, it can now be used like TCustomListBox
This commit is contained in:
Martok 2022-08-24 22:25:26 +02:00 committed by Maxim Ganetsky
parent 1161c4a75a
commit e4043024da
4 changed files with 21 additions and 27 deletions

View File

@ -55,7 +55,6 @@ type
class procedure WSRegisterClass; override;
procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); override;
procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure DrawItem(AIndex: Integer; ARect: TRect; State: TOwnerDrawState); override;
function GetCachedDataSize: Integer; override;
function GetCheckWidth: Integer;
@ -68,7 +67,7 @@ type
procedure FontChanged(Sender: TObject); override;
public
constructor Create(AOwner: TComponent); override;
procedure MeasureItem(Index: Integer; var TheHeight: Integer); override;
function CalculateStandardItemHeight: Integer; override;
procedure Toggle(AIndex: Integer);
procedure CheckAll(AState: TCheckBoxState; aAllowGrayed: Boolean = True; aAllowDisabled: Boolean = True);
procedure Exchange(AIndex1, AIndex2: Integer);
@ -121,6 +120,7 @@ type
property OnKeyPress;
property OnKeyDown;
property OnKeyUp;
property OnMeasureItem;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
@ -183,12 +183,6 @@ begin
SendItemHeader(AIndex, PCachedItemData(AData + FItemDataOffset)^.Header);
end;
procedure TCustomCheckListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := (Params.Style and not LBS_OWNERDRAWVARIABLE) or LBS_OWNERDRAWFIXED;
end;
procedure TCustomCheckListBox.DrawItem(AIndex: Integer; ARect: TRect; State: TOwnerDrawState);
begin
if not Header[AIndex] then begin
@ -216,12 +210,12 @@ begin
FItemDataOffset := inherited GetCachedDataSize;
end;
procedure TCustomCheckListBox.MeasureItem(Index: Integer; var TheHeight: Integer);
function TCustomCheckListBox.CalculateStandardItemHeight: Integer;
begin
if (Style = lbStandard) then
TheHeight := Max(CalculateStandardItemHeight, GetSystemMetrics(SM_CYMENUCHECK) + 2)
else
inherited MeasureItem(Index, TheHeight);
Result:=inherited CalculateStandardItemHeight;
// for Win32WS, ensure item height for internally owner-drawn checkmarks
if Style <> lbOwnerDrawVariable then
Result:= Max(Result, GetSystemMetrics(SM_CYMENUCHECK) + 2);
end;
procedure TCustomCheckListBox.Toggle(AIndex: Integer);

View File

@ -342,10 +342,8 @@ begin
// don't call GetItemHeight: causes errors on Windows due to recursion on control creation
if FItemHeight <> 0 then
AHeight := FItemHeight
else begin
Canvas.Font := Font;
AHeight := Canvas.TextHeight('Hg');
end;
else
AHeight:= CalculateStandardItemHeight;
if FStyle = lbOwnerDrawVariable then
MeasureItem(Integer(ItemId), AHeight);
if AHeight > 0 then

View File

@ -159,6 +159,9 @@ begin
pClassName := ListBoxClsName;
pSubClassName := LCLCheckListboxClsName;
SubClassWndProc := @CheckListBoxWndProc;
// require always owner-drawn, add flags if not already set due to Style
if (Flags and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE)) = 0 then
Flags:= Flags or LBS_OWNERDRAWFIXED;
end;
// create window
FinishCreateWindow(AWinControl, Params, False, True);
@ -262,6 +265,10 @@ begin
case TLMessage(AMessage).Msg of
LM_DRAWITEM:
begin
{ If the user set one of the OwnerDraw Styles, the widgetset will have translated the draw messages to LM_DRAWLISTITEM
instead (in TWindowProcHelper.DoMsgDrawItem). This means we don't get to draw the checkmark and the CLB looks like a
regular list.
}
with TLMDrawItems(AMessage) do
begin
// ItemID not UINT(-1)
@ -270,15 +277,10 @@ begin
end;
end;
LM_MEASUREITEM:
begin
with TLMMeasureItem(AMessage).MeasureItemStruct^ do
begin
itemHeight := TCustomListBox(AWinControl).ItemHeight;
if TCustomListBox(AWinControl).Style = lbOwnerDrawVariable then
TCustomListBox(AWinControl).MeasureItem(Integer(itemID), integer(itemHeight));
end;
end;
{ LM_MEASUREITEM:
TCustomListBox has a message handler, so DefaultWndHandler is never called.
We handle CLB specialcasing via a CalculateStandardItemHeight override
}
end;
inherited DefaultWndHandler(AWinControl, AMessage);

View File

@ -581,7 +581,7 @@ type
procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); virtual; // called to restore the itemdata after a handle is created
procedure BeforeDragStart; override;
procedure BeginAutoDrag; override;
function CalculateStandardItemHeight: Integer;
function CalculateStandardItemHeight: Integer; virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure InitializeWnd; override;
procedure DestroyWnd; override;