unit Myc.Fmx.AstEditor.Workspace; interface uses System.Classes, System.SysUtils, System.Types, System.UITypes, System.Math, System.Math.Vectors, FMX.Types, FMX.Controls, FMX.Objects, FMX.Graphics, FMX.Forms, Myc.Fmx.AstEditor.Layout; type TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object; TOnDragDropEvent = procedure(ASource, ATarget: TControl; AIndex: Integer) of object; TAstWorld = class(TControl) private FOnPaintConnections: TOnPaintConnectionsEvent; // VISUAL: Drop Marker State FShowDropMarker: Boolean; FDropP1, FDropP2: TPointF; protected procedure Paint; override; procedure AfterPaint; override; public constructor Create(AOwner: TComponent); override; procedure InvalidateConnections; property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections; end; TWorkspace = class(TControl) private const MinZoom = 0.1; MaxZoom = 5.0; ZoomStep = 0.1; private FRootLayer: TAstWorld; FIsPanning: Boolean; FLastMousePos: TPointF; FIsDraggingNode: Boolean; FDragSource: TControl; FDragVisual: TControl; FDragOffset: TPointF; FCurrentDropTarget: TControl; FCurrentDropIndex: Integer; FOnNodeDragDrop: TOnDragDropEvent; function GetZoom: Single; procedure SetZoom(const Value: Single); function GetContentOffset: TPointF; procedure SetContentOffset(const Value: TPointF); function GetOnPaintConnections: TOnPaintConnectionsEvent; procedure SetOnPaintConnections(const Value: TOnPaintConnectionsEvent); procedure StopDrag; procedure UpdateDropMarker(const ScreenPos: TPointF); protected procedure Loaded; override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function ScreenToWorld(const APoint: TPointF): TPointF; procedure BeginDragNode(ASource: TControl); property World: TAstWorld read FRootLayer; property Zoom: Single read GetZoom write SetZoom; property ContentOffset: TPointF read GetContentOffset write SetContentOffset; property OnPaintConnections: TOnPaintConnectionsEvent read GetOnPaintConnections write SetOnPaintConnections; property OnNodeDragDrop: TOnDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop; end; implementation { TAstWorld } constructor TAstWorld.Create(AOwner: TComponent); begin inherited; HitTest := False; Locked := True; Stored := False; ClipChildren := False; Width := 100; Height := 100; FShowDropMarker := False; end; procedure TAstWorld.Paint; begin inherited; if (csDesigning in ComponentState) then DrawDesignBorder; // Connections should be BEHIND the nodes, so Paint is the correct place. if Assigned(FOnPaintConnections) then FOnPaintConnections(Self, Canvas); end; procedure TAstWorld.AfterPaint; var ScaleFactor: Single; Radius: Single; Thickness: Single; begin inherited; // --- DRAW DROP MARKER (IN FRONT OF NODES) --- if FShowDropMarker then begin // Calculate visual sizes inversely proportional to zoom if Scale.X > 0 then ScaleFactor := 1 / Scale.X else ScaleFactor := 1; Thickness := 3 * ScaleFactor; Radius := 4 * ScaleFactor; Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Color := TAlphaColors.Red; Canvas.Stroke.Thickness := Thickness; Canvas.Stroke.Cap := TStrokeCap.Round; // Draw Line Canvas.DrawLine(FDropP1, FDropP2, 1.0); // Draw Circles at ends Canvas.Fill.Kind := TBrushKind.Solid; Canvas.Fill.Color := TAlphaColors.Red; Canvas.FillEllipse(TRectF.Create(FDropP1.X - Radius, FDropP1.Y - Radius, FDropP1.X + Radius, FDropP1.Y + Radius), 1.0); Canvas.FillEllipse(TRectF.Create(FDropP2.X - Radius, FDropP2.Y - Radius, FDropP2.X + Radius, FDropP2.Y + Radius), 1.0); end; end; procedure TAstWorld.InvalidateConnections; begin Repaint; end; { TWorkspace } constructor TWorkspace.Create(AOwner: TComponent); begin inherited Create(AOwner); ClipChildren := True; HitTest := True; CanFocus := True; // Enable Keyboard Input AutoCapture := True; FRootLayer := TAstWorld.Create(Self); FRootLayer.Parent := Self; FRootLayer.SetBounds(0, 0, 100, 100); FRootLayer.Scale.Point := TPointF.Create(1, 1); end; destructor TWorkspace.Destroy; begin inherited; end; procedure TWorkspace.Loaded; begin inherited; if FRootLayer <> nil then FRootLayer.BringToFront; end; function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF; begin Result := ScreenToLocal(APoint); Result := FRootLayer.AbsoluteToLocal(LocalToAbsolute(Result)); end; procedure TWorkspace.BeginDragNode(ASource: TControl); var Snapshot: TBitmap; DragImg: TImage; MouseWorld: TPointF; AbsPos, WorldPos: TPointF; begin if FIsDraggingNode or FIsPanning then Exit; FIsDraggingNode := True; FDragSource := ASource; Root.Captured := Self; Snapshot := ASource.MakeScreenshot; DragImg := TImage.Create(nil); DragImg.Parent := FRootLayer; DragImg.Bitmap := Snapshot; DragImg.WrapMode := TImageWrapMode.Stretch; DragImg.HitTest := False; DragImg.Opacity := 0.7; DragImg.BringToFront; AbsPos := ASource.LocalToAbsolute(TPointF.Zero); WorldPos := FRootLayer.AbsoluteToLocal(AbsPos); DragImg.SetBounds(WorldPos.X, WorldPos.Y, ASource.Width, ASource.Height); FDragVisual := DragImg; MouseWorld := ScreenToWorld(Screen.MousePos); FDragOffset := MouseWorld - WorldPos; ASource.Opacity := 0.4; end; procedure TWorkspace.UpdateDropMarker(const ScreenPos: TPointF); var Obj: IControl; TargetCtrl: TControl; TargetLocalPos: TPointF; IsHorizontal: Boolean; InsertAfter: Boolean; PTL, PBR: TPointF; P1, P2: TPointF; SourceParent: TControl; TargetContainer: TAutoFitControl; begin FRootLayer.FShowDropMarker := False; FCurrentDropTarget := nil; FCurrentDropIndex := -1; if FDragSource = nil then Exit; if not (FDragSource.Parent is TControl) then Exit; SourceParent := TControl(FDragSource.Parent); // 1. Find Drop Target Obj := ObjectAtPoint(ScreenPos); if (Obj = nil) or not (Obj.GetObject is TControl) then Exit; TargetCtrl := TControl(Obj.GetObject); // 2. Walk up hierarchy while (TargetCtrl <> nil) and (TargetCtrl.Parent <> SourceParent) do begin TargetCtrl := TargetCtrl.ParentControl; if TargetCtrl = FRootLayer then Exit; end; if TargetCtrl = nil then Exit; if TargetCtrl = FDragSource then Exit; FCurrentDropTarget := TargetCtrl; // 3. Determine Geometry using TAutoFitControl info TargetLocalPos := TargetCtrl.AbsoluteToLocal(ScreenPos); IsHorizontal := True; // Default fallback if SourceParent is TAutoFitControl then begin TargetContainer := TAutoFitControl(SourceParent); if TargetContainer.Orientation = TLayoutOrientation.loHorizontal then IsHorizontal := True else IsHorizontal := False; end; // Split logic if IsHorizontal then InsertAfter := TargetLocalPos.X > (TargetCtrl.Width / 2) else InsertAfter := TargetLocalPos.Y > (TargetCtrl.Height / 2); // 4. Calculate Index if InsertAfter then FCurrentDropIndex := TargetCtrl.Index + 1 else FCurrentDropIndex := TargetCtrl.Index; // 5. Calculate Marker Visuals var AbsTL := TargetCtrl.LocalToAbsolute(TPointF.Zero); var AbsBR := TargetCtrl.LocalToAbsolute(TPointF.Create(TargetCtrl.Width, TargetCtrl.Height)); PTL := FRootLayer.AbsoluteToLocal(AbsTL); PBR := FRootLayer.AbsoluteToLocal(AbsBR); if IsHorizontal then begin // Vertical Line var XPos := PTL.X; if InsertAfter then XPos := PBR.X; if InsertAfter then XPos := XPos + 2 else XPos := XPos - 2; P1 := TPointF.Create(XPos, PTL.Y); P2 := TPointF.Create(XPos, PBR.Y); end else begin // Horizontal Line var YPos := PTL.Y; if InsertAfter then YPos := PBR.Y; if InsertAfter then YPos := YPos + 2 else YPos := YPos - 2; P1 := TPointF.Create(PTL.X, YPos); P2 := TPointF.Create(PBR.X, YPos); end; FRootLayer.FDropP1 := P1; FRootLayer.FDropP2 := P2; FRootLayer.FShowDropMarker := True; end; procedure TWorkspace.StopDrag; begin if not FIsDraggingNode then Exit; if Assigned(FDragVisual) then begin FDragVisual.Parent := nil; FDragVisual.Free; FDragVisual := nil; end; if Assigned(FDragSource) then FDragSource.Opacity := 1.0; FRootLayer.FShowDropMarker := False; FRootLayer.Repaint; if Assigned(FOnNodeDragDrop) and Assigned(FCurrentDropTarget) and (FCurrentDropIndex >= 0) then FOnNodeDragDrop(FDragSource, FCurrentDropTarget, FCurrentDropIndex); FIsDraggingNode := False; FDragSource := nil; FCurrentDropTarget := nil; Root.Captured := nil; end; procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; // Capture Keyboard Focus if CanFocus then SetFocus; if not FIsDraggingNode and (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) then begin FIsPanning := True; FLastMousePos := TPointF.Create(X, Y); Root.Captured := Self; end; end; procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single); var LCurrentPos: TPointF; LDelta: TPointF; LWorldPos: TPointF; begin inherited; if FIsDraggingNode then begin if Assigned(FDragVisual) then begin LWorldPos := ScreenToWorld(Screen.MousePos); FDragVisual.Position.Point := LWorldPos - FDragOffset; end; UpdateDropMarker(Screen.MousePos); FRootLayer.Repaint; end else if FIsPanning then begin LCurrentPos := TPointF.Create(X, Y); LDelta := LCurrentPos - FLastMousePos; FRootLayer.Position.Point := FRootLayer.Position.Point + LDelta; FLastMousePos := LCurrentPos; end; end; procedure TWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; if FIsDraggingNode then begin StopDrag; end else if FIsPanning then begin FIsPanning := False; Root.Captured := nil; end; end; procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); var LOldZoom, LNewZoom: Single; LScaleRatio: Single; LMousePosLocal: TPointF; LOffset: TPointF; begin LOldZoom := Zoom; if WheelDelta > 0 then LNewZoom := LOldZoom + ZoomStep else LNewZoom := LOldZoom - ZoomStep; LNewZoom := EnsureRange(LNewZoom, MinZoom, MaxZoom); if not SameValue(LNewZoom, LOldZoom, TEpsilon.Vector) then begin LMousePosLocal := ScreenToLocal(Screen.MousePos); LOffset := LMousePosLocal - FRootLayer.Position.Point; LScaleRatio := LNewZoom / LOldZoom; FRootLayer.Position.Point := LMousePosLocal - (LOffset * LScaleRatio); SetZoom(LNewZoom); end; Handled := True; if not Handled then inherited; end; function TWorkspace.GetZoom: Single; begin Result := FRootLayer.Scale.X; end; procedure TWorkspace.SetZoom(const Value: Single); begin FRootLayer.Scale.Point := TPointF.Create(Value, Value); end; function TWorkspace.GetContentOffset: TPointF; begin Result := FRootLayer.Position.Point; end; procedure TWorkspace.SetContentOffset(const Value: TPointF); begin FRootLayer.Position.Point := Value; end; function TWorkspace.GetOnPaintConnections: TOnPaintConnectionsEvent; begin Result := FRootLayer.OnPaintConnections; end; procedure TWorkspace.SetOnPaintConnections(const Value: TOnPaintConnectionsEvent); begin FRootLayer.OnPaintConnections := Value; end; end.