unit Myc.Fmx.AstEditor.Workspace; interface uses System.SysUtils, System.Classes, System.Types, System.UITypes, System.Math.Vectors, System.Generics.Collections, FMX.Types, FMX.Controls, FMX.Graphics, FMX.Objects, Myc.Ast.Nodes; const cDataPinColor = TAlphaColors.Dodgerblue; cExecPinColor = TAlphaColors.Lightgreen; type TPinConnection = record OutputPin: TControl; InputPin: TControl; constructor Create(AOutputPin, AInputPin: TControl); end; TAstWorkspace = class(TStyledControl) private FConnections: TArray; FPanning: TSizeF; FIsPanning: Boolean; FLastPanPos: TPointF; FZoom: Single; protected procedure Paint; override; procedure DoDeleteChildren; 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 DblClick; override; public constructor Create(AOwner: TComponent); override; procedure Build(const RootNode: IAstNode; const Position: TPointF); function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override; function Zoom(Factor: Single): Boolean; // Neue Public Methoden, damit Nodes das Panning steuern können procedure ExternalMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); procedure ExternalMouseMove(Shift: TShiftState; X, Y: Single); procedure ExternalMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); published property Align; property Anchors; property ClipChildren default True; property Cursor default crDefault; property DragMode default TDragMode.dmManual; property Enabled; property Height; property HelpContext; property HelpKeyword; property HelpType; property Hint; property HitTest default True; property Locked; property Margins; property Opacity; property Padding; property PopupMenu; property Position; property RotationAngle; property RotationCenter; property Scale; property Size; property StyleLookup; property Visible; property Width; property OnClick; property OnDblClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMouseWheel; property OnMouseEnter; property OnMouseLeave; end; implementation uses System.Math, FMX.Platform, Myc.Fmx.AstEditor, Myc.Fmx.AstEditor.Visualizer; { TPinConnection } constructor TPinConnection.Create(AOutputPin, AInputPin: TControl); begin OutputPin := AOutputPin; InputPin := AInputPin; end; { TAstWorkspace } constructor TAstWorkspace.Create(AOwner: TComponent); begin inherited; FZoom := 1.0; // Standard-Eigenschaften für einen Arbeitsbereich ClipChildren := True; HitTest := True; end; procedure TAstWorkspace.Build(const RootNode: IAstNode; const Position: TPointF); var visu: IAstVisualizer; node: TAstViewNode; begin // Löscht alle bestehenden visuellen Knoten DeleteChildren; FConnections := nil; if not Assigned(RootNode) then Exit; // Erstellt den Visualizer mit dem Workspace als Kontext visu := TAstVisualizer.Create(Self, Self, 0); node := visu.CallAccept(RootNode); if Assigned(node) then begin node.Position.Point := Position; end; end; procedure TAstWorkspace.DoDeleteChildren; begin FConnections := nil; inherited; end; function TAstWorkspace.GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; begin Matrix := TMatrix.CreateScaling(FZoom, FZoom) * TMatrix.CreateTranslation(FPanning.cx, FPanning.cy); Simple := (FZoom = 1.0) and (FPanning.cx = 0) and (FPanning.cy = 0); Result := True; end; // --- Interne Event Handler --- procedure TAstWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; ExternalMouseDown(Button, Shift, X, Y); end; procedure TAstWorkspace.MouseMove(Shift: TShiftState; X, Y: Single); begin inherited; ExternalMouseMove(Shift, X, Y); end; procedure TAstWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; ExternalMouseUp(Button, Shift, X, Y); end; // --- Externe Steuerung für Nodes --- procedure TAstWorkspace.ExternalMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if (Button = TMouseButton.mbLeft) then begin Capture; FIsPanning := True; FLastPanPos := TPointF.Create(X, Y); Cursor := crHandPoint; end; end; procedure TAstWorkspace.ExternalMouseMove(Shift: TShiftState; X, Y: Single); var delta: TPointF; begin if FIsPanning then begin delta := TPointF.Create(X - FLastPanPos.X, Y - FLastPanPos.Y); FPanning.cx := FPanning.cx + delta.X; FPanning.cy := FPanning.cy + delta.Y; FLastPanPos := TPointF.Create(X, Y); RecalcAbsolute; RecalcUpdateRect; Repaint; end; end; procedure TAstWorkspace.ExternalMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin if (Button = TMouseButton.mbLeft) and (FIsPanning) then begin ReleaseCapture; FIsPanning := False; Cursor := crDefault; end; end; procedure TAstWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); begin inherited; Handled := Zoom(IfThen(WheelDelta > 0, FZoom * 1.1, FZoom / 1.1)); end; procedure TAstWorkspace.DblClick; begin inherited; // Reset Zoom/Pan on double click FZoom := 1.0; FPanning := TSizeF.Create(0, 0); RecalcAbsolute; RecalcUpdateRect; Repaint; end; procedure TAstWorkspace.Paint; var connection: TPinConnection; startPoint, endPoint, pinCenter: TPointF; path: TPathData; controlPoint1, controlPoint2: TPointF; controlOffset: Single; absoluteStart, absoluteEnd: TPointF; str: string; begin inherited; Canvas.Stroke.Kind := TBrushKind.Solid; Canvas.Stroke.Thickness := 2; for connection in FConnections do begin // Safety check if pins are still valid/visible if (connection.OutputPin = nil) or (connection.InputPin = nil) or (connection.OutputPin.Root <> Self.Root) or (connection.InputPin.Root <> Self.Root) then continue; pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2); absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter); pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2); absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter); startPoint := AbsoluteToLocal(absoluteStart); endPoint := AbsoluteToLocal(absoluteEnd); str := connection.InputPin.TagString; if Pos('data', str) = 0 then Canvas.Stroke.Color := cExecPinColor else Canvas.Stroke.Color := cDataPinColor; path := TPathData.Create; try controlOffset := Max(25, 0.5 * endPoint.Distance(startPoint)); controlPoint1 := TPointF.Create(startPoint.X + controlOffset, startPoint.Y); controlPoint2 := TPointF.Create(endPoint.X - controlOffset, endPoint.Y); path.MoveTo(startPoint); path.CurveTo(controlPoint1, controlPoint2, endPoint); Canvas.DrawPath(path, 1.0); finally path.Free; end; end; end; function TAstWorkspace.Zoom(Factor: Single): Boolean; var mouseService: IFMXMouseService; mousePos: TPointF; begin Result := TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, mouseService); if Result then begin mousePos := ScreenToLocal(mouseService.GetMousePos); Factor := Max(0.2, Min(3.0, Factor)); // Adjust panning to zoom towards mouse position FPanning.cx := mousePos.X * (1 - Factor / FZoom) + FPanning.cx * (Factor / FZoom); FPanning.cy := mousePos.Y * (1 - Factor / FZoom) + FPanning.cy * (Factor / FZoom); FZoom := Factor; RecalcAbsolute; RecalcUpdateRect; Repaint; end; end; end.