623 lines
18 KiB
ObjectPascal
623 lines
18 KiB
ObjectPascal
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; // Verschiebung in Screen-Pixeln
|
|
FZoom: Single; // Skalierungsfaktor
|
|
|
|
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;
|
|
|
|
// Koordinaten-Transformation
|
|
function LocalToWorld(const ALocalPoint: TPointF): TPointF;
|
|
function WorldToLocal(const AWorldPoint: TPointF): TPointF;
|
|
|
|
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;
|
|
|
|
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
|
|
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
|
|
// --- HIT TEST FIX ---
|
|
// 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.
|