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

LCL: TLabel added DoMeasureTextPosition from Luiz Americo Pereira Camara

Browse Source 
git-svn-id: trunk@11830 -
This commit is contained in:
mattias 2007-08-16 18:42:49 +00:00
parent 13c2b40e20
commit 73d0ae53b0
2 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lcl/include/customlabel.inc
View File

@ -174,6 +174,24 @@ begin
Result:=false;
end;
procedure TCustomLabel.DoMeasureTextPosition(var TextTop: integer;
var TextLeft: integer);
var
lTextHeight: integer;
lTextWidth: integer;
begin
TextLeft := 0;
if Layout = tlTop then begin
TextTop := 0;
end else begin
CalcSize(lTextWidth, lTextHeight);
case Layout of
tlCenter: TextTop := (Height - lTextHeight) div 2;
tlBottom: TextTop := Height - lTextHeight;
end;
end;
end;
constructor TCustomLabel.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -364,7 +382,6 @@ var
TR : TTextStyle;
R : TRect;
TextLeft, TextTop: integer;
lTextWidth, lTextHeight: integer;
LabelText: string;
begin
R := Rect(0,0,Width,Height);
@ -412,16 +429,7 @@ begin
SystemFont:=false;
RightToLeft:=UseRightToLeftReading;
end;
TextLeft := R.Left;
if Layout = tlTop then begin
TextTop := R.Top;
end else begin
CalcSize(lTextWidth, lTextHeight);
case Layout of
tlCenter: TextTop := (R.Bottom - R.Top - lTextHeight) div 2;
tlBottom: TextTop := R.Bottom - R.Top - lTextHeight;
end;
end;
DoMeasureTextPosition(TextTop, TextLeft);
//debugln('TCustomLabel.Paint ',dbgs(Alignment=tacenter),' ',dbgs(Layout=tlCenter),' ',dbgs(TextLeft),' TextTop=',dbgs(TextTop),' ',dbgs(R));
LabelText := GetLabelText;
if not Enabled then begin

2
lcl/stdctrls.pp
View File

@ -1346,6 +1346,8 @@ type
procedure SetOptimalFill(const AValue: Boolean);
protected
function CanTab: boolean; override;
procedure DoMeasureTextPosition(var TextTop: integer;
var TextLeft: integer); virtual;
function HasMultiLine : boolean;
procedure CalcSize(var AWidth, AHeight: integer);
procedure DoAutoSize; override;