Focus & cursor movement in UI
This commit is contained in:
Michael Schimmel
File diff suppressed because one or more lines are too long
@@ -29,9 +29,9 @@ uses
|
||||
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',
|
||||
Myc.Fmx.AstEditor.Controller in '..\Src\AST\Myc.Fmx.AstEditor.Controller.pas',
|
||||
Myc.Fmx.AstEditor in '..\Src\AST\Myc.Fmx.AstEditor.pas',
|
||||
Myc.Fmx.AstEditor.Layout in '..\Src\AST\Myc.Fmx.AstEditor.Layout.pas';
|
||||
Myc.Fmx.AstEditor.Layout in '..\Src\AST\Myc.Fmx.AstEditor.Layout.pas',
|
||||
Myc.Fmx.AstEditor.Node in '..\Src\AST\Myc.Fmx.AstEditor.Node.pas',
|
||||
Myc.Fmx.AstEditor in '..\Src\AST\Myc.Fmx.AstEditor.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
|
||||
@@ -159,9 +159,9 @@
|
||||
<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"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Controller.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Layout.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.Node.pas"/>
|
||||
<DCCReference Include="..\Src\AST\Myc.Fmx.AstEditor.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
+30
-40
@@ -44,9 +44,7 @@ uses
|
||||
Myc.Ast.RTL,
|
||||
Myc.Ast.Compiler.Macros,
|
||||
// Editor Units
|
||||
Myc.Fmx.AstEditor,
|
||||
Myc.Fmx.AstEditor.Workspace,
|
||||
Myc.Fmx.AstEditor.Controller; // Controller integration
|
||||
Myc.Fmx.AstEditor; // Die neue Komponente (ersetzt Controller und Workspace-Access)
|
||||
|
||||
type
|
||||
// A test record
|
||||
@@ -93,7 +91,6 @@ type
|
||||
procedure ClearButtonClick(Sender: TObject);
|
||||
procedure CompilerStageBoxChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure CreateTriggerExampleButtonClick(Sender: TObject);
|
||||
procedure DebugBoxChange(Sender: TObject);
|
||||
procedure DoTrigger2ButtonClick(Sender: TObject);
|
||||
@@ -119,17 +116,16 @@ type
|
||||
FCurrUnboundAst: IAstNode;
|
||||
FCurrExec: TCompiledFunction;
|
||||
FEnvironment: TAstEnvironment;
|
||||
FWorkspace: TWorkspace; // Changed to TWorkspace
|
||||
FController: TAstEditorController; // The UI Controller
|
||||
FAstEditor: TAstEditor; // Die Komponente (Facade)
|
||||
FScriptUpdate: Boolean;
|
||||
FTriggerTest: TAstEnvironment;
|
||||
|
||||
procedure WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
procedure AstEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
|
||||
// Helper function to encapsulate the Compile -> Evaluate pattern
|
||||
function ExecuteAst(const ANode: IAstNode): TDataValue;
|
||||
procedure UpdateScript;
|
||||
procedure ShowVizualization(X, Y: Single);
|
||||
procedure ShowVizualization;
|
||||
procedure PrintScript(const Node: IAstNode);
|
||||
public
|
||||
{ Public declarations }
|
||||
@@ -158,19 +154,20 @@ begin
|
||||
// 1. Initialize Environment
|
||||
FEnvironment := TAstEnvironment.Construct(TAst.CreateScope(nil));
|
||||
|
||||
// 2. Initialize Workspace
|
||||
// TWorkspace is now a simple viewport control
|
||||
FWorkspace := TWorkspace.Create(Panel2);
|
||||
FWorkspace.Parent := Panel2;
|
||||
FWorkspace.Align := TAlignLayout.Client;
|
||||
FWorkspace.ClipChildren := true;
|
||||
FWorkspace.OnMouseDown := WorkspaceMouseDown;
|
||||
// 2. Initialize AST Editor Component
|
||||
// This replaces the manual Workspace + Controller setup.
|
||||
// The Editor encapsulates logic for Navigation, Zoom, Drag&Drop, Undo/Redo.
|
||||
FAstEditor := TAstEditor.Create(Self);
|
||||
FAstEditor.Parent := Panel2;
|
||||
FAstEditor.Align := TAlignLayout.Client;
|
||||
|
||||
// 3. Initialize Controller (connects Env and Workspace)
|
||||
// The Controller will manage the nodes inside FWorkspace.World
|
||||
FController := TAstEditorController.Create(FEnvironment, FWorkspace);
|
||||
// Wire up events exposed by the component
|
||||
FAstEditor.OnMouseDown := AstEditorMouseDown;
|
||||
|
||||
// 4. Register the SMA factory into the environment
|
||||
// Initialize the logic backend of the editor
|
||||
FAstEditor.Init(FEnvironment);
|
||||
|
||||
// 3. Register the SMA factory into the environment
|
||||
var RegFunc :=
|
||||
procedure(const Scope: IExecutionScope)
|
||||
var
|
||||
@@ -286,19 +283,13 @@ begin
|
||||
ClearButtonClick(Self);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FController.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.ShowVizualization(X, Y: Single);
|
||||
procedure TForm1.ShowVizualization;
|
||||
begin
|
||||
if FCurrUnboundAst = nil then
|
||||
exit;
|
||||
|
||||
// Use the Controller to build, validate and show the UI
|
||||
// The controller internally clears FWorkspace.World and adds nodes there.
|
||||
FController.SetRoot(FCurrUnboundAst);
|
||||
// Use the Editor Component to build, validate and show the UI
|
||||
FAstEditor.SetRoot(FCurrUnboundAst);
|
||||
end;
|
||||
|
||||
// Simplified ExecuteAst using TEnvironment and handling errors gracefully
|
||||
@@ -422,14 +413,13 @@ end;
|
||||
|
||||
procedure TForm1.ClearButtonClick(Sender: TObject);
|
||||
begin
|
||||
// Clear content of world (not workspace itself, as it has the root layer)
|
||||
FWorkspace.World.DeleteChildren;
|
||||
FWorkspace.World.Repaint;
|
||||
// Clear content of component
|
||||
FAstEditor.SetRoot(nil);
|
||||
end;
|
||||
|
||||
procedure TForm1.CompilerStageBoxChange(Sender: TObject);
|
||||
begin
|
||||
ShowVizualization(14, 14);
|
||||
ShowVizualization;
|
||||
end;
|
||||
|
||||
procedure TForm1.CreateTriggerExampleButtonClick(Sender: TObject);
|
||||
@@ -731,8 +721,8 @@ begin
|
||||
var result := ExecuteAst(FCurrUnboundAst);
|
||||
Memo1.Lines.Add(Format('Script executed. Final result: %s', [result.ToString]));
|
||||
finally
|
||||
// Trigger visualization update via Controller (inside ShowVizualization)
|
||||
ShowVizualization(14, 14);
|
||||
// Trigger visualization update via Component
|
||||
ShowVizualization;
|
||||
end;
|
||||
except
|
||||
on E: Exception do
|
||||
@@ -890,15 +880,15 @@ procedure TForm1.UpdateScript;
|
||||
begin
|
||||
PrintScript(FCurrUnboundAst);
|
||||
|
||||
// Clear and redraw via Controller
|
||||
FController.SetRoot(FCurrUnboundAst);
|
||||
// Clear and redraw via Component
|
||||
FAstEditor.SetRoot(FCurrUnboundAst);
|
||||
end;
|
||||
|
||||
procedure TForm1.WorkspaceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
procedure TForm1.AstEditorMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
if Button <> TMouseButton.mbMiddle then
|
||||
exit;
|
||||
ShowVizualization(X, Y);
|
||||
// Nur zur Demo: Wir könnten hier klicken, um etwas im Memo zu loggen
|
||||
if Button = TMouseButton.mbMiddle then
|
||||
ShowVizualization;
|
||||
end;
|
||||
|
||||
procedure TForm1.SaveUserLibButtonClick(Sender: TObject);
|
||||
|
||||
@@ -1,432 +0,0 @@
|
||||
unit Myc.Fmx.AstEditor.Controller;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Types,
|
||||
System.Math.Vectors,
|
||||
System.Generics.Collections,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
Myc.Ast,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Identities,
|
||||
Myc.Ast.Types,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Ast.Scope,
|
||||
Myc.Ast.Environment,
|
||||
Myc.Fmx.AstEditor,
|
||||
Myc.Fmx.AstEditor.Workspace;
|
||||
|
||||
type
|
||||
TAstEditorController = class
|
||||
private
|
||||
type
|
||||
TNodeMap = TDictionary<IAstIdentity, TAstViewNode>;
|
||||
TUndoStack = TStack<IAstNode>;
|
||||
|
||||
TTypePropagator = class(TAstVisitor)
|
||||
private
|
||||
FMap: TNodeMap;
|
||||
procedure ApplyType(const Node: IAstNode);
|
||||
protected
|
||||
procedure Accept(const Node: IAstNode); override;
|
||||
public
|
||||
constructor Create(AMap: TNodeMap);
|
||||
end;
|
||||
|
||||
private
|
||||
FEnv: TAstEnvironment;
|
||||
FWorkspace: TWorkspace;
|
||||
FNodeMap: TNodeMap;
|
||||
FRootViewNode: TAstViewNode;
|
||||
|
||||
// State Tracking
|
||||
FCurrentAst: IAstNode;
|
||||
|
||||
// Undo/Redo Stacks
|
||||
FUndoStack: TUndoStack;
|
||||
FRedoStack: TUndoStack;
|
||||
FIsUndoing: Boolean;
|
||||
|
||||
procedure CollectNodes(Parent: TControl);
|
||||
procedure ClearVisuals;
|
||||
procedure ApplyErrors(const Log: ICompilerLog);
|
||||
procedure ApplyTypes(const TypedAst: IAstNode);
|
||||
procedure RootResized(Sender: TObject);
|
||||
|
||||
procedure HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
|
||||
|
||||
procedure CommitSnapshot;
|
||||
|
||||
public
|
||||
constructor Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure ValidateAndShow;
|
||||
procedure SetRoot(const AstNode: IAstNode);
|
||||
|
||||
procedure Undo;
|
||||
procedure Redo;
|
||||
function CanUndo: Boolean;
|
||||
function CanRedo: Boolean;
|
||||
|
||||
// Expose current AST for external use (saving etc.)
|
||||
property CurrentAst: IAstNode read FCurrentAst;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Data.Value,
|
||||
Myc.Fmx.AstEditor.Visualizer;
|
||||
|
||||
{ TAstEditorController }
|
||||
|
||||
constructor TAstEditorController.Create(const AEnv: TAstEnvironment; AWorkspace: TWorkspace);
|
||||
begin
|
||||
inherited Create;
|
||||
FEnv := AEnv;
|
||||
FWorkspace := AWorkspace;
|
||||
FWorkspace.OnNodeDragDrop := HandleNodeDragDrop;
|
||||
FNodeMap := TNodeMap.Create;
|
||||
|
||||
FUndoStack := TUndoStack.Create;
|
||||
FRedoStack := TUndoStack.Create;
|
||||
FIsUndoing := False;
|
||||
FCurrentAst := nil;
|
||||
end;
|
||||
|
||||
destructor TAstEditorController.Destroy;
|
||||
begin
|
||||
// Cleaning up FCurrentAst is done by ARC automatically
|
||||
SetRoot(nil);
|
||||
FNodeMap.Free;
|
||||
FUndoStack.Free;
|
||||
FRedoStack.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.CommitSnapshot;
|
||||
begin
|
||||
// Optimization: Push the already known AST instead of recreating it from UI.
|
||||
// Since AST nodes are immutable interfaces, storing the reference is safe.
|
||||
if Assigned(FCurrentAst) and (not FIsUndoing) then
|
||||
begin
|
||||
FUndoStack.Push(FCurrentAst);
|
||||
FRedoStack.Clear;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.Undo;
|
||||
var
|
||||
prevAst: IAstNode;
|
||||
begin
|
||||
if FUndoStack.Count = 0 then
|
||||
exit;
|
||||
|
||||
FIsUndoing := True;
|
||||
try
|
||||
// Capture current state for Redo
|
||||
if Assigned(FCurrentAst) then
|
||||
FRedoStack.Push(FCurrentAst);
|
||||
|
||||
// Restore previous state
|
||||
prevAst := FUndoStack.Pop;
|
||||
SetRoot(prevAst);
|
||||
finally
|
||||
FIsUndoing := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.Redo;
|
||||
var
|
||||
nextAst: IAstNode;
|
||||
begin
|
||||
if FRedoStack.Count = 0 then
|
||||
exit;
|
||||
|
||||
FIsUndoing := True;
|
||||
try
|
||||
// Capture current state for Undo
|
||||
if Assigned(FCurrentAst) then
|
||||
FUndoStack.Push(FCurrentAst);
|
||||
|
||||
// Restore next state
|
||||
nextAst := FRedoStack.Pop;
|
||||
SetRoot(nextAst);
|
||||
finally
|
||||
FIsUndoing := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TAstEditorController.CanUndo: Boolean;
|
||||
begin
|
||||
Result := FUndoStack.Count > 0;
|
||||
end;
|
||||
|
||||
function TAstEditorController.CanRedo: Boolean;
|
||||
begin
|
||||
Result := FRedoStack.Count > 0;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.HandleNodeDragDrop(ASource, ATarget: TControl; AIndex: Integer);
|
||||
var
|
||||
SourceParent: TControl;
|
||||
ContainerOwner: TAstViewNode;
|
||||
Reorderable: IReorderable;
|
||||
SourceIdx, TargetIdx: Integer;
|
||||
NewAst: IAstNode;
|
||||
begin
|
||||
if (ASource = nil) or (AIndex < 0) then
|
||||
exit;
|
||||
if not (ASource is TAstViewNode) then
|
||||
exit;
|
||||
|
||||
if not (ASource.Parent is TControl) then
|
||||
exit;
|
||||
SourceParent := TControl(ASource.Parent);
|
||||
|
||||
ContainerOwner := nil;
|
||||
|
||||
// Logic to find the Reorderable container (same as before)
|
||||
if (SourceParent is TAstViewNode) then
|
||||
begin
|
||||
ContainerOwner := TAstViewNode(SourceParent);
|
||||
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
|
||||
ContainerOwner := nil;
|
||||
end;
|
||||
|
||||
if (ContainerOwner = nil) and (SourceParent.Parent is TAstViewNode) then
|
||||
begin
|
||||
ContainerOwner := TAstViewNode(SourceParent.Parent);
|
||||
if not Supports(ContainerOwner.Handler, IReorderable, Reorderable) then
|
||||
ContainerOwner := nil;
|
||||
end;
|
||||
|
||||
if (ContainerOwner <> nil) and (Reorderable <> nil) then
|
||||
begin
|
||||
if Reorderable.CanDrag(ASource) then
|
||||
begin
|
||||
SourceIdx := ASource.Index;
|
||||
TargetIdx := AIndex;
|
||||
|
||||
if SourceIdx <> TargetIdx then
|
||||
begin
|
||||
// 1. Commit the CURRENT (clean) AST before visual changes
|
||||
CommitSnapshot;
|
||||
|
||||
// 2. Perform Visual Change (Dirty State)
|
||||
Reorderable.MoveChild(SourceIdx, TargetIdx);
|
||||
|
||||
// 3. Generate NEW AST from the modified visual tree
|
||||
NewAst := FRootViewNode.CreateAst;
|
||||
|
||||
// 4. Update the system with the new AST (Updates FCurrentAst)
|
||||
SetRoot(NewAst);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.SetRoot(const AstNode: IAstNode);
|
||||
var
|
||||
Visualizer: IAstVisualizer;
|
||||
begin
|
||||
// Update the "Truth"
|
||||
FCurrentAst := AstNode;
|
||||
|
||||
if not FIsUndoing then
|
||||
begin
|
||||
FUndoStack.Clear;
|
||||
FRedoStack.Clear;
|
||||
end;
|
||||
|
||||
FWorkspace.World.DeleteChildren;
|
||||
if Assigned(FRootViewNode) then
|
||||
FRootViewNode.OnResized := nil;
|
||||
FRootViewNode := nil;
|
||||
|
||||
if not Assigned(AstNode) then
|
||||
exit;
|
||||
|
||||
Visualizer := TAstVisualizer.Create(FWorkspace, FWorkspace.World, 0);
|
||||
FRootViewNode := Visualizer.CallAccept(AstNode);
|
||||
|
||||
if Assigned(FRootViewNode) then
|
||||
begin
|
||||
FWorkspace.World.Size := FRootViewNode.Size;
|
||||
FRootViewNode.OnResized := RootResized;
|
||||
FRootViewNode.Position.Point := TPointF.Create(50, 50);
|
||||
end;
|
||||
|
||||
if Assigned(FRootViewNode) then
|
||||
ValidateAndShow;
|
||||
end;
|
||||
|
||||
// ... (Rest: CollectNodes, ClearVisuals, ApplyErrors, ApplyTypes, RootResized, TTypePropagator bleiben gleich)
|
||||
|
||||
procedure TAstEditorController.CollectNodes(Parent: TControl);
|
||||
var
|
||||
i: Integer;
|
||||
child: TControl;
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
for i := 0 to Parent.ChildrenCount - 1 do
|
||||
begin
|
||||
if Parent.Children[i] is TControl then
|
||||
begin
|
||||
child := TControl(Parent.Children[i]);
|
||||
|
||||
if child is TAstViewNode then
|
||||
begin
|
||||
viewNode := TAstViewNode(child);
|
||||
if Assigned(viewNode.Node) and Assigned(viewNode.Node.Identity) then
|
||||
begin
|
||||
FNodeMap.AddOrSetValue(viewNode.Node.Identity, viewNode);
|
||||
end;
|
||||
end;
|
||||
|
||||
if child.ChildrenCount > 0 then
|
||||
CollectNodes(child);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ClearVisuals;
|
||||
begin
|
||||
for var viewNode in FNodeMap.Values do
|
||||
begin
|
||||
viewNode.ErrorMessage := '';
|
||||
viewNode.TypeInfoText := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ApplyErrors(const Log: ICompilerLog);
|
||||
var
|
||||
entry: TCompilerError;
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
for entry in Log.GetEntries do
|
||||
begin
|
||||
if (entry.Level = elError) and Assigned(entry.Node) and Assigned(entry.Node.Identity) then
|
||||
begin
|
||||
if FNodeMap.TryGetValue(entry.Node.Identity, viewNode) then
|
||||
begin
|
||||
if viewNode.ErrorMessage = '' then
|
||||
viewNode.ErrorMessage := entry.Message
|
||||
else
|
||||
viewNode.ErrorMessage := viewNode.ErrorMessage + sLineBreak + entry.Message;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ApplyTypes(const TypedAst: IAstNode);
|
||||
var
|
||||
propagator: TTypePropagator;
|
||||
begin
|
||||
if not Assigned(TypedAst) then
|
||||
exit;
|
||||
|
||||
propagator := TTypePropagator.Create(FNodeMap);
|
||||
try
|
||||
propagator.Accept(TypedAst);
|
||||
finally
|
||||
propagator.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.RootResized(Sender: TObject);
|
||||
begin
|
||||
FWorkspace.World.Size := FRootViewNode.Size;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.ValidateAndShow;
|
||||
var
|
||||
logicalAst: IAstNode;
|
||||
begin
|
||||
if not Assigned(FRootViewNode) then
|
||||
exit;
|
||||
|
||||
// Note: We use FCurrentAst here if we trust it, or recreate for safety.
|
||||
// Since SetRoot sets FCurrentAst, and any UI manipulation (DragDrop) calls SetRoot afterwards,
|
||||
// FCurrentAst should be in sync.
|
||||
// However, strictly speaking, ValidateAndShow operates on the VISUAL tree to find Mapping.
|
||||
// But since we have FCurrentAst, we can use it directly for binding.
|
||||
|
||||
// BUT: ValidateAndShow is responsible for mapping NodeMap.
|
||||
logicalAst := FRootViewNode.CreateAst;
|
||||
// ^ This is still needed to rebuild the Mapping if we haven't tracked ViewNodes perfectly.
|
||||
// Or we rely on FCurrentAst being the source of truth and we assume ViewNodes match.
|
||||
// For now, let's keep CreateAst here to be 100% sure the mapping corresponds to what is on screen.
|
||||
// The performance hit here is acceptable as it's part of the validation cycle, not the drag-start.
|
||||
|
||||
FNodeMap.Clear;
|
||||
CollectNodes(FWorkspace.World);
|
||||
|
||||
ClearVisuals;
|
||||
|
||||
try
|
||||
var log := TCompilerLog.Create as ICompilerLog;
|
||||
|
||||
var expanded := FEnv.ExpandMacros(logicalAst);
|
||||
var typedAst := FEnv.Bind(expanded, [], log);
|
||||
var specAst := FEnv.Specialize(typedAst);
|
||||
|
||||
ApplyTypes(specAst);
|
||||
|
||||
if specAst.Kind = akLambdaExpression then
|
||||
var compiled := FEnv.Link(specAst.AsLambdaExpression, log);
|
||||
|
||||
ApplyErrors(log);
|
||||
except
|
||||
on E: ECompilationFailed do
|
||||
begin
|
||||
var tempLog := TCompilerLog.Create as ICompilerLog;
|
||||
for var err in E.Errors do
|
||||
tempLog.Add(err.Level, err.Message, err.Node);
|
||||
ApplyErrors(tempLog);
|
||||
end;
|
||||
end;
|
||||
|
||||
FWorkspace.World.Repaint;
|
||||
end;
|
||||
|
||||
{ TAstEditorController.TTypePropagator }
|
||||
|
||||
constructor TAstEditorController.TTypePropagator.Create(AMap: TNodeMap);
|
||||
begin
|
||||
inherited Create;
|
||||
FMap := AMap;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.TTypePropagator.ApplyType(const Node: IAstNode);
|
||||
var
|
||||
viewNode: TAstViewNode;
|
||||
begin
|
||||
if Assigned(Node) and Assigned(Node.Identity) then
|
||||
begin
|
||||
if FMap.TryGetValue(Node.Identity, viewNode) then
|
||||
begin
|
||||
if Node.IsTyped then
|
||||
begin
|
||||
var st := Node.AsTypedNode.StaticType;
|
||||
if Assigned(st) then
|
||||
viewNode.TypeInfoText := st.ToString;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstEditorController.TTypePropagator.Accept(const Node: IAstNode);
|
||||
begin
|
||||
if Node = nil then
|
||||
exit;
|
||||
ApplyType(Node);
|
||||
Node.Accept(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -18,7 +18,7 @@ uses
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Identities,
|
||||
Myc.Fmx.AstEditor.Layout,
|
||||
Myc.Fmx.AstEditor;
|
||||
Myc.Fmx.AstEditor.Node;
|
||||
|
||||
type
|
||||
// --- Abstract List Base ---
|
||||
|
||||
@@ -0,0 +1,542 @@
|
||||
unit Myc.Fmx.AstEditor.Node;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.UITypes,
|
||||
System.Types,
|
||||
System.Math,
|
||||
System.Math.Vectors,
|
||||
System.Generics.Defaults,
|
||||
System.Generics.Collections,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Objects,
|
||||
FMX.Graphics,
|
||||
FMX.StdCtrls,
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Fmx.AstEditor.Workspace,
|
||||
Myc.Fmx.AstEditor.Layout;
|
||||
|
||||
const
|
||||
cNodePadding = 10;
|
||||
cTitleTopPadding = 2;
|
||||
cTitleBottomPadding = 4;
|
||||
cMinNodeWidth = 10;
|
||||
cMinNodeHeight = 10;
|
||||
cDragGutterWidth = 20; // Width of the trigger zone for dragging
|
||||
|
||||
type
|
||||
TAstViewNode = class;
|
||||
|
||||
IAstViewNodeHandler = interface
|
||||
function GetAstNode: IAstNode;
|
||||
procedure BuildUI(OwnerNode: TAstViewNode);
|
||||
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
|
||||
property Node: IAstNode read GetAstNode;
|
||||
end;
|
||||
|
||||
IReorderable = interface
|
||||
['{9FA7C504-D327-4E00-A5FE-DD2876886212}']
|
||||
function CanDrag(Child: TControl): Boolean;
|
||||
procedure MoveChild(SourceIndex, TargetIndex: Integer);
|
||||
end;
|
||||
|
||||
IAstVisualizer = interface
|
||||
{$region 'private'}
|
||||
function GetExprDepth: Integer;
|
||||
function GetParentControl: TControl;
|
||||
function GetWorkspace: TWorkspace;
|
||||
{$endregion}
|
||||
|
||||
function Clone(ParentControl: TControl; ExprDepth: Integer): IAstVisualizer;
|
||||
function CallAccept(const Node: IAstNode): TAstViewNode;
|
||||
|
||||
property ExprDepth: Integer read GetExprDepth;
|
||||
property ParentControl: TControl read GetParentControl;
|
||||
property Workspace: TWorkspace read GetWorkspace;
|
||||
end;
|
||||
|
||||
TAstViewNode = class(TAutoFitControl)
|
||||
private
|
||||
FBackgroundColor: TAlphaColor;
|
||||
FBorderColor: TAlphaColor;
|
||||
FBorderWidth: Single;
|
||||
FBorderRadius: Single;
|
||||
FFrameless: Boolean;
|
||||
FVisualizer: IAstVisualizer;
|
||||
FHandler: IAstViewNodeHandler;
|
||||
|
||||
FErrorMessage: string;
|
||||
FTypeInfoText: string;
|
||||
|
||||
FIsFocused: Boolean;
|
||||
|
||||
procedure SetBackgroundColor(const Value: TAlphaColor);
|
||||
procedure SetBorderColor(const Value: TAlphaColor);
|
||||
procedure SetBorderWidth(const Value: Single);
|
||||
procedure SetBorderRadius(const Value: Single);
|
||||
procedure SetFrameless(const Value: Boolean);
|
||||
function GetNode: IAstNode;
|
||||
|
||||
procedure SetErrorMessage(const Value: string);
|
||||
procedure SetTypeInfoText(const Value: string);
|
||||
procedure UpdateVisualState;
|
||||
procedure SetIsFocused(const Value: Boolean);
|
||||
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure SetupNode;
|
||||
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; 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;
|
||||
|
||||
public
|
||||
constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler); reintroduce;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure AfterConstruction; override;
|
||||
|
||||
function AddLabel(Parent: TControl; const Txt: String): TLabel;
|
||||
function AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
|
||||
function AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAstViewNode;
|
||||
|
||||
function CreateAst: IAstNode;
|
||||
|
||||
property Visualizer: IAstVisualizer read FVisualizer;
|
||||
property Node: IAstNode read GetNode;
|
||||
property Handler: IAstViewNodeHandler read FHandler;
|
||||
|
||||
property ErrorMessage: string read FErrorMessage write SetErrorMessage;
|
||||
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
|
||||
property IsFocused: Boolean read FIsFocused write SetIsFocused;
|
||||
|
||||
published
|
||||
property BorderColor: TAlphaColor read FBorderColor write SetBorderColor;
|
||||
property BorderWidth: Single read FBorderWidth write SetBorderWidth;
|
||||
property BorderRadius: Single read FBorderRadius write SetBorderRadius;
|
||||
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
|
||||
property Frameless: Boolean read FFrameless write SetFrameless;
|
||||
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ClipChildren default True;
|
||||
property Cursor default crDefault;
|
||||
property DragMode default TDragMode.dmManual;
|
||||
property Enabled;
|
||||
property Height;
|
||||
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 Visible;
|
||||
property Width;
|
||||
property OnClick;
|
||||
property OnDblClick;
|
||||
property OnMouseDown;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
end;
|
||||
|
||||
TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAstViewNodeHandler)
|
||||
protected
|
||||
FNode: T;
|
||||
function GetAstNode: IAstNode;
|
||||
public
|
||||
constructor Create(const ANode: T);
|
||||
procedure BuildUI(OwnerNode: TAstViewNode); virtual; abstract;
|
||||
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode; virtual; abstract;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Myc.Ast;
|
||||
|
||||
{ TAstViewNode }
|
||||
|
||||
constructor TAstViewNode.Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler);
|
||||
begin
|
||||
inherited Create(AVisualizer.Workspace);
|
||||
|
||||
Parent := AVisualizer.ParentControl;
|
||||
|
||||
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
|
||||
FHandler := AHandler;
|
||||
|
||||
FBorderColor := TAlphaColors.Gray;
|
||||
FBorderWidth := 1;
|
||||
FBorderRadius := 9;
|
||||
FBackgroundColor := $080a0a0a;
|
||||
|
||||
FFrameless := False;
|
||||
FIsFocused := False;
|
||||
|
||||
Width := cMinNodeWidth;
|
||||
Height := cMinNodeHeight;
|
||||
|
||||
HitTest := True;
|
||||
ClipChildren := True;
|
||||
|
||||
Margins.Left := 4;
|
||||
Margins.Top := 4;
|
||||
Margins.Right := 4;
|
||||
Margins.Bottom := 4;
|
||||
Padding.Left := 3;
|
||||
Padding.Top := 3;
|
||||
Padding.Right := 3;
|
||||
Padding.Bottom := 3;
|
||||
|
||||
var cn: Cardinal := $ea - (7 * FVisualizer.ExprDepth);
|
||||
var c: Cardinal := $ff000000 or (cn shl 16) or (cn shl 8) or cn;
|
||||
BackgroundColor := c;
|
||||
end;
|
||||
|
||||
destructor TAstViewNode.Destroy;
|
||||
begin
|
||||
FHandler := nil;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.DoMouseEnter;
|
||||
begin
|
||||
inherited;
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.DoMouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
const
|
||||
cHeaderHeight = 30; // Defined height for header drag area
|
||||
begin
|
||||
// Check for Drag Start.
|
||||
// Condition: Left Click AND we are part of a container (list)
|
||||
if (Button = TMouseButton.mbLeft) and (Parent is TAutoFitControl) then
|
||||
begin
|
||||
// Hit-Test: Either Gutter (Left) OR Header area (Top)
|
||||
if (X < cDragGutterWidth) or (Y < cHeaderHeight) then
|
||||
begin
|
||||
if Assigned(FVisualizer.Workspace) then
|
||||
begin
|
||||
FVisualizer.Workspace.BeginDragNode(Self);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
const
|
||||
cHeaderHeight = 30;
|
||||
begin
|
||||
// Cursor Logic (Hover Feedback)
|
||||
if (Parent is TAutoFitControl) and ((X < cDragGutterWidth) or (Y < cHeaderHeight)) then
|
||||
Cursor := crSizeAll
|
||||
else
|
||||
Cursor := crDefault;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TAstViewNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
|
||||
begin
|
||||
Result := TAutoFitControl.Create(Self);
|
||||
Result.Parent := Parent;
|
||||
Result.Orientation := Orientation;
|
||||
Result.Alignment := Alignment;
|
||||
Result.HitTest := False;
|
||||
end;
|
||||
|
||||
function TAstViewNode.AddExpr(Parent: TControl; const Title: String; const Node: IAstNode): TAstViewNode;
|
||||
begin
|
||||
var cont := AddContainer(Parent, loHorizontal, laCenter);
|
||||
|
||||
var lbl := AddLabel(cont, Title);
|
||||
lbl.Font.Style := lbl.Font.Style + [TFontStyle.fsBold];
|
||||
|
||||
Result := FVisualizer.Clone(cont, FVisualizer.ExprDepth + 1).CallAccept(Node);
|
||||
end;
|
||||
|
||||
function TAstViewNode.AddLabel(Parent: TControl; const Txt: String): TLabel;
|
||||
begin
|
||||
Result := TLabel.Create(Self);
|
||||
Result.Parent := Parent;
|
||||
|
||||
Result.Position.Point := TPoint.Create(cNodePadding, cNodePadding);
|
||||
Result.Margins.Left := cNodePadding;
|
||||
Result.Margins.Right := cNodePadding;
|
||||
Result.Margins.Top := cTitleTopPadding;
|
||||
Result.Margins.Bottom := cTitleBottomPadding;
|
||||
Result.WordWrap := False;
|
||||
Result.AutoSize := True;
|
||||
Result.HitTest := False;
|
||||
|
||||
Result.StyledSettings := Result.StyledSettings - [TStyledSetting.Style];
|
||||
|
||||
Result.Text := Txt;
|
||||
Result.ApplyStyleLookup;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.AfterConstruction;
|
||||
begin
|
||||
inherited;
|
||||
SetupNode;
|
||||
end;
|
||||
|
||||
function TAstViewNode.CreateAst: IAstNode;
|
||||
begin
|
||||
if Assigned(FHandler) then
|
||||
Result := FHandler.ReconstructAst(Self)
|
||||
else
|
||||
Result := TAst.Nop;
|
||||
end;
|
||||
|
||||
function TAstViewNode.GetNode: IAstNode;
|
||||
begin
|
||||
if Assigned(FHandler) then
|
||||
Result := FHandler.Node
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetErrorMessage(const Value: string);
|
||||
begin
|
||||
if FErrorMessage <> Value then
|
||||
begin
|
||||
FErrorMessage := Value;
|
||||
UpdateVisualState;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetTypeInfoText(const Value: string);
|
||||
begin
|
||||
if FTypeInfoText <> Value then
|
||||
begin
|
||||
FTypeInfoText := Value;
|
||||
UpdateVisualState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetIsFocused(const Value: Boolean);
|
||||
begin
|
||||
if FIsFocused <> Value then
|
||||
begin
|
||||
FIsFocused := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.UpdateVisualState;
|
||||
begin
|
||||
if FErrorMessage <> '' then
|
||||
begin
|
||||
Hint := 'Error: ' + FErrorMessage;
|
||||
ShowHint := True;
|
||||
end
|
||||
else if FTypeInfoText <> '' then
|
||||
begin
|
||||
Hint := 'Type: ' + FTypeInfoText;
|
||||
ShowHint := True;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Hint := '';
|
||||
ShowHint := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.Paint;
|
||||
var
|
||||
rect: TRectF;
|
||||
effBorderColor: TAlphaColor;
|
||||
effBorderWidth: Single;
|
||||
effDash: TStrokeDash;
|
||||
isHovering: Boolean;
|
||||
shouldIgnoreHover: Boolean;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
shouldIgnoreHover := False;
|
||||
if Assigned(Node) then
|
||||
begin
|
||||
case Node.Kind of
|
||||
akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
isHovering := IsMouseOver and (not shouldIgnoreHover);
|
||||
|
||||
// 1. Determine Base Style
|
||||
if FFrameless then
|
||||
begin
|
||||
effBorderColor := FBorderColor;
|
||||
effBorderWidth := FBorderWidth;
|
||||
effDash := TStrokeDash.Dot;
|
||||
end
|
||||
else
|
||||
begin
|
||||
effBorderColor := FBorderColor;
|
||||
effBorderWidth := FBorderWidth;
|
||||
effDash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
// 2. Hover Overlay
|
||||
if isHovering then
|
||||
begin
|
||||
effBorderColor := TAlphaColors.White;
|
||||
effBorderWidth := Max(2.0, FBorderWidth + 1.0);
|
||||
effDash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
// 3. Error Overlay (High Priority for Color)
|
||||
if FErrorMessage <> '' then
|
||||
begin
|
||||
effBorderColor := TAlphaColors.Red;
|
||||
effBorderWidth := 2.0;
|
||||
effDash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
// 4. Focus Overlay (Highest Priority for Visibility/Color)
|
||||
// Note: If Error is present, Focus will override color to Blue to indicate "Active Cursor".
|
||||
// Error text is available in Hint.
|
||||
if FIsFocused then
|
||||
begin
|
||||
effBorderColor := TAlphaColors.Dodgerblue;
|
||||
effBorderWidth := 2.0;
|
||||
effDash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
Canvas.Fill.Kind := TBrushKind.Solid;
|
||||
Canvas.Fill.Color := FBackgroundColor;
|
||||
|
||||
if FFrameless and (FErrorMessage = '') and (not isHovering) and (not FIsFocused) then
|
||||
begin
|
||||
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
|
||||
|
||||
if FBorderWidth > 0 then
|
||||
begin
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := effBorderColor;
|
||||
Canvas.Stroke.Thickness := effBorderWidth;
|
||||
Canvas.Stroke.Dash := effDash;
|
||||
Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
rect := TRectF.Create(0, 0, Width, Height);
|
||||
if (effBorderWidth > 0) then
|
||||
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
|
||||
|
||||
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
|
||||
if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
|
||||
begin
|
||||
Canvas.Stroke.Kind := TBrushKind.Solid;
|
||||
Canvas.Stroke.Color := effBorderColor;
|
||||
Canvas.Stroke.Thickness := effBorderWidth;
|
||||
Canvas.Stroke.Dash := effDash;
|
||||
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
|
||||
end;
|
||||
end;
|
||||
|
||||
if isHovering and (Parent is TAutoFitControl) then
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.DimGray;
|
||||
Canvas.FillEllipse(TRectF.Create(4, 6, 8, 10), 1.0);
|
||||
Canvas.FillEllipse(TRectF.Create(4, 12, 8, 16), 1.0);
|
||||
Canvas.FillEllipse(TRectF.Create(4, 18, 8, 22), 1.0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetBorderColor(const Value: TAlphaColor);
|
||||
begin
|
||||
if FBorderColor <> Value then
|
||||
begin
|
||||
FBorderColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetBorderRadius(const Value: Single);
|
||||
begin
|
||||
if FBorderRadius <> Value then
|
||||
begin
|
||||
FBorderRadius := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetBorderWidth(const Value: Single);
|
||||
begin
|
||||
if FBorderWidth <> Value then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetFrameless(const Value: Boolean);
|
||||
begin
|
||||
if FFrameless <> Value then
|
||||
begin
|
||||
FFrameless := Value;
|
||||
Repaint;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor);
|
||||
begin
|
||||
FBackgroundColor := Value;
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TAstViewNode.SetupNode;
|
||||
begin
|
||||
if Assigned(FHandler) then
|
||||
FHandler.BuildUI(Self);
|
||||
end;
|
||||
|
||||
{ TBaseNodeHandler<T> }
|
||||
|
||||
constructor TBaseNodeHandler<T>.Create(const ANode: T);
|
||||
begin
|
||||
inherited Create;
|
||||
FNode := ANode;
|
||||
end;
|
||||
|
||||
function TBaseNodeHandler<T>.GetAstNode: IAstNode;
|
||||
begin
|
||||
Result := FNode;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -10,7 +10,7 @@ uses
|
||||
Myc.Ast.Nodes,
|
||||
Myc.Ast.Visitor,
|
||||
Myc.Fmx.AstEditor.Workspace,
|
||||
Myc.Fmx.AstEditor,
|
||||
Myc.Fmx.AstEditor.Node,
|
||||
Myc.Fmx.AstEditor.Handlers;
|
||||
|
||||
type
|
||||
|
||||
@@ -18,7 +18,6 @@ uses
|
||||
|
||||
type
|
||||
TOnPaintConnectionsEvent = procedure(ASender: TObject; ACanvas: TCanvas) of object;
|
||||
|
||||
TOnDragDropEvent = procedure(ASource, ATarget: TControl; AIndex: Integer) of object;
|
||||
|
||||
TAstWorld = class(TControl)
|
||||
@@ -29,7 +28,7 @@ type
|
||||
FDropP1, FDropP2: TPointF;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure AfterPaint; override; // <--- HIER: Für Zeichnen ÜBER den Kindern
|
||||
procedure AfterPaint; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure InvalidateConnections;
|
||||
@@ -163,6 +162,8 @@ begin
|
||||
inherited Create(AOwner);
|
||||
ClipChildren := True;
|
||||
HitTest := True;
|
||||
CanFocus := True; // Enable Keyboard Input
|
||||
AutoCapture := True;
|
||||
|
||||
FRootLayer := TAstWorld.Create(Self);
|
||||
FRootLayer.Parent := Self;
|
||||
@@ -369,6 +370,10 @@ end;
|
||||
procedure TWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited;
|
||||
// Capture Keyboard Focus
|
||||
if CanFocus then
|
||||
SetFocus;
|
||||
|
||||
if not FIsDraggingNode and (Button in [TMouseButton.mbLeft, TMouseButton.mbMiddle]) then
|
||||
begin
|
||||
FIsPanning := True;
|
||||
|
||||
+881
-385
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user