Ast editor custom draw
This commit is contained in:
Michael Schimmel
@@ -14,146 +14,84 @@ uses
|
||||
FMX.Objects,
|
||||
FMX.Graphics,
|
||||
FMX.Forms,
|
||||
Myc.Fmx.AstEditor.Layout;
|
||||
Myc.Fmx.AstEditor.Render;
|
||||
|
||||
type
|
||||
TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object;
|
||||
TOnDragDropEvent = procedure(ASource, ATarget: TControl; AIndex: Integer) of object;
|
||||
TOnDragDropEvent = procedure(ASource, ATarget: TVisualNode; 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)
|
||||
TWorkspace = class(TControl, IVisualHost)
|
||||
private
|
||||
const
|
||||
MinZoom = 0.1;
|
||||
MaxZoom = 5.0;
|
||||
ZoomStep = 0.1;
|
||||
private
|
||||
FRootLayer: TAstWorld;
|
||||
FRootNode: TVisualNode;
|
||||
|
||||
FContentOffset: TPointF;
|
||||
FZoom: Single;
|
||||
|
||||
FIsPanning: Boolean;
|
||||
FLastMousePos: TPointF;
|
||||
FMouseOverNode: TVisualNode;
|
||||
FCapturedNode: TVisualNode;
|
||||
|
||||
FIsDraggingNode: Boolean;
|
||||
FDragSource: TControl;
|
||||
FDragVisual: TControl;
|
||||
FDragSource: TVisualNode;
|
||||
FDragVisualBitmap: TBitmap;
|
||||
FDragVisualPos: TPointF;
|
||||
FDragOffset: TPointF;
|
||||
|
||||
FCurrentDropTarget: TControl;
|
||||
FCurrentDropTarget: TVisualNode;
|
||||
FCurrentDropIndex: Integer;
|
||||
FShowDropMarker: Boolean;
|
||||
FDropP1, FDropP2: TPointF;
|
||||
|
||||
FOnPaintConnections: TOnPaintConnectionsEvent;
|
||||
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);
|
||||
// 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;
|
||||
procedure UpdateDropMarker(const ScreenPos: TPointF);
|
||||
|
||||
protected
|
||||
procedure Loaded; override;
|
||||
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;
|
||||
|
||||
// Moved to public for Editor access
|
||||
function ScreenToWorld(const APoint: TPointF): TPointF;
|
||||
procedure BeginDragNode(ASource: TControl);
|
||||
procedure RequestLayout;
|
||||
|
||||
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 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
|
||||
|
||||
{ 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;
|
||||
uses
|
||||
Myc.Fmx.AstEditor.Node;
|
||||
|
||||
{ TWorkspace }
|
||||
|
||||
@@ -162,260 +100,234 @@ begin
|
||||
inherited Create(AOwner);
|
||||
ClipChildren := True;
|
||||
HitTest := True;
|
||||
CanFocus := True; // Enable Keyboard Input
|
||||
CanFocus := True;
|
||||
AutoCapture := True;
|
||||
|
||||
FRootLayer := TAstWorld.Create(Self);
|
||||
FRootLayer.Parent := Self;
|
||||
FRootLayer.SetBounds(0, 0, 100, 100);
|
||||
FRootLayer.Scale.Point := TPointF.Create(1, 1);
|
||||
FZoom := 1.0;
|
||||
FContentOffset := TPointF.Zero;
|
||||
FRootNode := TVisualNode.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TWorkspace.Destroy;
|
||||
begin
|
||||
FreeAndNil(FRootNode);
|
||||
FreeAndNil(FDragVisualBitmap);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TWorkspace.Loaded;
|
||||
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 FZoom <> Value 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;
|
||||
|
||||
procedure TWorkspace.Paint;
|
||||
var
|
||||
State: TCanvasSaveState;
|
||||
DragRect: TRectF;
|
||||
begin
|
||||
inherited;
|
||||
if FRootLayer <> nil then
|
||||
FRootLayer.BringToFront;
|
||||
|
||||
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);
|
||||
|
||||
Canvas.MultiplyMatrix(TMatrix.CreateScaling(FZoom, FZoom));
|
||||
Canvas.MultiplyMatrix(TMatrix.CreateTranslation(FContentOffset.X, FContentOffset.Y));
|
||||
|
||||
if Assigned(FOnPaintConnections) then
|
||||
FOnPaintConnections(Self, Canvas);
|
||||
|
||||
if Assigned(FRootNode) then
|
||||
FRootNode.Paint(Canvas, TPointF.Zero);
|
||||
|
||||
if FShowDropMarker then
|
||||
begin
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := TAlphaColors.Red;
|
||||
Canvas.Stroke.Thickness := 3 / FZoom;
|
||||
Canvas.Stroke.Cap := TStrokeCap.Round;
|
||||
|
||||
Canvas.DrawLine(FDropP1, FDropP2, 1.0);
|
||||
|
||||
Canvas.Fill.Color := TAlphaColors.Red;
|
||||
var R: Single := 4 / FZoom;
|
||||
Canvas.FillEllipse(TRectF.Create(FDropP1.X - R, FDropP1.Y - R, FDropP1.X + R, FDropP1.Y + R), 1.0);
|
||||
Canvas.FillEllipse(TRectF.Create(FDropP2.X - R, FDropP2.Y - R, FDropP2.X + R, FDropP2.Y + R), 1.0);
|
||||
end;
|
||||
|
||||
if FIsDraggingNode and Assigned(FDragVisualBitmap) then
|
||||
begin
|
||||
DragRect := TRectF.Create(FDragVisualPos, FDragVisualBitmap.Width, FDragVisualBitmap.Height);
|
||||
Canvas.DrawBitmap(FDragVisualBitmap, TRectF.Create(0, 0, FDragVisualBitmap.Width, FDragVisualBitmap.Height), DragRect, 0.7);
|
||||
end;
|
||||
|
||||
finally
|
||||
Canvas.RestoreState(State);
|
||||
end;
|
||||
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;
|
||||
LocalP: 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;
|
||||
LocalP := ScreenToLocal(APoint);
|
||||
Result := (LocalP - FContentOffset) / FZoom;
|
||||
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;
|
||||
procedure TWorkspace.Resize;
|
||||
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;
|
||||
inherited;
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
var
|
||||
WorldP: TPointF;
|
||||
Hit: TVisualNode;
|
||||
begin
|
||||
inherited;
|
||||
// Capture Keyboard Focus
|
||||
if CanFocus then
|
||||
SetFocus;
|
||||
|
||||
if not FIsDraggingNode and (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) then
|
||||
WorldP := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
|
||||
|
||||
if (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) and (ssCtrl in Shift) then
|
||||
begin
|
||||
FIsPanning := True;
|
||||
FLastMousePos := TPointF.Create(X, Y);
|
||||
Root.Captured := Self;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if Assigned(FRootNode) then
|
||||
begin
|
||||
Hit := FRootNode.HitTest(WorldP);
|
||||
|
||||
if Assigned(Hit) then
|
||||
begin
|
||||
FCapturedNode := Hit;
|
||||
var NodeLocal := Hit.AbsoluteToLocal(WorldP);
|
||||
Hit.MouseDown(Button, Shift, NodeLocal.X, NodeLocal.Y);
|
||||
end
|
||||
else if Button = TMouseButton.mbLeft then
|
||||
begin
|
||||
FIsPanning := True;
|
||||
FLastMousePos := TPointF.Create(X, Y);
|
||||
Root.Captured := Self;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
var
|
||||
LCurrentPos: TPointF;
|
||||
LDelta: TPointF;
|
||||
LWorldPos: TPointF;
|
||||
WorldP: TPointF;
|
||||
LocalP: TPointF;
|
||||
Hit: TVisualNode;
|
||||
Delta: TPointF;
|
||||
begin
|
||||
inherited;
|
||||
LocalP := TPointF.Create(X, Y);
|
||||
WorldP := ScreenToWorld(LocalToScreen(LocalP));
|
||||
|
||||
if FIsDraggingNode then
|
||||
begin
|
||||
if Assigned(FDragVisual) then
|
||||
begin
|
||||
LWorldPos := ScreenToWorld(Screen.MousePos);
|
||||
FDragVisual.Position.Point := LWorldPos - FDragOffset;
|
||||
end;
|
||||
|
||||
UpdateDropMarker(Screen.MousePos);
|
||||
|
||||
FRootLayer.Repaint;
|
||||
FDragVisualPos := WorldP - FDragOffset;
|
||||
UpdateDropMarker(WorldP);
|
||||
Repaint;
|
||||
end
|
||||
else if FIsPanning then
|
||||
begin
|
||||
LCurrentPos := TPointF.Create(X, Y);
|
||||
LDelta := LCurrentPos - FLastMousePos;
|
||||
Delta := LocalP - FLastMousePos;
|
||||
FContentOffset := FContentOffset + Delta;
|
||||
FLastMousePos := LocalP;
|
||||
Repaint;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if Assigned(FCapturedNode) then
|
||||
begin
|
||||
var NodeLocal := FCapturedNode.AbsoluteToLocal(WorldP);
|
||||
FCapturedNode.MouseMove(Shift, NodeLocal.X, NodeLocal.Y);
|
||||
end
|
||||
else if Assigned(FRootNode) then
|
||||
begin
|
||||
Hit := FRootNode.HitTest(WorldP);
|
||||
if Hit <> FMouseOverNode then
|
||||
begin
|
||||
if Assigned(FMouseOverNode) then
|
||||
FMouseOverNode.MouseLeave;
|
||||
FMouseOverNode := Hit;
|
||||
if Assigned(FMouseOverNode) then
|
||||
FMouseOverNode.MouseEnter;
|
||||
end;
|
||||
|
||||
FRootLayer.Position.Point := FRootLayer.Position.Point + LDelta;
|
||||
|
||||
FLastMousePos := LCurrentPos;
|
||||
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 := ScreenToWorld(LocalToScreen(TPointF.Create(X, Y)));
|
||||
|
||||
if FIsDraggingNode then
|
||||
begin
|
||||
StopDrag;
|
||||
@@ -424,68 +336,192 @@ begin
|
||||
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
|
||||
LOldZoom, LNewZoom: Single;
|
||||
LScaleRatio: Single;
|
||||
LMousePosLocal: TPointF;
|
||||
LOffset: TPointF;
|
||||
OldZoom: Single;
|
||||
LocalP, OffsetLocal: TPointF;
|
||||
begin
|
||||
LOldZoom := Zoom;
|
||||
OldZoom := FZoom;
|
||||
|
||||
if WheelDelta > 0 then
|
||||
LNewZoom := LOldZoom + ZoomStep
|
||||
SetZoom(FZoom + ZoomStep)
|
||||
else
|
||||
LNewZoom := LOldZoom - ZoomStep;
|
||||
SetZoom(FZoom - ZoomStep);
|
||||
|
||||
LNewZoom := EnsureRange(LNewZoom, MinZoom, MaxZoom);
|
||||
|
||||
if not SameValue(LNewZoom, LOldZoom, TEpsilon.Vector) then
|
||||
if not SameValue(OldZoom, FZoom, TEpsilon.Position) then
|
||||
begin
|
||||
LMousePosLocal := ScreenToLocal(Screen.MousePos);
|
||||
LOffset := LMousePosLocal - FRootLayer.Position.Point;
|
||||
LScaleRatio := LNewZoom / LOldZoom;
|
||||
|
||||
FRootLayer.Position.Point := LMousePosLocal - (LOffset * LScaleRatio);
|
||||
SetZoom(LNewZoom);
|
||||
LocalP := ScreenToLocal(Screen.MousePos);
|
||||
OffsetLocal := LocalP - FContentOffset;
|
||||
FContentOffset := LocalP - (OffsetLocal * (FZoom / OldZoom));
|
||||
Repaint;
|
||||
end;
|
||||
Handled := True;
|
||||
|
||||
if not Handled then
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TWorkspace.GetZoom: Single;
|
||||
procedure TWorkspace.BeginDragNode(ASource: TVisualNode);
|
||||
var
|
||||
Bitmap: TBitmap;
|
||||
Scale: Single;
|
||||
begin
|
||||
Result := FRootLayer.Scale.X;
|
||||
if FIsDraggingNode or FIsPanning then
|
||||
Exit;
|
||||
if ASource = nil then
|
||||
Exit;
|
||||
|
||||
FIsDraggingNode := True;
|
||||
FDragSource := ASource;
|
||||
Root.Captured := Self;
|
||||
|
||||
Scale := Scene.GetSceneScale;
|
||||
Bitmap := TBitmap.Create(Round(ASource.Size.Width * Scale), Round(ASource.Size.Height * Scale));
|
||||
Bitmap.BitmapScale := Scale;
|
||||
|
||||
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.SetZoom(const Value: Single);
|
||||
procedure TWorkspace.UpdateDropMarker(const WorldPos: TPointF);
|
||||
var
|
||||
Hit: TVisualNode;
|
||||
TargetContainer: TAutoFitLayout;
|
||||
IsHorizontal: Boolean;
|
||||
InsertIndex: Integer;
|
||||
Child: TVisualNode;
|
||||
P1, P2: TPointF;
|
||||
AbsP: TPointF;
|
||||
begin
|
||||
FRootLayer.Scale.Point := TPointF.Create(Value, Value);
|
||||
FShowDropMarker := False;
|
||||
FCurrentDropTarget := nil;
|
||||
FCurrentDropIndex := -1;
|
||||
|
||||
if FDragSource = nil then
|
||||
Exit;
|
||||
|
||||
Hit := FRootNode.HitTest(WorldPos);
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
function TWorkspace.GetContentOffset: TPointF;
|
||||
procedure TWorkspace.StopDrag;
|
||||
begin
|
||||
Result := FRootLayer.Position.Point;
|
||||
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.SetContentOffset(const Value: TPointF);
|
||||
procedure TWorkspace.InvalidateConnections;
|
||||
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;
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user