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

LCL: TCustomLabel: fixed measuring size on wordwrap

Browse Source 
git-svn-id: trunk@24899 -
This commit is contained in:
mattias 2010-04-24 22:36:56 +00:00
parent 36e585e8a6
commit d1377d95cb
3 changed files with 28 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/helpmanager.pas
View File

@ -380,7 +380,7 @@ begin
try try
R := Rect(0, 0, 600, 200); R := Rect(0, 0, 600, 200);
OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle)); OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
Flags := DT_CalcRect; Flags := DT_CALCRECT or DT_EXPANDTABS;
inc(Flags, DT_WordBreak); inc(Flags, DT_WordBreak);
LabelText := GetLabelText; LabelText := GetLabelText;
DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags); DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);

33
lcl/include/customlabel.inc
View File

@ -30,16 +30,28 @@ procedure TCustomLabel.CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
// assumes: (Parent <> nil) and Parent.HandleAllocated // assumes: (Parent <> nil) and Parent.HandleAllocated
var var
R: TRect; AWidth: Integer;
DC: HDC;
Flags: Cardinal;
OldFont: HGDIOBJ;
LabelText: string;
begin begin
if (Parent = nil) or (not Parent.HandleAllocated) then Exit; if (Parent = nil) or (not Parent.HandleAllocated) then Exit;
if WidthIsAnchored and WordWrap and HasMultiLine then
AWidth:=Width
else
AWidth:=10000;
CalculateSize(AWidth,PreferredWidth,PreferredHeight);
end;
procedure TCustomLabel.CalculateSize(MaxWidth: integer; var NeededWidth,
NeededHeight: integer);
var
DC: HDC;
R: TRect;
OldFont: HGDIOBJ;
Flags: cardinal;
LabelText: String;
begin
DC := GetDC(Parent.Handle); DC := GetDC(Parent.Handle);
try try
R := Rect(0, 0, Width, Height); R := Rect(0, 0, MaxWidth, 10000);
OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle)); OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle));
Flags := DT_CALCRECT or DT_EXPANDTABS; Flags := DT_CALCRECT or DT_EXPANDTABS;
if WordWrap then if WordWrap then
@ -52,8 +64,9 @@ begin
DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags); DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags);
SelectObject(DC, OldFont); SelectObject(DC, OldFont);
// add one to be able to display disabled label // add one to be able to display disabled label
PreferredWidth := R.Right - R.Left + 1; NeededWidth := R.Right - R.Left + 1;
PreferredHeight := R.Bottom - R.Top + 1; NeededHeight := R.Bottom - R.Top + 1;
//DebugLn(['TCustomLabel.CalculatePreferredSize ',DbgSName(Self),' R=',dbgs(R),' MaxWidth=',MaxWidth,' DT_WORDBREAK=',(DT_WORDBREAK and Flags)>0,' LabelText="',LabelText,'"']);
finally finally
ReleaseDC(Parent.Handle, DC); ReleaseDC(Parent.Handle, DC);
end; end;
@ -209,7 +222,7 @@ begin
TextTop := 0; TextTop := 0;
end else end else
begin begin
GetPreferredSize(lTextWidth, lTextHeight, True); CalculateSize(Width, lTextWidth, lTextHeight);
case Layout of case Layout of
tlCenter: TextTop := (Height - lTextHeight) div 2; tlCenter: TextTop := (Height - lTextHeight) div 2;
tlBottom: TextTop := Height - lTextHeight; tlBottom: TextTop := Height - lTextHeight;
@ -313,8 +326,10 @@ begin
InvalidatePreferredSize; InvalidatePreferredSize;
if OptimalFill and (not AutoSize) then if OptimalFill and (not AutoSize) then
AdjustFontForOptimalFill; AdjustFontForOptimalFill;
{$IFDEF OldAutoSize}
if (Parent <> nil) and Parent.AutoSize then if (Parent <> nil) and Parent.AutoSize then
Parent.AdjustSize; Parent.AdjustSize;
{$ENDIF}
AdjustSize; AdjustSize;
end; end;

4
lcl/stdctrls.pp
View File

@ -29,7 +29,7 @@ interface
uses uses
Classes, SysUtils, LCLStrConsts, LCLType, LCLProc, LMessages, Graphics, Classes, SysUtils, types, LCLStrConsts, LCLType, LCLProc, LMessages, Graphics,
GraphType, ExtendedStrings, LCLIntf, ClipBrd, ActnList, Controls, GraphType, ExtendedStrings, LCLIntf, ClipBrd, ActnList, Controls,
TextStrings, Forms, Menus, LResources; TextStrings, Forms, Menus, LResources;
@ -1386,6 +1386,8 @@ type
procedure CalculatePreferredSize( procedure CalculatePreferredSize(
var PreferredWidth, PreferredHeight: integer; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override; WithThemeSpace: Boolean); override;
procedure CalculateSize(MaxWidth: integer;
var NeededWidth, NeededHeight: integer);
procedure DoAutoSize; override; procedure DoAutoSize; override;
function DialogChar(var Message: TLMKey): boolean; override; function DialogChar(var Message: TLMKey): boolean; override;
procedure TextChanged; override; procedure TextChanged; override;