improved TLabel autosizing

git-svn-id: trunk@6627 -

designer/anchoreditor.pas

@@ -329,6 +329,7 @@ begin
 
     if (Values=nil) then begin
       Caption:='Anchor Editor - no control selected';
+      BorderSpaceGroupBox.Enabled:=false;
       TopGroupBox.Enabled:=false;
       LeftGroupBox.Enabled:=false;
       RightGroupBox.Enabled:=false;
@@ -337,6 +338,7 @@ begin
       Caption:='Anchors of selected controls';
 
       // all
+      BorderSpaceGroupBox.Enabled:=true;
       if Values.AmbigiousBorderspaceAround then
         AroundBorderSpaceSpinEdit.Value:=-1
       else

lcl/controls.pp

@@ -1402,7 +1402,7 @@ type
     FBrush: TBrush;
     FAdjustClientRectRealized: TRect;
     FChildSizing: TControlChildSizing;
-    FControls: TList;
+    FControls: TList; // the child controls (only TControl, no TWinControl)
     FDefWndProc: Pointer;
     FDockClients: TList;
     //FDockSite: Boolean;
@@ -1435,7 +1435,7 @@ type
     FTabStop: Boolean;
     FTabList: TList;
     FUseDockManager: Boolean;
-    FWinControls: TList;
+    FWinControls: TList; // the child controls (only TWinControl, no TControl)
     procedure AlignControl(AControl: TControl);
     function GetBrush: TBrush;
     function GetControl(const Index: Integer): TControl;
@@ -2820,6 +2820,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.268  2005/01/17 16:42:35  mattias
+  improved TLabel autosizing
+
   Revision 1.267  2005/01/17 11:53:39  mattias
   added showing all four sides to AnchorEditor
 

lcl/include/customlabel.inc

@@ -29,21 +29,27 @@ Procedure TCustomLabel.DoAutoSize;
 var
   R : TRect;
   DC : hDC;
+  Flags: Cardinal;
+  OldFont: HGDIOBJ;
 begin
+  //debugln('TCustomLabel.DoAutoSize ',DbgSName(Self),' AutoSizing=',dbgs(AutoSizing),' AutoSize=',dbgs(AutoSize),' Parent=',DbgSName(Parent),' Parent.HandleAllocated=',dbgs(Parent.HandleAllocated),' csLoading=',dbgs(csLoading in ComponentState));
   If AutoSizing or not AutoSize then
     Exit;
-  if (Parent = nil) or (not Parent.HandleAllocated) or ([csLoading,csDestroying]*ComponentState<>[]) then
+  if (Parent = nil) or (not Parent.HandleAllocated)
+  or ([csLoading,csDestroying]*ComponentState<>[]) then
     exit;
   AutoSizing := True;
   DC := GetDC(Parent.Handle);
   Try
     R := Rect(0,0, Width, Height);
-    SelectObject(DC, Font.Handle);
+    OldFont:=SelectObject(DC, Font.Handle);
-    DrawText(DC, PChar(Caption), Length(Caption), R,
+    Flags:=DT_CalcRect or DT_NoPrefix;
-      DT_CalcRect or DT_NoPrefix or DT_WordBreak);
+    if WordWrap then inc(Flags,DT_WordBreak);
+    DrawText(DC, PChar(Caption), Length(Caption), R, Flags);
+    SelectObject(DC, OldFont);
+    //debugln('TCustomLabel.DoAutoSize R=',dbgs(R));
 
-    Width := R.Right - R.Left;
+    SetBounds(Left,Top,R.Right - R.Left,R.Bottom - R.Top);
-    Height := R.Bottom - R.Top;
   Finally
     ReleaseDC(Parent.Handle, DC);
     AutoSizing := False;
@@ -146,6 +152,12 @@ begin
   end;
 end;
 
+procedure TCustomLabel.Loaded;
+begin
+  inherited Loaded;
+  DoAutoSize;
+end;
+
 Procedure TCustomLabel.Paint;
 var
   TR : TTextStyle;
@@ -179,6 +191,8 @@ begin
       LineTo(Width - 1,Height);
     end;
 }
+    //Brush.Color:=clRed;
+    //FillRect(R);
     FillChar(TR,SizeOf(TR),0);
     With TR do begin
       Alignment := Self.Alignment;
@@ -202,6 +216,9 @@ end;
 
 {
   $Log$
+  Revision 1.22  2005/01/17 16:42:35  mattias
+  improved TLabel autosizing
+
   Revision 1.21  2005/01/08 22:13:21  vincents
   TLabel.ShowAccelChar default value is True
 

lcl/include/wincontrol.inc

@@ -3557,6 +3557,7 @@ procedure TWinControl.CreateWnd;
 var
   Params: TCreateParams;
   n: Integer;
+  i: Integer;
 
 {  procedure WriteClientRect(const Prefix: string);
   var r: TRect;
@@ -3619,6 +3620,9 @@ begin
   // size this control
   {$IFDEF EnablePreferredSize}
   AdjustSize;
+  if FControls<>nil then
+    for i:=0 to FControls.Count-1 do
+      TControl(FControls[i]).DoAutoSize;
   {$ENDIF}
   // realign childs
   ReAlign;
@@ -4299,6 +4303,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.299  2005/01/17 16:42:35  mattias
+  improved TLabel autosizing
+
   Revision 1.298  2005/01/16 11:40:10  mattias
   fixed TGtkWidgetSet.ExtSelectClipRGN for DCOrigin
 

lcl/interfaces/gtk/gtkwinapi.inc

@@ -2700,7 +2700,8 @@ end;
   Returns: If the string was drawn, or CalcRect run
 
  ------------------------------------------------------------------------------}
-function TGtkWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Flags: Cardinal): Integer;
+function TGtkWidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
+  var Rect: TRect; Flags: Cardinal): Integer;
 var
   TM : TTextmetric;
   theRect     : TRect;
