Visual AST editing with drag'n'drop 1s Version
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,280 @@
|
||||
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.
|
||||
Reference in New Issue
Block a user