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.Render; type TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object; TOnDragDropEvent = procedure(ASource, ATarget: TVisualNode; AIndex: Integer) of object; TWorkspace = class(TControl, IVisualHost) private const MinZoom = 0.1; MaxZoom = 5.0; ZoomStep = 0.1; private FRootNode: TVisualNode; FContentOffset: TPointF; FZoom: Single; FIsPanning: Boolean; FLastMousePos: TPointF; FMouseOverNode: TVisualNode; FCapturedNode: TVisualNode; FIsDraggingNode: Boolean; FDragSource: TVisualNode; FDragVisualBitmap: TBitmap; FDragVisualPos: TPointF; // World Coordinates FDragOffset: TPointF; FCurrentDropTarget: TVisualNode; FCurrentDropIndex: Integer; FShowDropMarker: Boolean; FDropP1, FDropP2: TPointF; FOnPaintConnections: TOnPaintConnectionsEvent; FOnNodeDragDrop: TOnDragDropEvent; // IVisualHost procedure InvalidateRect(const R: TRectF); function GetCanvas: TCanvas; procedure SetZoom(const Value: Single); procedure SetContentOffset(const Value: TPointF); procedure SetRootNode(const Value: TVisualNode); procedure UpdateDropMarker(const WorldPos: TPointF); procedure StopDrag; protected procedure Paint; 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; procedure Resize; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function LocalToWorld(const ALocalPoint: TPointF): TPointF; function WorldToLocal(const AWorldPoint: TPointF): TPointF; procedure BeginDragNode(ASource: TVisualNode); procedure InvalidateConnections; function ScreenToWorld(const APoint: TPointF): TPointF; procedure RequestLayout; property RootNode: TVisualNode read FRootNode write SetRootNode; property Zoom: Single read FZoom write SetZoom; property ContentOffset: TPointF read FContentOffset write SetContentOffset; property OnPaintConnections: TOnPaintConnectionsEvent read FOnPaintConnections write FOnPaintConnections; property OnNodeDragDrop: TOnDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop; end; implementation uses System.Generics.Collections, Myc.Fmx.AstEditor.Node; { TWorkspace } constructor TWorkspace.Create(AOwner: TComponent); begin inherited Create(AOwner); ClipChildren := True; HitTest := True; CanFocus := True; AutoCapture := True; FZoom := 1.0; FContentOffset := TPointF.Zero; FRootNode := TVisualNode.Create(Self); end; destructor TWorkspace.Destroy; begin FreeAndNil(FRootNode); FreeAndNil(FDragVisualBitmap); inherited; end; function TWorkspace.GetCanvas: TCanvas; begin Result := Canvas; end; procedure TWorkspace.InvalidateRect(const R: TRectF); begin Repaint; end; procedure TWorkspace.RequestLayout; begin if Assigned(FRootNode) then begin FRootNode.RecalcLayout; Repaint; end; end; procedure TWorkspace.SetRootNode(const Value: TVisualNode); begin if FRootNode <> Value then begin if Assigned(FRootNode) then FRootNode.Free; FRootNode := Value; RequestLayout; end; end; procedure TWorkspace.SetZoom(const Value: Single); begin if not SameValue(FZoom, Value, TEpsilon.Position) then begin FZoom := EnsureRange(Value, MinZoom, MaxZoom); Repaint; end; end; procedure TWorkspace.SetContentOffset(const Value: TPointF); begin if FContentOffset <> Value then begin FContentOffset := Value; Repaint; end; end; // ============================================================================= // COORDINATE SYSTEM LOGIC // ============================================================================= // Screen(Local) = (World * Zoom) + ContentOffset // World = (Screen - ContentOffset) / Zoom // ============================================================================= function TWorkspace.LocalToWorld(const ALocalPoint: TPointF): TPointF; begin // Transformation: Screen Pixel -> Logical AST Coordinate if FZoom < 0.001 then Result := ALocalPoint - FContentOffset else Result := (ALocalPoint - FContentOffset) / FZoom; end; function TWorkspace.WorldToLocal(const AWorldPoint: TPointF): TPointF; begin // Transformation: Logical AST Coordinate -> Screen Pixel Result := (AWorldPoint * FZoom) + FContentOffset; end; function TWorkspace.ScreenToWorld(const APoint: TPointF): TPointF; begin // Helper for external calls (e.g. from DragDrop where we get global mouse pos) Result := LocalToWorld(ScreenToLocal(APoint)); end; procedure TWorkspace.Paint; var State: TCanvasSaveState; DragRect: TRectF; M: TMatrix; begin inherited; // Design-Time Border if (csDesigning in ComponentState) then begin Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Color := TAlphaColors.Gray; Canvas.Stroke.Dash := TStrokeDash.Dash; Canvas.DrawRect(LocalRect, 0, 0, AllCorners, 1.0); end; State := Canvas.SaveState; try Canvas.IntersectClipRect(LocalRect); // --- MATRIX APPLICATION --- // Order matters! // 1. Scale (Zoom) // 2. Translate (Pan) // Mathematically corresponds to: World * Scale + Translate M := TMatrix.Identity; M := M * TMatrix.CreateScaling(FZoom, FZoom); M := M * TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y); Canvas.MultiplyMatrix(M); // Callback for Connections (World Space drawing) if Assigned(FOnPaintConnections) then FOnPaintConnections(Self, Canvas); // Draw Tree (World Space) if Assigned(FRootNode) then FRootNode.Paint(Canvas, TPointF.Zero); // Draw Drop Marker (World Space) if FShowDropMarker then begin // Adjust line thickness inverse to zoom to keep it consistent on screen var LineThick := 3.0 / FZoom; var DotRadius := 4.0 / FZoom; Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Color := TAlphaColors.Red; Canvas.Stroke.Thickness := LineThick; Canvas.Stroke.Cap := TStrokeCap.Round; Canvas.DrawLine(FDropP1, FDropP2, 1.0); Canvas.Fill.Color := TAlphaColors.Red; Canvas.FillEllipse( TRectF.Create(FDropP1.X - DotRadius, FDropP1.Y - DotRadius, FDropP1.X + DotRadius, FDropP1.Y + DotRadius), 1.0 ); Canvas.FillEllipse( TRectF.Create(FDropP2.X - DotRadius, FDropP2.Y - DotRadius, FDropP2.X + DotRadius, FDropP2.Y + DotRadius), 1.0 ); end; // Draw Drag Ghost (World Space) if FIsDraggingNode and Assigned(FDragVisualBitmap) then begin // Scale is already in the Bitmap (BitmapScale), but here we draw on Scaled Canvas. // We draw 1:1 on World Coordinates. DragRect := TRectF.Create( FDragVisualPos, FDragVisualBitmap.Width / FDragVisualBitmap.BitmapScale, FDragVisualBitmap.Height / FDragVisualBitmap.BitmapScale ); Canvas.DrawBitmap(FDragVisualBitmap, TRectF.Create(0, 0, FDragVisualBitmap.Width, FDragVisualBitmap.Height), DragRect, 0.7); end; finally Canvas.RestoreState(State); end; end; procedure TWorkspace.Resize; begin inherited; Repaint; end; procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); var WorldP: TPointF; Hit: TVisualNode; HitTestP: TPointF; begin inherited; if CanFocus then SetFocus; // Convert local mouse pos (pixel) to world pos WorldP := LocalToWorld(TPointF.Create(X, Y)); // Panning Start if (Button = TMouseButton.mbMiddle) or ((Button = TMouseButton.mbLeft) and (ssCtrl in Shift)) then begin FIsPanning := True; FLastMousePos := TPointF.Create(X, Y); // Keep raw pixel for delta Root.Captured := Self; Exit; end; if Assigned(FRootNode) then begin // HitTest expects coordinates relative to the Node's Local Origin (0,0). // The RootNode is drawn at FRootNode.Position in World Space. // So we transform: WorldMouse - NodePosition HitTestP := WorldP - FRootNode.Position; Hit := FRootNode.HitTest(HitTestP); if Assigned(Hit) then begin FCapturedNode := Hit; // Propagate: Convert WorldP to the Node's internal coordinate system var NodeLocal := Hit.AbsoluteToLocal(WorldP); Hit.MouseDown(Button, Shift, NodeLocal.X, NodeLocal.Y); end else if Button = TMouseButton.mbLeft then begin // Clicked background -> Pan FIsPanning := True; FLastMousePos := TPointF.Create(X, Y); Root.Captured := Self; end; end; end; procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single); var WorldP: TPointF; LocalP: TPointF; HitTestP: TPointF; Hit: TVisualNode; Delta: TPointF; begin inherited; LocalP := TPointF.Create(X, Y); WorldP := LocalToWorld(LocalP); if FIsDraggingNode then begin FDragVisualPos := WorldP - FDragOffset; UpdateDropMarker(WorldP); Repaint; end else if FIsPanning then begin // Pan logic works in Screen Pixels (1:1 mouse movement) Delta := LocalP - FLastMousePos; FContentOffset := FContentOffset + Delta; FLastMousePos := LocalP; Repaint; end else begin // Propagate to Captured Node if Assigned(FCapturedNode) then begin var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP); FCapturedNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y); end else if Assigned(FRootNode) then begin // Handle Hover // --- HIT TEST FIX --- HitTestP := WorldP - FRootNode.Position; Hit := FRootNode.HitTest(HitTestP); if Hit <> FMouseOverNode then begin if Assigned(FMouseOverNode) then FMouseOverNode.MouseLeave; FMouseOverNode := Hit; if Assigned(FMouseOverNode) then FMouseOverNode.MouseEnter; end; if Assigned(FMouseOverNode) then begin var NodeLocal := FMouseOverNode.AbsoluteToLocal(WorldP); FMouseOverNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y); end; end; end; end; procedure TWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); var WorldP: TPointF; begin inherited; WorldP := LocalToWorld(TPointF.Create(X, Y)); if FIsDraggingNode then begin StopDrag; end else if FIsPanning then begin FIsPanning := False; Root.Captured := nil; end else if Assigned(FCapturedNode) then begin var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP); FCapturedNode.MouseUp(Button, Shift, NodeLocal.X, NodeLocal.Y); FCapturedNode := nil; end; end; procedure TWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); var OldZoom: Single; LocalP, WorldBefore, OffsetNew: TPointF; begin OldZoom := FZoom; if WheelDelta > 0 then SetZoom(FZoom + ZoomStep) else SetZoom(FZoom - ZoomStep); // Zoom-To-Mouse Logic if not SameValue(OldZoom, FZoom, TEpsilon.Position) then begin // 1. Where was the mouse pointing in World Space BEFORE zoom? LocalP := ScreenToLocal(Screen.MousePos); WorldBefore := (LocalP - FContentOffset) / OldZoom; // 2. We want WorldBefore to be at LocalP AFTER zoom. // LocalP = (WorldBefore * NewZoom) + NewOffset // NewOffset = LocalP - (WorldBefore * NewZoom) OffsetNew := LocalP - (WorldBefore * FZoom); FContentOffset := OffsetNew; Repaint; end; Handled := True; end; procedure TWorkspace.BeginDragNode(ASource: TVisualNode); var Bitmap: TBitmap; ScaleFactor: Single; begin if FIsDraggingNode or FIsPanning then Exit; if ASource = nil then Exit; FIsDraggingNode := True; FDragSource := ASource; Root.Captured := Self; // Snapshot creation ScaleFactor := Scene.GetSceneScale; Bitmap := TBitmap.Create(Round(ASource.Size.Width * ScaleFactor), Round(ASource.Size.Height * ScaleFactor)); Bitmap.BitmapScale := ScaleFactor; if Bitmap.Canvas.BeginScene then try Bitmap.Canvas.Clear(0); ASource.Paint(Bitmap.Canvas, TPointF.Zero); finally Bitmap.Canvas.EndScene; end; FDragVisualBitmap := Bitmap; var MouseWorld := ScreenToWorld(Screen.MousePos); var NodeWorld := ASource.GetAbsolutePosition; FDragOffset := MouseWorld - NodeWorld; FDragVisualPos := NodeWorld; ASource.Opacity := 0.4; ASource.RequestLayout; end; procedure TWorkspace.UpdateDropMarker(const WorldPos: TPointF); var Hit: TVisualNode; TargetContainer: TAutoFitLayout; IsHorizontal: Boolean; InsertIndex: Integer; Child: TVisualNode; P1, P2: TPointF; AbsP: TPointF; HitTestP: TPointF; begin FShowDropMarker := False; FCurrentDropTarget := nil; FCurrentDropIndex := -1; if FDragSource = nil then Exit; if Assigned(FRootNode) then begin // Fix HitTest for Root Offset HitTestP := WorldPos - FRootNode.Position; Hit := FRootNode.HitTest(HitTestP); end else Hit := nil; if Hit = nil then Exit; if (Hit is TAutoFitLayout) then TargetContainer := TAutoFitLayout(Hit) else if (Hit.Parent is TAutoFitLayout) then TargetContainer := TAutoFitLayout(Hit.Parent) else Exit; if TargetContainer = FDragSource then Exit; FCurrentDropTarget := TargetContainer; IsHorizontal := TargetContainer.Orientation = loHorizontal; var TargetLocal := TargetContainer.AbsoluteToLocal(WorldPos); InsertIndex := TargetContainer.GetInsertionIndex(TargetLocal); FCurrentDropIndex := InsertIndex; // Marker Geometry Calculation if InsertIndex < TargetContainer.GetChildCount then begin Child := TargetContainer.GetChild(InsertIndex); AbsP := Child.GetAbsolutePosition; if IsHorizontal then begin P1 := AbsP; P2 := AbsP + TPointF.Create(0, Child.Size.Height); end else begin P1 := AbsP; P2 := AbsP + TPointF.Create(Child.Size.Width, 0); end; end else if TargetContainer.GetChildCount > 0 then begin Child := TargetContainer.GetChild(TargetContainer.GetChildCount - 1); AbsP := Child.GetAbsolutePosition; if IsHorizontal then begin P1 := AbsP + TPointF.Create(Child.Size.Width + Child.Margins.Right, 0); P2 := P1 + TPointF.Create(0, Child.Size.Height); end else begin P1 := AbsP + TPointF.Create(0, Child.Size.Height + Child.Margins.Bottom); P2 := P1 + TPointF.Create(Child.Size.Width, 0); end; end else begin AbsP := TargetContainer.GetAbsolutePosition + TPointF.Create(TargetContainer.Padding.Left, TargetContainer.Padding.Top); if IsHorizontal then begin P1 := AbsP; P2 := AbsP + TPointF.Create(0, 20); end else begin P1 := AbsP; P2 := AbsP + TPointF.Create(20, 0); end; end; FDropP1 := P1; FDropP2 := P2; FShowDropMarker := True; end; procedure TWorkspace.StopDrag; begin if not FIsDraggingNode then Exit; FreeAndNil(FDragVisualBitmap); if Assigned(FDragSource) then begin FDragSource.Opacity := 1.0; if Assigned(FOnNodeDragDrop) and Assigned(FCurrentDropTarget) and (FCurrentDropIndex >= 0) then begin FOnNodeDragDrop(FDragSource, FCurrentDropTarget, FCurrentDropIndex); end; end; FShowDropMarker := False; FIsDraggingNode := False; FDragSource := nil; FCurrentDropTarget := nil; Root.Captured := nil; Repaint; end; procedure TWorkspace.InvalidateConnections; begin Repaint; end; end.