unit Myc.Fmx.AstEditor.Layout; interface uses System.SysUtils, System.Classes, System.Types, System.Math, System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls; type TLayoutOrientation = (loVertical, loHorizontal); TLayoutAlignment = (laCenter, laFlush); TAutoFitControl = class(TControl) private FUpdatingOwnSize: Boolean; FNeedRecalcSize: Boolean; FOrientation: TLayoutOrientation; FAlignment: TLayoutAlignment; procedure RecalcOwnSize; procedure SetOrientation(const Value: TLayoutOrientation); procedure SetAlignment(const Value: TLayoutAlignment); protected procedure ParentContentChanged; override; procedure PaddingChanged; override; procedure ChangeChildren; override; procedure Loaded; override; procedure DoEndUpdate; override; public constructor Create(AOwner: TComponent); override; function GetInsertionIndex(const P: TPointF; ItemClass: TClass = nil): Integer; published property Padding; property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal; property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter; end; implementation { TAutoFitControl } constructor TAutoFitControl.Create(AOwner: TComponent); begin inherited Create(AOwner); HitTest := True; FOrientation := TLayoutOrientation.loHorizontal; FAlignment := TLayoutAlignment.laCenter; end; procedure TAutoFitControl.SetAlignment(const Value: TLayoutAlignment); begin if FAlignment <> Value then begin FAlignment := Value; RecalcOwnSize; end; end; procedure TAutoFitControl.SetOrientation(const Value: TLayoutOrientation); begin if FOrientation <> Value then begin FOrientation := Value; RecalcOwnSize; end; end; function TAutoFitControl.GetInsertionIndex(const P: TPointF; ItemClass: TClass = nil): Integer; var i: Integer; child: TControl; center: Single; relevantChildren: TList; begin relevantChildren := TList.Create; try for i := 0 to ChildrenCount - 1 do begin if Children[i] is TControl then begin child := TControl(Children[i]); if child.Visible and (child.Align = TAlignLayout.None) then begin if (ItemClass = nil) or (child.InheritsFrom(ItemClass)) then relevantChildren.Add(child); end; end; end; Result := relevantChildren.Count; for i := 0 to relevantChildren.Count - 1 do begin child := relevantChildren[i]; if FOrientation = TLayoutOrientation.loVertical then begin // Fix: Robustere Erkennung. Wenn P.Y kleiner als Mitte ist -> Insert center := child.Position.Y + (child.Height / 2); if P.Y < center then Exit(i); end else begin center := child.Position.X + (child.Width / 2); if P.X < center then Exit(i); end; end; finally relevantChildren.Free; end; end; procedure TAutoFitControl.RecalcOwnSize; var i: Integer; child: TControl; childrenToLayout: TList; currentX, currentY: Single; requiredWidth, requiredHeight: Single; childWidthWithMargins, childHeightWithMargins: Single; hasVisibleChild: Boolean; begin if FUpdatingOwnSize then exit; if IsUpdating then begin FNeedRecalcSize := True; exit; end; FUpdatingOwnSize := True; childrenToLayout := nil; try requiredWidth := Padding.Left + Padding.Right; requiredHeight := Padding.Top + Padding.Bottom; currentX := Padding.Left; currentY := Padding.Top; hasVisibleChild := False; childrenToLayout := TList.Create; for i := 0 to ChildrenCount - 1 do begin if Children[i] is TControl then begin child := TControl(Children[i]); if child.Visible and (child.Align = TAlignLayout.None) then begin childrenToLayout.Add(child); hasVisibleChild := True; end; end; end; if hasVisibleChild then begin if FOrientation = TLayoutOrientation.loVertical then begin for child in childrenToLayout do begin child.Position.Y := currentY + child.Margins.Top; currentY := child.Position.Y + child.Height + child.Margins.Bottom; childWidthWithMargins := Padding.Left + child.Margins.Left + child.Width + child.Margins.Right + Padding.Right; requiredWidth := System.Math.Max(requiredWidth, childWidthWithMargins); end; requiredHeight := currentY + Padding.Bottom; if FAlignment = TLayoutAlignment.laFlush then begin for child in childrenToLayout do begin child.Position.X := Padding.Left + child.Margins.Left; end; end else begin var contentWidth := requiredWidth - Padding.Left - Padding.Right; for child in childrenToLayout do begin var childTotalWidth := child.Width + child.Margins.Left + child.Margins.Right; var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + child.Margins.Left; child.Position.X := childX; end; end; end else begin for child in childrenToLayout do begin child.Position.X := currentX + child.Margins.Left; currentX := child.Position.X + child.Width + child.Margins.Right; childHeightWithMargins := Padding.Top + child.Margins.Top + child.Height + child.Margins.Bottom + Padding.Bottom; requiredHeight := System.Math.Max(requiredHeight, childHeightWithMargins); end; requiredWidth := currentX + Padding.Right; if FAlignment = TLayoutAlignment.laFlush then begin for child in childrenToLayout do begin child.Position.Y := Padding.Top + child.Margins.Top; end; end else begin var contentHeight := requiredHeight - Padding.Top - Padding.Bottom; for child in childrenToLayout do begin var childTotalHeight := child.Height + child.Margins.Top + child.Margins.Bottom; var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + child.Margins.Top; child.Position.Y := childY; end; end; end; end else begin requiredWidth := Padding.Left + Padding.Right; requiredHeight := Padding.Top + Padding.Bottom; end; requiredWidth := System.Math.Max(0, requiredWidth); requiredHeight := System.Math.Max(0, requiredHeight); if not SameValue(requiredWidth, Width, TEpsilon.Position) or not SameValue(requiredHeight, Height, TEpsilon.Position) then begin FSize.SetSizeWithoutNotification(TSizeF.Create(requiredWidth, requiredHeight)); HandleSizeChanged; end; finally childrenToLayout.Free; FUpdatingOwnSize := False; end; end; procedure TAutoFitControl.Loaded; begin inherited Loaded; RecalcOwnSize; end; procedure TAutoFitControl.ChangeChildren; begin inherited ChangeChildren; RecalcOwnSize; end; procedure TAutoFitControl.PaddingChanged; begin inherited PaddingChanged; RecalcOwnSize; end; procedure TAutoFitControl.ParentContentChanged; begin inherited ParentContentChanged; RecalcOwnSize; end; procedure TAutoFitControl.DoEndUpdate; begin inherited; if FNeedRecalcSize then begin FNeedRecalcSize := False; RecalcOwnSize; end; end; end.