paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-25 14:39:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, grids, only draw on cells with enough space

Browse Source 
git-svn-id: trunk@15860 -
This commit is contained in:
jesus 2008-07-24 20:55:49 +00:00
parent e98bf43728
commit 7e7711b535
1 changed files with 25 additions and 9 deletions

34
lcl/grids.pas
View File

@ -3281,16 +3281,32 @@ end;
procedure TCustomGrid.DrawCellText(aCol, aRow: Integer; aRect: TRect;
aState: TGridDrawState; aText: String);
begin
dec(aRect.Right, 3);
case Canvas.TextStyle.Alignment of
Classes.taLeftJustify: Inc(aRect.Left, 3);
Classes.taRightJustify: Dec(aRect.Right, 1);
with ARect do begin
dec(Right, 3);
case Canvas.TextStyle.Alignment of
Classes.taLeftJustify: Inc(Left, 3);
Classes.taRightJustify: Dec(Right, 1);
end;
case Canvas.TextStyle.Layout of
tlTop: Inc(Top, 3);
tlBottom: Dec(Bottom, 3);
end;
if Right<Left then
Right:=Left;
if Left>Right then
Left:=Right;
if Bottom<Top then
Bottom:=Top;
if Top>Bottom then
Top:=Bottom;
if (Left<>Right) and (Top<>Bottom) then
Canvas.TextRect(aRect,Left,Top, aText);
end;
case Canvas.TextStyle.Layout of
tlTop: Inc(aRect.Top, 3);
tlBottom: Dec(aRect.Bottom, 3);
end;
Canvas.TextRect(aRect,ARect.Left,ARect.Top, aText);
end;
procedure TCustomGrid.OnTitleFontChanged(Sender: TObject);