Files
MycLib/Src/AST/Myc.Fmx.AstEditor.Layout.pas
2025-11-30 16:00:00 +01:00

281 lines
8.8 KiB
ObjectPascal

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<TControl>;
begin
relevantChildren := TList<TControl>.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<TControl>;
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<TControl>.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.