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:
parent
92e097ff63
commit
d2bc4123dc
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user