unit Myc.Fmx.AstEditor.Render; interface uses System.Types, System.UITypes, System.Classes, System.SysUtils, System.Math, System.Generics.Collections, FMX.Types, FMX.Graphics, FMX.TextLayout; type TVisualNode = class; // Interface for the host (e.g. TWorkspace) to request repaints/layouts IVisualHost = interface ['{A9E2BD60-281B-42A2-9DB5-3100E8EF1519}'] procedure InvalidateRect(const R: TRectF); procedure RequestLayout; function GetCanvas: TCanvas; end; // Helper structure for margins and padding TMarginRect = record Left, Top, Right, Bottom: Single; function Width: Single; inline; function Height: Single; inline; class function Create(L, T, R, B: Single): TMarginRect; static; inline; class operator Initialize(out Dest: TMarginRect); end; // The base class for all virtual UI elements (Flyweight) TVisualNode = class private FHost: IVisualHost; FParent: TVisualNode; FChildren: TList; // Data stored as Position and Size (Layout Model) // Direct field access is preferred within the unit FPosition: TPointF; FSize: TSizeF; FPadding: TMarginRect; FMargins: TMarginRect; FVisible: Boolean; FHitTest: Boolean; FTag: NativeInt; FOpacity: Single; procedure SetParent(const Value: TVisualNode); protected procedure SetHost(const Value: IVisualHost); virtual; // Called to paint the node-specific content (background, etc.) procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); virtual; public constructor Create(AHost: IVisualHost = nil); virtual; destructor Destroy; override; // Layout system procedure RequestLayout; procedure RecalcLayout; virtual; // Geometry function GetAbsolutePosition: TPointF; function LocalToAbsolute(const P: TPointF): TPointF; function AbsoluteToLocal(const P: TPointF): TPointF; function AbsoluteRect: TRectF; function HitTest(const P: TPointF): TVisualNode; virtual; // Rendering pipeline // Offset is the absolute position of the parent content area procedure Paint(Canvas: TCanvas; const Offset: TPointF); // Child Management procedure AddChild(Child: TVisualNode); procedure RemoveChild(Child: TVisualNode); procedure DeleteChildren; function GetChildCount: Integer; inline; function GetChild(Index: Integer): TVisualNode; inline; // Interaction stubs (called by the host) procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); virtual; procedure MouseMove(Shift: TShiftState; X, Y: Single); virtual; procedure MouseEnter; virtual; procedure MouseLeave; virtual; property Host: IVisualHost read FHost; property Parent: TVisualNode read FParent; // Direct field access via properties property Position: TPointF read FPosition write FPosition; property Size: TSizeF read FSize write FSize; property Padding: TMarginRect read FPadding write FPadding; property Margins: TMarginRect read FMargins write FMargins; property Visible: Boolean read FVisible write FVisible; property HitTestEnabled: Boolean read FHitTest write FHitTest; property Opacity: Single read FOpacity write FOpacity; property Tag: NativeInt read FTag write FTag; end; // Lightweight replacement for TLabel TTextNode = class(TVisualNode) private FText: string; FLayout: TTextLayout; FFontSettings: TTextSettings; // Stores font properties FColor: TAlphaColor; FIsLayoutDirty: Boolean; procedure SetText(const Value: string); procedure SetColor(const Value: TAlphaColor); protected procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override; procedure UpdateTextLayout(Canvas: TCanvas); public constructor Create(AHost: IVisualHost = nil); override; destructor Destroy; override; procedure RecalcLayout; override; property Text: string read FText write SetText; property Color: TAlphaColor read FColor write SetColor; property FontSettings: TTextSettings read FFontSettings; end; TLayoutOrientation = (loVertical, loHorizontal); TLayoutAlignment = (laCenter, laFlush); // The Layout Manager TAutoFitLayout = class(TVisualNode) private FOrientation: TLayoutOrientation; FAlignment: TLayoutAlignment; procedure SetOrientation(const Value: TLayoutOrientation); procedure SetAlignment(const Value: TLayoutAlignment); protected // TAutoFitLayout is a container, draws no background by default, but propagates Paint to children procedure DoPaint(Canvas: TCanvas; const Offset: TPointF); override; public constructor Create(AHost: IVisualHost = nil); override; procedure RecalcLayout; override; // Calculates the insertion index for drag & drop based on coordinates function GetInsertionIndex(const LocalP: TPointF): Integer; property Orientation: TLayoutOrientation read FOrientation write SetOrientation; property Alignment: TLayoutAlignment read FAlignment write SetAlignment; end; implementation { TMarginRect } class function TMarginRect.Create(L, T, R, B: Single): TMarginRect; begin Result.Left := L; Result.Top := T; Result.Right := R; Result.Bottom := B; end; class operator TMarginRect.Initialize(out Dest: TMarginRect); begin Dest.Left := 0; Dest.Top := 0; Dest.Right := 0; Dest.Bottom := 0; end; function TMarginRect.Height: Single; begin Result := Top + Bottom; end; function TMarginRect.Width: Single; begin Result := Left + Right; end; { TVisualNode } constructor TVisualNode.Create(AHost: IVisualHost); begin inherited Create; FHost := AHost; FChildren := TList.Create; FVisible := True; FHitTest := True; FOpacity := 1.0; FPosition := TPointF.Create(0, 0); FSize := TSizeF.Create(10, 10); end; destructor TVisualNode.Destroy; begin // Recursive release for var i := 0 to FChildren.Count - 1 do FChildren[i].Free; FChildren.Free; inherited; end; procedure TVisualNode.SetParent(const Value: TVisualNode); begin if FParent <> Value then begin FParent := Value; // Propagate host if parent has one if (FHost = nil) and Assigned(FParent) then SetHost(FParent.Host); end; end; procedure TVisualNode.SetHost(const Value: IVisualHost); begin FHost := Value; for var Child in FChildren do Child.SetHost(Value); end; procedure TVisualNode.AddChild(Child: TVisualNode); begin Assert(Child <> nil); if Child.Parent <> nil then Child.Parent.RemoveChild(Child); FChildren.Add(Child); Child.SetParent(Self); RequestLayout; end; procedure TVisualNode.RemoveChild(Child: TVisualNode); begin FChildren.Remove(Child); Child.FParent := nil; RequestLayout; end; procedure TVisualNode.DeleteChildren; begin for var i := 0 to FChildren.Count - 1 do FChildren[i].Free; FChildren.Clear; RequestLayout; end; function TVisualNode.GetChild(Index: Integer): TVisualNode; begin Result := FChildren[Index]; end; function TVisualNode.GetChildCount: Integer; begin Result := FChildren.Count; end; procedure TVisualNode.RequestLayout; begin if Assigned(FParent) then FParent.RequestLayout else if Assigned(FHost) then FHost.RequestLayout; end; procedure TVisualNode.RecalcLayout; begin // Base implementation: Does nothing. // Subclasses (Layouts) must implement calculation here. end; function TVisualNode.GetAbsolutePosition: TPointF; var Curr: TVisualNode; begin Result := FPosition; Curr := FParent; while Assigned(Curr) do begin // Add parent position + padding (since we are in the content area) Result := Result + Curr.FPosition + TPointF.Create(Curr.Padding.Left, Curr.Padding.Top); Curr := Curr.Parent; end; end; function TVisualNode.LocalToAbsolute(const P: TPointF): TPointF; begin Result := GetAbsolutePosition + P; end; function TVisualNode.AbsoluteToLocal(const P: TPointF): TPointF; begin Result := P - GetAbsolutePosition; end; function TVisualNode.AbsoluteRect: TRectF; begin Result := TRectF.Create(GetAbsolutePosition, FSize.Width, FSize.Height); end; procedure TVisualNode.Paint(Canvas: TCanvas; const Offset: TPointF); var AbsPos: TPointF; ChildOffset: TPointF; Child: TVisualNode; begin if not FVisible then exit; // Absolute position of this node AbsPos := Offset + FPosition; // 1. Background / Own content DoPaint(Canvas, AbsPos); // 2. Draw children if FChildren.Count > 0 then begin // The 0,0 point for children is shifted by padding ChildOffset := AbsPos + TPointF.Create(FPadding.Left, FPadding.Top); for Child in FChildren do Child.Paint(Canvas, ChildOffset); end; end; procedure TVisualNode.DoPaint(Canvas: TCanvas; const Offset: TPointF); begin // Stub end; function TVisualNode.HitTest(const P: TPointF): TVisualNode; var i: Integer; Child: TVisualNode; LocalP: TPointF; ContentOrigin: TPointF; begin Result := nil; if not FVisible or not FHitTest then exit; // P is relative to Position of this node. Check if P is inside rect. if not TRectF.Create(0, 0, FSize.Width, FSize.Height).Contains(P) then exit; ContentOrigin := TPointF.Create(FPadding.Left, FPadding.Top); // Check children in reverse Z-order (topmost first) for i := FChildren.Count - 1 downto 0 do begin Child := FChildren[i]; // Transformation into child coordinates LocalP := P - ContentOrigin - Child.FPosition; Result := Child.HitTest(LocalP); if Result <> nil then exit; end; // If no child hit, it's us Result := Self; end; procedure TVisualNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin end; procedure TVisualNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin end; procedure TVisualNode.MouseMove(Shift: TShiftState; X, Y: Single); begin end; procedure TVisualNode.MouseEnter; begin end; procedure TVisualNode.MouseLeave; begin end; { TTextNode } constructor TTextNode.Create(AHost: IVisualHost); begin inherited; FHitTest := False; // Text is usually passive FIsLayoutDirty := True; FFontSettings := TTextSettings.Create(nil); FColor := TAlphaColors.Black; end; destructor TTextNode.Destroy; begin FreeAndNil(FLayout); FreeAndNil(FFontSettings); inherited; end; procedure TTextNode.SetText(const Value: string); begin if FText <> Value then begin FText := Value; FIsLayoutDirty := True; RequestLayout; end; end; procedure TTextNode.SetColor(const Value: TAlphaColor); begin if FColor <> Value then begin FColor := Value; if Assigned(FHost) then FHost.InvalidateRect(AbsoluteRect); end; end; procedure TTextNode.UpdateTextLayout(Canvas: TCanvas); begin if FIsLayoutDirty or (FLayout = nil) then begin if FLayout = nil then FLayout := TTextLayoutManager.DefaultTextLayout.Create(Canvas); FLayout.BeginUpdate; try FLayout.Text := FText; FLayout.Font.Assign(FFontSettings.Font); FLayout.Color := FColor; FLayout.WordWrap := False; finally FLayout.EndUpdate; end; FIsLayoutDirty := False; end; end; procedure TTextNode.RecalcLayout; begin if Assigned(FHost) then begin UpdateTextLayout(FHost.GetCanvas); FSize.Width := FLayout.TextRect.Width + FPadding.Width; FSize.Height := FLayout.TextRect.Height + FPadding.Height; // Safety net for empty strings if FSize.Width < 1 then FSize.Width := 5; if FSize.Height < 1 then FSize.Height := 10; end; end; procedure TTextNode.DoPaint(Canvas: TCanvas; const Offset: TPointF); begin UpdateTextLayout(Canvas); var P := Offset + TPointF.Create(FPadding.Left, FPadding.Top); // Set position and color on layout, then render FLayout.TopLeft := P; FLayout.Color := FColor; FLayout.RenderLayout(Canvas); end; { TAutoFitLayout } constructor TAutoFitLayout.Create(AHost: IVisualHost); begin inherited; FOrientation := loHorizontal; FAlignment := laCenter; end; procedure TAutoFitLayout.SetOrientation(const Value: TLayoutOrientation); begin if FOrientation <> Value then begin FOrientation := Value; RequestLayout; end; end; procedure TAutoFitLayout.SetAlignment(const Value: TLayoutAlignment); begin if FAlignment <> Value then begin FAlignment := Value; RequestLayout; end; end; procedure TAutoFitLayout.DoPaint(Canvas: TCanvas; const Offset: TPointF); begin // TAutoFitLayout is a container, draws no background by default. inherited DoPaint(Canvas, Offset); end; procedure TAutoFitLayout.RecalcLayout; var Child: TVisualNode; CurrentX, CurrentY: Single; ReqW, ReqH: Single; begin // 1. Recursion: Calculate children for Child in FChildren do begin if Child.Visible then Child.RecalcLayout; end; CurrentX := 0; CurrentY := 0; ReqW := 0; ReqH := 0; // 2. Stacking Logic if FOrientation = loVertical then begin for Child in FChildren do begin if not Child.Visible then continue; // Set Y-Position Child.FPosition := TPointF.Create(Child.Margins.Left, CurrentY + Child.Margins.Top); var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom; var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right; CurrentY := CurrentY + ChildTotalH; ReqW := Max(ReqW, ChildTotalW); end; ReqH := CurrentY; // 3. Alignment Logic (Cross-Axis) if FAlignment = laCenter then begin for Child in FChildren do begin if not Child.Visible then continue; var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right; var OffsetX := (ReqW - ChildTotalW) * 0.5; Child.FPosition := TPointF.Create(Child.Margins.Left + OffsetX, Child.FPosition.Y); end; end; end else // Horizontal begin for Child in FChildren do begin if not Child.Visible then continue; // Set X-Position Child.FPosition := TPointF.Create(CurrentX + Child.Margins.Left, Child.Margins.Top); var ChildTotalW := Child.Size.Width + Child.Margins.Left + Child.Margins.Right; var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom; CurrentX := CurrentX + ChildTotalW; ReqH := Max(ReqH, ChildTotalH); end; ReqW := CurrentX; // 3. Alignment Logic (Cross-Axis) if FAlignment = laCenter then begin for Child in FChildren do begin if not Child.Visible then continue; var ChildTotalH := Child.Size.Height + Child.Margins.Top + Child.Margins.Bottom; var OffsetY := (ReqH - ChildTotalH) * 0.5; Child.FPosition := TPointF.Create(Child.FPosition.X, Child.Margins.Top + OffsetY); end; end; end; // 4. Set own size FSize.Width := ReqW + FPadding.Width; FSize.Height := ReqH + FPadding.Height; end; function TAutoFitLayout.GetInsertionIndex(const LocalP: TPointF): Integer; var i: Integer; Child: TVisualNode; Center: Single; ContentP: TPointF; begin // Assumption: Append to end as default Result := FChildren.Count; // Convert coords to content area ContentP := LocalP - TPointF.Create(FPadding.Left, FPadding.Top); for i := 0 to FChildren.Count - 1 do begin Child := FChildren[i]; if not Child.Visible then continue; if FOrientation = loVertical then begin Center := Child.FPosition.Y + (Child.Size.Height * 0.5); if ContentP.Y < Center then exit(i); end else begin Center := Child.FPosition.X + (Child.Size.Width * 0.5); if ContentP.X < Center then exit(i); end; end; end; end.