paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-02 03:52:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl: fix checklistbox item height under win32 (wince?)

Browse Source 
git-svn-id: trunk@15373 -
This commit is contained in:
paul 2008-06-10 01:19:42 +00:00
parent 7f7721db71
commit 31c5d5d91e
4 changed files with 40 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lcl/checklst.pas
View File

@ -65,6 +65,7 @@ type
procedure ItemClick(const AIndex: Integer); dynamic; procedure ItemClick(const AIndex: Integer); dynamic;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
procedure MeasureItem(Index: Integer; var TheHeight: Integer); override;
procedure Toggle(AIndex: Integer); procedure Toggle(AIndex: Integer);
property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False; property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
@ -181,6 +182,27 @@ begin
FItemDataOffset := inherited GetCachedDataSize; FItemDataOffset := inherited GetCachedDataSize;
end; end;
procedure TCustomCheckListBox.MeasureItem(Index: Integer; var TheHeight: Integer);
var
B: TBitmap;
begin
if (Style = lbStandard) then
begin
// Paul: This will happen only once if Style = lbStandard then CheckListBox is
// OwnerDrawFixed in real (under windows). Handle is not allocated and we
// cant use Canvas since it will cause recursion but we need correct font height
B := TBitmap.Create;
try
B.Canvas.Font := Font;
TheHeight := B.Canvas.TextHeight('Fj');
finally
B.Free;
end;
end
else
inherited MeasureItem(Index, TheHeight);
end;
procedure TCustomCheckListBox.Toggle(AIndex: Integer); procedure TCustomCheckListBox.Toggle(AIndex: Integer);
const const
NextStateMap: array[TCheckBoxState] of array[Boolean] of TCheckBoxState = NextStateMap: array[TCheckBoxState] of array[Boolean] of TCheckBoxState =

2
lcl/interfaces/win32/win32winapi.inc
View File

@ -289,7 +289,7 @@ begin
begin begin
with TLMDrawItems(Message) do with TLMDrawItems(Message) do
begin begin
if Sender is TCheckListBox then if Sender is TCustomCheckListBox then
begin begin
// ItemID not UINT(-1) // ItemID not UINT(-1)
if DrawItemStruct^.ItemID <> DWORD($FFFFFFFF) then if DrawItemStruct^.ItemID <> DWORD($FFFFFFFF) then

15
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -572,13 +572,16 @@ begin
Flags := Flags or LBS_MULTIPLESEL; Flags := Flags or LBS_MULTIPLESEL;
if Columns > 1 then if Columns > 1 then
Flags := Flags or LBS_MULTICOLUMN; Flags := Flags or LBS_MULTICOLUMN;
if AWinControl.FCompStyle = csCheckListBox then
if (AWinControl.FCompStyle = csCheckListBox) and (Style = lbStandard) then
Flags := Flags or LBS_OWNERDRAWFIXED Flags := Flags or LBS_OWNERDRAWFIXED
else case Style of else
lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED; case Style of
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE; lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED;
end; lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
if BorderStyle=bsSingle then end;
if BorderStyle = bsSingle then
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
end; end;
pClassName := 'LISTBOX'; pClassName := 'LISTBOX';

13
lcl/interfaces/wince/wincewsstdctrls.pp
View File

@ -442,12 +442,15 @@ begin
Flags := Flags or LBS_MULTIPLESEL; Flags := Flags or LBS_MULTIPLESEL;
if Columns > 1 then if Columns > 1 then
Flags := Flags or LBS_MULTICOLUMN; Flags := Flags or LBS_MULTICOLUMN;
if AWinControl.FCompStyle = csCheckListBox then
if (AWinControl.FCompStyle = csCheckListBox) and (Style = lbStandard) then
Flags := Flags or LBS_OWNERDRAWFIXED Flags := Flags or LBS_OWNERDRAWFIXED
else case Style of else
lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED; case Style of
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE; lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED;
end; lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
end;
if BorderStyle=bsSingle then if BorderStyle=bsSingle then
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE; FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
end; end;