@@ -2748,6 +2749,7 @@ var
     MaxLength := theRect.Right - theRect.Left;
 
     If (Flags and DT_SingleLine) = DT_SingleLine then begin
+      // ignore word and line breaks
       GetTextExtentPoint(DC, Str, Count, AP);
       theRect.Right := theRect.Left + Min(MaxLength, AP.cX);
       theRect.Bottom := theRect.Top + TM.tmHeight;
@@ -2761,24 +2763,28 @@ var
         end;
     end
     else begin
-      If (Flags and DT_WordBreak) <> DT_WordBreak then
+      // consider line breaks
-        MaxLength := Count*TM.tmMaxCharWidth;
+      If (Flags and DT_WordBreak) <> DT_WordBreak then begin
+        // do not break at word boundaries
+        GetTextExtentPoint(DC, Str, Count, AP);
+        MaxLength := AP.cX;
+      end;
       Self.WordWrap(DC, Str, MaxLength, Lines, NumLines);
 
-      If (Lines = nil) or (NumLines = 0) then
-        exit;
-
       LineWidth := 0;
 
-      For J := 0 to NumLines - 1 do begin
+      If (Lines <> nil) then begin
-        GetTextExtentPoint(DC, Lines[J], StrLen(Lines[J]), AP);
+        For J := 0 to NumLines - 1 do begin
-        LineWidth := Max(LineWidth, AP.cX);
+          GetTextExtentPoint(DC, Lines[J], StrLen(Lines[J]), AP);
+          LineWidth := Max(LineWidth, AP.cX);
+        end;
       end;
 
       LineWidth := Min(MaxLength, LineWidth);
 
       theRect.Right := theRect.Left + LineWidth;
       theRect.Bottom := theRect.Top + NumLines*TM.tmHeight;
+      //debugln('TGtkWidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
     end;
 
     If not CalcRect then
@@ -2876,8 +2882,13 @@ begin
 
       DoCalcRect;
 
-      If (Flags and DT_CalcRect) <> DT_CalcRect then begin
+      If (Flags and DT_CalcRect) = DT_CalcRect then begin
+        CopyRect(Rect, theRect);
+        Result := 1;
+        exit;
+      end else begin
         TempDC := SaveDC(DC);
+      end;
 
       If (Flags and DT_NOCLIP) <> DT_NOCLIP then begin
         If theRect.Right > Rect.Right then
@@ -2892,25 +2903,19 @@ begin
         DrawLine(Str, Count, theRect.Top);
         Result := 1;
       end
-      else
+      else If (Lines <> nil) and (NumLines <> 0) then begin
-        If (Lines <> nil) and (NumLines <> 0) then begin
+        For I := 0 to NumLines - 1 do begin
-          For I := 0 to NumLines - 1 do begin
+          If (((Flags and DT_EditControl) = DT_EditControl) and
-            If (((Flags and DT_EditControl) = DT_EditControl) and
+            (tm.tmHeight > (theRect.Bottom - theRect.Top))) or
-              (tm.tmHeight > (theRect.Bottom - theRect.Top))) or
+            (theRect.Top > theRect.Bottom)
-              (theRect.Top > theRect.Bottom)
+          then
-            then
+            break;
-              break;
 
-            If Lines[I] <> nil then
+          If Lines[I] <> nil then
-              DrawLine(Lines[I], StrLen(Lines[I]), theRect.Top);
+            DrawLine(Lines[I], StrLen(Lines[I]), theRect.Top);
 
-            Inc(theRect.Top, TM.tmHeight);
+          Inc(theRect.Top, TM.tmHeight);
-          end;
-          Result := 1;
         end;
-      end
-      else begin
-        CopyRect(Rect, theRect);
         Result := 1;
       end;
 
@@ -8852,6 +8857,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.387  2005/01/17 16:42:35  mattias
+  improved TLabel autosizing
+
   Revision 1.386  2005/01/17 15:36:31  mattias
   improved gtk intf to calculate TextHeight
 

lcl/stdctrls.pp

@@ -1099,6 +1099,7 @@ type
     procedure SetLayout(Value: TTextLayout);
     procedure SetShowAccelChar(Value: Boolean);
     procedure SetWordWrap(Value: Boolean);
+    procedure Loaded; override;
 
     property Alignment: TAlignment read GetAlignment write SetAlignment;
     property FocusControl: TWinControl read FFocusControl write SetFocusControl;
@@ -1212,6 +1213,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.184  2005/01/17 16:42:35  mattias
+  improved TLabel autosizing
+
   Revision 1.183  2005/01/11 21:36:36  micha
   remove TStaticText.Layout property, not supported by delphi, hard to implement