mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-18 05:09:33 +02:00
TCustomLabel: DoDrawText for Delphi compatibility and for unifying size calculation and painting
git-svn-id: trunk@64173 -
This commit is contained in:
ondrej
parent
78a6b3d56a
commit
6133721d44
@ -54,8 +54,9 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
DC := GetDC(Parent.Handle);
|
||||
DC := GetDC(0);
|
||||
try
|
||||
Canvas.Handle := DC;
|
||||
R := Rect(0, 0, MaxWidth, cMaxLabelSize);
|
||||
OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
|
||||
Flags := DT_CALCRECT or DT_EXPANDTABS;
|
||||
@ -64,14 +65,14 @@ begin
|
||||
else
|
||||
if not HasMultiLine then
|
||||
Flags := Flags or DT_SINGLELINE;
|
||||
|
||||
if not ShowAccelChar then
|
||||
Flags := Flags or DT_NOPREFIX;
|
||||
|
||||
DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
|
||||
DoDrawText(R, Flags);
|
||||
SelectObject(DC, OldFont);
|
||||
NeededWidth := R.Right - R.Left;
|
||||
NeededHeight := R.Bottom - R.Top;
|
||||
Canvas.Handle := 0;
|
||||
//DebugLn(['TCustomLabel.CalculatePreferredSize ',DbgSName(Self),' R=',dbgs(R),' MaxWidth=',MaxWidth,' DT_WORDBREAK=',(DT_WORDBREAK and Flags)>0,' LabelText="',LabelText,'"']);
|
||||
finally
|
||||
ReleaseDC(Parent.Handle, DC);
|
||||
@ -104,6 +105,29 @@ begin
|
||||
//debugln('TCustomLabel.DoAutoSize ',DbgSName(Self),' AutoSizing=',dbgs(AutoSizing),' AutoSize=',dbgs(AutoSize),' Parent=',DbgSName(Parent),' csLoading=',dbgs(csLoading in ComponentState),' Parnet.HandleAllocated=',dbgs((Parent<>nil) and (Parent.HandleAllocated)));
|
||||
end;
|
||||
|
||||
procedure TCustomLabel.DoDrawText(var Rect: TRect; Flags: Longint);
|
||||
var
|
||||
LabelText: string;
|
||||
OldFontColor: TColor;
|
||||
Rect2: TRect;
|
||||
begin
|
||||
LabelText := GetLabelText;
|
||||
OldFontColor := Font.Color;
|
||||
if not IsEnabled and (Flags and DT_CALCRECT = 0) then
|
||||
if ThemeServices.ThemesEnabled then
|
||||
Font.Color := clGrayText
|
||||
else
|
||||
begin
|
||||
Font.Color := clBtnHighlight;
|
||||
Rect2 := Rect;
|
||||
OffsetRect(Rect2, 1, 1);
|
||||
DrawText(Canvas.Handle, PChar(LabelText), Length(LabelText), Rect2, Flags);
|
||||
Font.Color := clBtnShadow;
|
||||
end;
|
||||
DrawText(Canvas.Handle, PChar(LabelText), Length(LabelText), Rect, Flags);
|
||||
Font.Color := OldFontColor;
|
||||
end;
|
||||
|
||||
procedure TCustomLabel.SetAlignment(Value : TAlignment);
|
||||
begin
|
||||
//debugln('TCustomLabel.SetAlignment Old=',dbgs(ord(Alignment)),' New=',dbgs(ord(Value)),' csLoading=',dbgs(csLoading in ComponentState));
|
||||
@ -179,26 +203,6 @@ 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
|
||||
CalculateSize(Width, 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);
|
||||
@ -417,77 +421,45 @@ end;
|
||||
|
||||
procedure TCustomLabel.Paint;
|
||||
var
|
||||
TR : TTextStyle;
|
||||
R : TRect;
|
||||
R, CalcRect: TRect;
|
||||
TextLeft, TextTop: integer;
|
||||
LabelText: string;
|
||||
OldFontColor: TColor;
|
||||
Flags: Longint;
|
||||
const
|
||||
cAlignment: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
||||
begin
|
||||
R := Rect(0,0,Width,Height);
|
||||
with Canvas do
|
||||
Canvas.Brush.Color := Color;
|
||||
if (Color<>clNone) and not Transparent then
|
||||
begin
|
||||
Brush.Color := Self.Color;
|
||||
if (Color<>clNone) and not Transparent then
|
||||
begin
|
||||
Brush.Style:=bsSolid;
|
||||
FillRect(R);
|
||||
end;
|
||||
Brush.Style:=bsClear;
|
||||
Font := Self.Font;
|
||||
{
|
||||
If BorderStyle <> sbsNone then begin
|
||||
InflateRect(R,-2,-2);
|
||||
Pen.Style := psSolid;
|
||||
If BorderStyle = sbsSunken then
|
||||
Pen.Color := clBtnShadow
|
||||
else
|
||||
Pen.Color := clBtnHighlight;
|
||||
MoveTo(0, 0);
|
||||
LineTo(Width - 1,0);
|
||||
MoveTo(0, 0);
|
||||
LineTo(0,Height - 1);
|
||||
If BorderStyle = sbsSunken then
|
||||
Pen.Color := clBtnHighlight
|
||||
else
|
||||
Pen.Color := clBtnShadow;
|
||||
MoveTo(0,Height - 1);
|
||||
LineTo(Width - 1,Height - 1);
|
||||
MoveTo(Width - 1, 0);
|
||||
LineTo(Width - 1,Height);
|
||||
end;
|
||||
}
|
||||
//Brush.Color:=clRed;
|
||||
//FillRect(R);
|
||||
FillChar(TR,SizeOf(TR),0);
|
||||
with TR do
|
||||
begin
|
||||
Alignment := BidiFlipAlignment(Self.Alignment, UseRightToLeftAlignment);
|
||||
Layout := Self.Layout;
|
||||
Opaque := (Color<>clNone) and not Transparent;
|
||||
WordBreak := wordWrap;
|
||||
SingleLine:= not WordWrap and not HasMultiLine;
|
||||
Clipping := True;
|
||||
ShowPrefix := ShowAccelChar;
|
||||
SystemFont := False;
|
||||
RightToLeft := UseRightToLeftReading;
|
||||
ExpandTabs := True;
|
||||
end;
|
||||
DoMeasureTextPosition(TextTop, TextLeft);
|
||||
//debugln('TCustomLabel.Paint ',dbgs(Alignment=tacenter),' ',dbgs(Layout=tlCenter),' ',dbgs(TextLeft),' TextTop=',dbgs(TextTop),' ',dbgs(R));
|
||||
LabelText := GetLabelText;
|
||||
OldFontColor := Font.Color;
|
||||
if not IsEnabled then
|
||||
if ThemeServices.ThemesEnabled then
|
||||
Font.Color := clGrayText
|
||||
else
|
||||
begin
|
||||
Font.Color := clBtnHighlight;
|
||||
TextRect(R, TextLeft + 1, TextTop + 1, LabelText, TR);
|
||||
Font.Color := clBtnShadow;
|
||||
end;
|
||||
TextRect(R, TextLeft, TextTop, LabelText, TR);
|
||||
Font.Color := OldFontColor;
|
||||
Canvas.Brush.Style:=bsSolid;
|
||||
Canvas.FillRect(R);
|
||||
end;
|
||||
Canvas.Brush.Style:=bsClear;
|
||||
Canvas.Font := Font;
|
||||
|
||||
Flags := DT_EXPANDTABS;
|
||||
if WordWrap then
|
||||
Flags := Flags or DT_WORDBREAK
|
||||
else
|
||||
if not HasMultiLine then
|
||||
Flags := Flags or DT_SINGLELINE;
|
||||
if not ShowAccelChar then
|
||||
Flags := Flags or DT_NOPREFIX;
|
||||
Flags := Flags or cAlignment[BidiFlipAlignment(Self.Alignment, UseRightToLeftAlignment)];
|
||||
|
||||
if FLayout<>tlTop then
|
||||
begin
|
||||
CalcRect := R;
|
||||
DoDrawText(CalcRect, Flags or DT_CALCRECT);
|
||||
case FLayout of
|
||||
tlTop: ; // nothing
|
||||
tlCenter: OffsetRect(R, 0, (R.Height-CalcRect.Height) div 2);
|
||||
tlBottom: OffsetRect(R, 0, R.Height-CalcRect.Height)
|
||||
end;
|
||||
R.Height := CalcRect.Height;
|
||||
end;
|
||||
//debugln('TCustomLabel.Paint ',dbgs(Alignment=tacenter),' ',dbgs(Layout=tlCenter),' ',dbgs(TextLeft),' TextTop=',dbgs(TextTop),' ',dbgs(R));
|
||||
DoDrawText(R, Flags);
|
||||
end;
|
||||
|
||||
procedure TCustomLabel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
|
||||
|
||||
@ -1555,8 +1555,7 @@ type
|
||||
protected
|
||||
class procedure WSRegisterClass; override;
|
||||
function CanTab: boolean; override;
|
||||
procedure DoMeasureTextPosition(var TextTop: integer;
|
||||
var TextLeft: integer); virtual;
|
||||
procedure DoDrawText(var Rect: TRect; Flags: Longint); virtual;
|
||||
function HasMultiLine : boolean;
|
||||
procedure CalculatePreferredSize(
|
||||
var PreferredWidth, PreferredHeight: integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user