paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-26 15:33:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: update checklistbox itemheight in runtime on font change

Browse Source 
git-svn-id: trunk@15433 -
This commit is contained in:
paul 2008-06-16 01:37:30 +00:00
parent 4a04564358
commit d5d9f4c4d6
3 changed files with 34 additions and 14 deletions

31
lcl/checklst.pas
View File

@ -63,6 +63,8 @@ type
procedure WriteData(Stream: TStream);
procedure ClickCheck; dynamic;
procedure ItemClick(const AIndex: Integer); dynamic;
procedure FontChanged(Sender: TObject); override;
procedure ParentFontChanged; override;
public
constructor Create(AOwner: TComponent); override;
procedure MeasureItem(Index: Integer; var TheHeight: Integer); override;
@ -184,22 +186,9 @@ begin
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
TheHeight := CalculateStandardItemHeight
else
inherited MeasureItem(Index, TheHeight);
end;
@ -327,6 +316,20 @@ begin
if Assigned(OnItemClick) then OnItemClick(Self, AIndex);
end;
procedure TCustomCheckListBox.FontChanged(Sender: TObject);
begin
inherited FontChanged(Sender);
if ([csLoading, csDestroying] * ComponentState = []) and (Style = lbStandard) then
ItemHeight := CalculateStandardItemHeight;
end;
procedure TCustomCheckListBox.ParentFontChanged;
begin
inherited ParentFontChanged;
if ([csLoading, csDestroying] * ComponentState = []) and (Style = lbStandard) then
ItemHeight := CalculateStandardItemHeight;
end;
procedure TCustomCheckListBox.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);

16
lcl/include/customlistbox.inc
View File

@ -45,6 +45,22 @@ begin
BeginDrag(False);
end;
function TCustomListBox.CalculateStandardItemHeight: Integer;
var
B: TBitmap;
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;
Result := B.Canvas.TextHeight('Fj');
finally
B.Free;
end;
end;
procedure TCustomListBox.Loaded;
begin
inherited Loaded;

1
lcl/stdctrls.pp
View File

@ -491,6 +491,7 @@ type
procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); virtual; // called to store item data while the handle isn't created
procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); virtual; // called to restore the itemdata after a handle is created
procedure BeginAutoDrag; override;
function CalculateStandardItemHeight: Integer;
procedure Loaded; override;
procedure InitializeWnd; override;
procedure FinalizeWnd; override;