Ast editor unit refactoring
This commit is contained in:
Michael Schimmel
File diff suppressed because one or more lines are too long
@@ -12,9 +12,6 @@ uses
|
||||
Myc.Ast.RTL in '..\Src\AST\Myc.Ast.RTL.pas',
|
||||
Myc.Ast.Dumper in '..\Src\AST\Myc.Ast.Dumper.pas',
|
||||
Myc.Ast.RTL.Core in '..\Src\AST\Myc.Ast.RTL.Core.pas',
|
||||
Myc.Fmx.AstEditor.Node in 'Myc.Fmx.AstEditor.Node.pas',
|
||||
Myc.Fmx.AstEditor.Workspace in 'Myc.Fmx.AstEditor.Workspace.pas',
|
||||
Myc.Fmx.AstEditor.Text in 'Myc.Fmx.AstEditor.Text.pas',
|
||||
Myc.Utils in '..\Src\Myc.Utils.pas',
|
||||
Myc.Ast.Script in '..\Src\AST\Myc.Ast.Script.pas',
|
||||
Myc.Ast.Types in '..\Src\AST\Myc.Ast.Types.pas',
|
||||
@@ -28,7 +25,11 @@ uses
|
||||
Myc.Ast.Environment in '..\Src\AST\Myc.Ast.Environment.pas',
|
||||
Myc.Ast.Debugger in '..\Src\AST\Myc.Ast.Debugger.pas',
|
||||
Myc.Ast.Analysis.Purity in '..\Src\AST\Myc.Ast.Analysis.Purity.pas',
|
||||
Myc.Ast.Identities in '..\Src\AST\Myc.Ast.Identities.pas';
|
||||
Myc.Ast.Identities in '..\Src\AST\Myc.Ast.Identities.pas',
|
||||
Myc.Fmx.AstEditor.Core in '..\Src\AST\Myc.Fmx.AstEditor.Core.pas',
|
||||
Myc.Fmx.AstEditor.Handlers in '..\Src\AST\Myc.Fmx.AstEditor.Handlers.pas',
|
||||
Myc.Fmx.AstEditor.Visualizer in '..\Src\AST\Myc.Fmx.AstEditor.Visualizer.pas',
|
||||
Myc.Fmx.AstEditor.Workspace in '..\Src\AST\Myc.Fmx.AstEditor.Workspace.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@@ -142,9 +142,6 @@
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Dumper.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.RTL.Core.pas"/>
|
||||
<DCCReference Include="Myc.Fmx.AstEditor.Node.pas"/>
|
||||
<DCCReference Include="Myc.Fmx.AstEditor.Workspace.pas"/>
|
||||
<DCCReference Include="Myc.Fmx.AstEditor.Text.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Utils.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Script.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Types.pas"/>
|
||||
@@ -159,6 +156,10 @@
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Debugger.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Analysis.Purity.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Ast.Identities.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Core.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Handlers.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Visualizer.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Workspace.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -32,7 +32,7 @@ uses
|
||||
Myc.Ast.Script,
|
||||
FMX.Layouts,
|
||||
FMX.Objects,
|
||||
Myc.Fmx.AstEditor.Node,
|
||||
Myc.Fmx.AstEditor.Core,
|
||||
Myc.Fmx.AstEditor.Workspace,
|
||||
FMX.DialogService,
|
||||
FMX.ListView.Types,
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,265 +0,0 @@
|
||||
unit Myc.Fmx.AstEditor.Text;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
Myc.Data.Value,
|
||||
Myc.Data.Scalar,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Nodes;
|
||||
|
||||
type
|
||||
// This visitor converts an AST expression subtree into a single string.
|
||||
// It inherits from the generic visitor, returning a 'string' for each node.
|
||||
TAstToTextVisitor = class(TAstVisitor<string>)
|
||||
protected
|
||||
function VisitConstant(const Node: IConstantNode): string; override;
|
||||
function VisitIdentifier(const Node: IIdentifierNode): string; override;
|
||||
function VisitKeyword(const Node: IKeywordNode): string; override;
|
||||
function VisitIfExpression(const Node: IIfExpressionNode): string; override;
|
||||
function VisitTernaryExpression(const Node: ITernaryExpressionNode): string; override;
|
||||
function VisitLambdaExpression(const Node: ILambdaExpressionNode): string; override;
|
||||
function VisitMacroDefinition(const Node: IMacroDefinitionNode): string; override;
|
||||
function VisitFunctionCall(const Node: IFunctionCallNode): string; override;
|
||||
function VisitMacroExpansionNode(const Node: IMacroExpansionNode): string; override;
|
||||
function VisitBlockExpression(const Node: IBlockExpressionNode): string; override;
|
||||
function VisitVariableDeclaration(const Node: IVariableDeclarationNode): string; override;
|
||||
function VisitAssignment(const Node: IAssignmentNode): string; override;
|
||||
function VisitIndexer(const Node: IIndexerNode): string; override;
|
||||
function VisitMemberAccess(const Node: IMemberAccessNode): string; override;
|
||||
function VisitQuasiquote(const Node: IQuasiquoteNode): string; override;
|
||||
function VisitUnquote(const Node: IUnquoteNode): string; override;
|
||||
function VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string; override;
|
||||
function VisitCreateSeries(const Node: ICreateSeriesNode): string; override;
|
||||
function VisitAddSeriesItem(const Node: IAddSeriesItemNode): string; override;
|
||||
function VisitSeriesLength(const Node: ISeriesLengthNode): string; override;
|
||||
function VisitRecurNode(const Node: IRecurNode): string; override;
|
||||
function VisitRecordLiteral(const Node: IRecordLiteralNode): string; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Classes, // For TStringBuilder
|
||||
Myc.Data.Keyword;
|
||||
|
||||
{ TAstToTextVisitor }
|
||||
|
||||
function TAstToTextVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): string;
|
||||
var
|
||||
seriesStr, valueStr, lookbackStr: string;
|
||||
begin
|
||||
seriesStr := Accept(Node.Series);
|
||||
valueStr := Accept(Node.Value);
|
||||
lookbackStr := '';
|
||||
if Assigned(Node.Lookback) then
|
||||
lookbackStr := ', ' + Accept(Node.Lookback);
|
||||
Result := Format('%s.add(%s%s)', [seriesStr, valueStr, lookbackStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitAssignment(const Node: IAssignmentNode): string;
|
||||
begin
|
||||
Result := Accept(Node.Target) + ' := ' + Accept(Node.Value);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitBlockExpression(const Node: IBlockExpressionNode): string;
|
||||
begin
|
||||
Result := '{...}';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitConstant(const Node: IConstantNode): string;
|
||||
begin
|
||||
Result := Node.Value.ToString;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): string;
|
||||
begin
|
||||
Result := 'new series(' + Node.Definition + ')';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitFunctionCall(const Node: IFunctionCallNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
calleeStr: string;
|
||||
begin
|
||||
calleeStr := Accept(Node.Callee);
|
||||
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append(calleeStr);
|
||||
sb.Append('(');
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
begin
|
||||
sb.Append(Accept(Node.Arguments[i]));
|
||||
if i < High(Node.Arguments) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
sb.Append(')');
|
||||
Result := sb.ToString;
|
||||
finally
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMacroExpansionNode(const Node: IMacroExpansionNode): string;
|
||||
begin
|
||||
// To represent a macro expansion as a single line of text, the most
|
||||
// informative representation is the original call itself. We can simply
|
||||
// delegate to the VisitFunctionCall implementation to format it.
|
||||
Result := VisitFunctionCall(Node.CallNode);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitRecurNode(const Node: IRecurNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append('recur(');
|
||||
for i := 0 to High(Node.Arguments) do
|
||||
begin
|
||||
sb.Append(Accept(Node.Arguments[i]));
|
||||
if i < High(Node.Arguments) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
sb.Append(')');
|
||||
Result := sb.ToString;
|
||||
finally
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIdentifier(const Node: IIdentifierNode): string;
|
||||
begin
|
||||
Result := Node.Name;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIfExpression(const Node: IIfExpressionNode): string;
|
||||
begin
|
||||
Result := Accept(Node.Condition);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitIndexer(const Node: IIndexerNode): string;
|
||||
var
|
||||
baseStr, indexStr: string;
|
||||
begin
|
||||
baseStr := Accept(Node.Base);
|
||||
indexStr := Accept(Node.Index);
|
||||
Result := Format('%s[%s]', [baseStr, indexStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitKeyword(const Node: IKeywordNode): string;
|
||||
begin
|
||||
Result := ':' + Node.Value.Name;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitLambdaExpression(const Node: ILambdaExpressionNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append(WideChar($03BB) + '('); // Lambda char
|
||||
if Length(Node.Parameters) > 0 then
|
||||
begin
|
||||
for i := 0 to High(Node.Parameters) do
|
||||
begin
|
||||
sb.Append(Node.Parameters[i].Name);
|
||||
if i < High(Node.Parameters) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
end;
|
||||
sb.Append(') => {...}');
|
||||
Result := sb.ToString;
|
||||
finally
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMacroDefinition(const Node: IMacroDefinitionNode): string;
|
||||
var
|
||||
i: Integer;
|
||||
sb: TStringBuilder;
|
||||
begin
|
||||
// Added text representation for macro definitions.
|
||||
sb := TStringBuilder.Create;
|
||||
try
|
||||
sb.Append('defmacro ');
|
||||
sb.Append(Node.Name.Name);
|
||||
sb.Append('(');
|
||||
if Length(Node.Parameters) > 0 then
|
||||
begin
|
||||
for i := 0 to High(Node.Parameters) do
|
||||
begin
|
||||
sb.Append(Node.Parameters[i].Name);
|
||||
if i < High(Node.Parameters) then
|
||||
sb.Append(', ');
|
||||
end;
|
||||
end;
|
||||
sb.Append(') => {...}');
|
||||
Result := sb.ToString;
|
||||
finally
|
||||
sb.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitMemberAccess(const Node: IMemberAccessNode): string;
|
||||
var
|
||||
baseStr: string;
|
||||
begin
|
||||
baseStr := Accept(Node.Base);
|
||||
Result := Format('%s.%s', [baseStr, Node.Member.Value.Name]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitQuasiquote(const Node: IQuasiquoteNode): string;
|
||||
begin
|
||||
Result := '`' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): string;
|
||||
begin
|
||||
Result := '{...}';
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitUnquote(const Node: IUnquoteNode): string;
|
||||
begin
|
||||
Result := '~' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitUnquoteSplicing(const Node: IUnquoteSplicingNode): string;
|
||||
begin
|
||||
Result := '~@' + Accept(Node.Expression);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitSeriesLength(const Node: ISeriesLengthNode): string;
|
||||
var
|
||||
seriesStr: string;
|
||||
begin
|
||||
seriesStr := Accept(Node.Series);
|
||||
Result := Format('length(%s)', [seriesStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitTernaryExpression(const Node: ITernaryExpressionNode): string;
|
||||
begin
|
||||
var condStr := Accept(Node.Condition);
|
||||
var thenStr := Accept(Node.ThenBranch);
|
||||
var elseStr := Accept(Node.ElseBranch);
|
||||
Result := Format('(%s ? %s : %s)', [condStr, thenStr, elseStr]);
|
||||
end;
|
||||
|
||||
function TAstToTextVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): string;
|
||||
var
|
||||
initStr: string;
|
||||
begin
|
||||
if Assigned(Node.Initializer) then
|
||||
initStr := ' := ' + Accept(Node.Initializer)
|
||||
else
|
||||
initStr := '';
|
||||
Result := 'var ' + Accept(Node.Target) + initStr;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -1,244 +0,0 @@
|
||||
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,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Compiler.Binder;
|
||||
|
||||
const
|
||||
cDataPinColor = TAlphaColors.Dodgerblue;
|
||||
cExecPinColor = TAlphaColors.Lightgreen;
|
||||
|
||||
type
|
||||
TPinConnection = record
|
||||
OutputPin: TControl;
|
||||
InputPin: TControl;
|
||||
constructor Create(AOutputPin, AInputPin: TControl);
|
||||
end;
|
||||
|
||||
TAuraWorkspace = class(TStyledControl)
|
||||
private
|
||||
FConnections: TArray<TPinConnection>;
|
||||
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;
|
||||
|
||||
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.Node;
|
||||
|
||||
{ TPinConnection }
|
||||
|
||||
constructor TPinConnection.Create(AOutputPin, AInputPin: TControl);
|
||||
begin
|
||||
OutputPin := AOutputPin;
|
||||
InputPin := AInputPin;
|
||||
end;
|
||||
|
||||
{ TAuraWorkspace }
|
||||
|
||||
constructor TAuraWorkspace.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
FZoom := 1.0;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.Build(const RootNode: IAstNode; const Position: TPointF);
|
||||
begin
|
||||
var visu := TAstVisualizer.Create(Self, Self, 0) as IAstVisualizer;
|
||||
visu.CallAccept(RootNode);
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.DoDeleteChildren;
|
||||
begin
|
||||
FConnections := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAuraWorkspace.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;
|
||||
|
||||
procedure TAuraWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) and (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then
|
||||
begin
|
||||
FIsPanning := True;
|
||||
FLastPanPos := TPointF.Create(X, Y);
|
||||
Cursor := crHandPoint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
var
|
||||
delta: TPointF;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
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 TAuraWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
if (Button = TMouseButton.mbLeft) and (FIsPanning) then
|
||||
begin
|
||||
FIsPanning := False;
|
||||
Cursor := crDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
begin
|
||||
inherited;
|
||||
Handled := Zoom(IfThen(WheelDelta > 0, FZoom * 1.1, FZoom / 1.1));
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.DblClick;
|
||||
begin
|
||||
inherited;
|
||||
Zoom(1.0);
|
||||
end;
|
||||
|
||||
procedure TAuraWorkspace.Paint;
|
||||
var
|
||||
connection: TPinConnection;
|
||||
startPoint, endPoint, pinCenter: TPointF;
|
||||
path: TPathData;
|
||||
controlPoint1, controlPoint2: TPointF;
|
||||
controlOffset: Single;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Thickness := 2;
|
||||
|
||||
for connection in FConnections do
|
||||
begin
|
||||
pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2);
|
||||
var absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2);
|
||||
var absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter);
|
||||
|
||||
startPoint := AbsoluteToLocal(absoluteStart);
|
||||
endPoint := AbsoluteToLocal(absoluteEnd);
|
||||
|
||||
var 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 TAuraWorkspace.Zoom(Factor: Single): Boolean;
|
||||
var
|
||||
MouseService: IFMXMouseService;
|
||||
begin
|
||||
Result := TPlatformServices.Current.SupportsPlatformService(IFMXMouseService, MouseService);
|
||||
if Result then
|
||||
begin
|
||||
var MousePos := ScreenToLocal(MouseService.GetMousePos);
|
||||
Factor := Max(0.2, Min(3.0, Factor));
|
||||
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.
|
||||
Reference in New Issue
Block a user