mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 18:37:58 +02:00
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:
parent
1161c4a75a
commit
e4043024da
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user