From 783001dd2da86af339fd539f09737f0fdc59ab56 Mon Sep 17 00:00:00 2001 From: paul Date: Sun, 30 Aug 2009 17:22:56 +0000 Subject: [PATCH] lcl: allow resize of label width if both AutoSize and WordWrap are true, better handle WordWrap change + formatting (fixes issue #0014362) git-svn-id: trunk@21486 - --- lcl/include/customlabel.inc | 93 +++++++++++++++++++++---------------- lcl/stdctrls.pp | 2 + 2 files changed, 55 insertions(+), 40 deletions(-) diff --git a/lcl/include/customlabel.inc b/lcl/include/customlabel.inc index 8bedc7a1ff..c16f289d17 100644 --- a/lcl/include/customlabel.inc +++ b/lcl/include/customlabel.inc @@ -30,23 +30,23 @@ procedure TCustomLabel.CalculatePreferredSize( var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); // assumes: (Parent <> nil) and Parent.HandleAllocated var - R : TRect; - DC : hDC; + R: TRect; + DC: HDC; Flags: Cardinal; OldFont: HGDIOBJ; LabelText: string; begin - if (Parent=nil) or (not Parent.HandleAllocated) then Exit; + if (Parent = nil) or (not Parent.HandleAllocated) then Exit; DC := GetDC(Parent.Handle); try R := Rect(0, 0, Width, Height); OldFont := SelectObject(DC, HGDIOBJ(Font.Reference.Handle)); Flags := DT_CALCRECT or DT_EXPANDTABS; if WordWrap then - inc(Flags, DT_WORDBREAK) + Flags := Flags or DT_WORDBREAK else if not HasMultiLine then - inc(Flags, DT_SINGLELINE); + Flags := Flags or DT_SINGLELINE; LabelText := GetLabelText; DrawText(DC, PChar(LabelText), Length(LabelText), R, Flags); @@ -62,10 +62,7 @@ end; procedure TCustomLabel.FontChanged(Sender: TObject); begin inherited FontChanged(Sender); - InvalidatePreferredSize; - if (Parent<>nil) and Parent.AutoSize then - Parent.AdjustSize; - AdjustSize; + UpdateSize; end; class function TCustomLabel.GetControlClassDefaultSize: TPoint; @@ -79,7 +76,7 @@ var s: String; begin s := GetLabelText; - result := (pos(#10, s) > 0) or (pos(#13, s) > 0); + Result := (pos(#10, s) > 0) or (pos(#13, s) > 0); end; procedure TCustomLabel.DoAutoSize; @@ -91,21 +88,23 @@ begin if OptimalFill and (not AutoSize) then begin AdjustFontForOptimalFill; - exit; + Exit; end; if AutoSizeDelayed then - exit; + Exit; + GetPreferredSize(NewWidth, NewHeight); //debugln('TCustomLabel.DoAutoSize ',dbgsName(Self),' Nice ',dbgs(Left),',',dbgs(Top),',w=',dbgs(NewWidth),',h=',dbgs(NewHeight),' Caption="',dbgstr(Caption),'"'); - CurAnchors:=[]; - if Align in [alLeft,alRight,alBottom,alTop,alClient] then - CurAnchors:=AnchorAlign[Align]; - CurAnchors:=Anchors+CurAnchors; - if CurAnchors*[akLeft,akRight]=[akLeft,akRight] then - NewWidth:=Width; - if CurAnchors*[akTop,akBottom]=[akTop,akBottom] then - NewHeight:=Height; + CurAnchors := []; + if Align in [alLeft, alRight, alBottom, alTop, alClient] then + CurAnchors := AnchorAlign[Align]; + CurAnchors := Anchors + CurAnchors; + if (CurAnchors * [akLeft, akRight] = [akLeft, akRight]) or + (WordWrap and (NewWidth < Width)) then + NewWidth := Width; + if CurAnchors * [akTop, akBottom] = [akTop, akBottom] then + NewHeight := Height; //debugln('TCustomLabel.DoAutoSize ',dbgsName(Self),' Anchored ',dbgs(Left),',',dbgs(Top),',w=',dbgs(NewWidth),',h=',dbgs(NewHeight)); SetBoundsKeepBase(Left, Top, NewWidth, NewHeight); @@ -125,7 +124,7 @@ procedure TCustomLabel.Notification(AComponent : TComponent; Operation : TOperat begin inherited Notification(AComponent, Operation); if (AComponent = FFocusControl) and (Operation = opRemove) then - FFocusControl:= nil; + FFocusControl := nil; end; procedure TCustomLabel.SetFocusControl(Value : TWinControl); @@ -166,12 +165,7 @@ end; procedure TCustomLabel.TextChanged; begin Invalidate; - InvalidatePreferredSize; - if OptimalFill and (not AutoSize) then - AdjustFontForOptimalFill; - if (Parent<>nil) and Parent.AutoSize then - Parent.AdjustSize; - AdjustSize; + UpdateSize; end; procedure TCustomLabel.Resize; @@ -188,7 +182,7 @@ end; function TCustomLabel.CanTab: boolean; begin - Result:=false; + Result := False; end; procedure TCustomLabel.DoMeasureTextPosition(var TextTop: integer; @@ -271,9 +265,11 @@ end; ------------------------------------------------------------------------------} procedure TCustomLabel.SetWordWrap(Value: Boolean); begin - if fWordWrap <> value then begin - fWordWrap:= value; + if FWordWrap <> Value then + begin + FWordWrap := Value; Invalidate; + UpdateSize; end; end; @@ -297,6 +293,16 @@ begin AdjustSize; end; +procedure TCustomLabel.UpdateSize; +begin + InvalidatePreferredSize; + if OptimalFill and (not AutoSize) then + AdjustFontForOptimalFill; + if (Parent <> nil) and Parent.AutoSize then + Parent.AdjustSize; + AdjustSize; +end; + {------------------------------------------------------------------------------- function TCustomLabel.CalcFittingFontHeight(const TheText: string; MaxWidth, MaxHeight: Integer; @@ -387,14 +393,14 @@ var NewFontHeight: Integer; OldFontHeight: LongInt; begin - Result:=false; - if not CalcFittingFontHeight(GetLabelText,Width,Height,NewFontHeight,NeededWidth, - NeededHeight) then exit; - if Font.Height=NewFontHeight then exit; + Result := False; + if not CalcFittingFontHeight(GetLabelText, Width, Height, NewFontHeight, + NeededWidth, NeededHeight) then Exit; + if Font.Height = NewFontHeight then Exit; //debugln('TCustomLabel.AdjustFontForOptimalFill OldFontHeight=',dbgs(Font.Height),' NewFontHeight=',dbgs(NewFontHeight)); - OldFontHeight:=Font.Height; - Font.Height:=NewFontHeight; - Result:=OldFontHeight<>Font.Height; + OldFontHeight := Font.Height; + Font.Height := NewFontHeight; + Result := OldFontHeight <> Font.Height; end; procedure TCustomLabel.Paint; @@ -470,12 +476,19 @@ begin end; end; +procedure TCustomLabel.SetBounds(aLeft, aTop, aWidth, aHeight: integer); +begin + if AutoSize and WordWrap then + InvalidatePreferredSize; + inherited SetBounds(aLeft, aTop, aWidth, aHeight); +end; + procedure TCustomLabel.SetOptimalFill(const AValue: Boolean); begin - if FOptimalFill=AValue then exit; - FOptimalFill:=AValue; + if FOptimalFill = AValue then Exit; + FOptimalFill := AValue; if OptimalFill and AutoSize then - AutoSize:=false; + AutoSize := False; Invalidate; end; diff --git a/lcl/stdctrls.pp b/lcl/stdctrls.pp index ce8af63cdf..c625c2392f 100644 --- a/lcl/stdctrls.pp +++ b/lcl/stdctrls.pp @@ -1395,6 +1395,7 @@ type procedure SetTransparent(NewTransparent: boolean); procedure SetWordWrap(Value: Boolean); procedure Loaded; override; + procedure UpdateSize; property Alignment: TAlignment read GetAlignment write SetAlignment default taLeftJustify; property FocusControl: TWinControl read FFocusControl write SetFocusControl; @@ -1411,6 +1412,7 @@ type function ColorIsStored: boolean; override; function AdjustFontForOptimalFill: Boolean; procedure Paint; override; + procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override; property AutoSize default True; property Color default clNone; end;