Reimplement the removed procedure in Lazarus trunk

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8011 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
jujibo 2021-05-09 08:26:02 +00:00
parent 92e097ff63
commit d2bc4123dc

View File

@ -40,6 +40,8 @@ type
procedure SetShadowColor2(AValue: TColor);
protected
procedure SetShadowColor(Value: TColor);
procedure DoCalculateTextPosition(var TextTop: integer;
var TextLeft: integer); virtual;
property ShadowColor: TColor read FShadowColor write SetShadowColor;
property ShadowColor2: TColor read FShadowColor2 write SetShadowColor2;
property LabelStyle: TLabelStyle read FLabelStyle write SetLabelStyle;
@ -206,6 +208,26 @@ begin
end;
end;
procedure TJCustomLabel.DoCalculateTextPosition(var TextTop: integer;
var TextLeft: integer);
var
lTextHeight: integer;
lTextWidth: integer;
begin
TextLeft := 0;
if Layout = tlTop then
begin
TextTop := 0;
end else
begin
CalculateSize(Width, lTextWidth, lTextHeight);
case Layout of
tlCenter: TextTop := (Height - lTextHeight) div 2;
tlBottom: TextTop := Height - lTextHeight;
end;
end;
end;
procedure TJCustomLabel.Paint;
var
TR: TTextStyle;
@ -244,7 +266,7 @@ begin
RightToLeft := UseRightToLeftReading;
ExpandTabs := True;
end;
DoMeasureTextPosition(TextTop, TextLeft);
DoCalculateTextPosition(TextTop, TextLeft);
//debugln('TCustomLabel.Paint ',dbgs(Alignment=tacenter),' ',dbgs(Layout=tlCenter),' ',dbgs(TextLeft),' TextTop=',dbgs(TextTop),' ',dbgs(R));
LabelText := GetLabelText;
OldFontColor := Font.Color;