Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

UI refactoring

Browse Source
This commit is contained in:
Michael Schimmel
2025-11-29 16:43:52 +01:00
parent 521d0ac28f
commit 250f950a68
2 changed files with 155 additions and 111 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Fmx.AstEditor.Core.pas
+122 -97
View File
@@ -29,15 +29,10 @@ const
type
TAstViewNode = class; // Forward declaration
// This aggregate interface encapsulates all node-specific logic.
IAstViewNodeHandler = interface
// Gets the original logical AST node
function GetAstNode: IAstNode;
// Creates the specific FMX UI for this node
procedure BuildUI(OwnerNode: TAstViewNode);
// Reconstructs the logical AST node from the FMX UI state
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
// The original logical AST node
property Node: IAstNode read GetAstNode;
end;
@@ -56,19 +51,15 @@ type
property Workspace: TAstWorkspace read GetWorkspace;
end;
// Defines the layout direction for children within TAutoFitControl
TLayoutOrientation = (loVertical, loHorizontal);
// Defines the alignment of children on the cross-axis
TLayoutAlignment = (laCenter, laFlush);
// A styled control that automatically adjusts its size to fit its children, including padding.
TAutoFitControl = class(TStyledControl)
private
FUpdatingOwnSize: Boolean; // Recursion guard
FNeedRecalcSize: Boolean; // Flag for EndUpdate
FOrientation: TLayoutOrientation; // Storage for Orientation
FAlignment: TLayoutAlignment; // Storage for Alignment
FUpdatingOwnSize: Boolean;
FNeedRecalcSize: Boolean;
FOrientation: TLayoutOrientation;
FAlignment: TLayoutAlignment;
procedure RecalcOwnSize;
procedure SetOrientation(const Value: TLayoutOrientation);
procedure SetAlignment(const Value: TLayoutAlignment);
@@ -87,12 +78,9 @@ type
property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
end;
// A movable panel with a custom-painted border. Content (like title) is added externally.
TAstViewNode = class(TAutoFitControl)
private
FBackgroundColor: TAlphaColor;
FIsDragging: Boolean;
FDownPos: TPointF;
FBorderColor: TAlphaColor;
FBorderWidth: Single;
FBorderRadius: Single;
@@ -100,7 +88,6 @@ type
FVisualizer: IAstVisualizer;
FHandler: IAstViewNodeHandler;
// --- Visual State Fields ---
FErrorMessage: string;
FTypeInfoText: string;
@@ -111,17 +98,20 @@ type
procedure SetFrameless(const Value: Boolean);
function GetNode: IAstNode;
// New Setters
procedure SetErrorMessage(const Value: string);
procedure SetTypeInfoText(const Value: string);
procedure UpdateVisualState;
protected
procedure Paint; override;
procedure SetupNode;
// Overrides for interaction
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;
procedure SetupNode;
public
constructor Create(const AVisualizer: IAstVisualizer; const AHandler: IAstViewNodeHandler); reintroduce;
@@ -138,7 +128,6 @@ type
property Visualizer: IAstVisualizer read FVisualizer;
property Node: IAstNode read GetNode;
// --- Visual State Properties ---
property ErrorMessage: string read FErrorMessage write SetErrorMessage;
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
@@ -180,7 +169,6 @@ type
property OnMouseLeave;
end;
// Helper base class to reduce boilerplate in specific handlers
TBaseNodeHandler<T: IAstNode> = class(TInterfacedObject, IAstViewNodeHandler)
protected
FNode: T;
@@ -394,8 +382,6 @@ begin
FVisualizer := AVisualizer.Clone(Self, AVisualizer.ExprDepth);
FHandler := AHandler;
FIsDragging := False;
FBorderColor := TAlphaColors.Gray;
FBorderWidth := 1;
FBorderRadius := 9;
@@ -406,6 +392,7 @@ begin
Width := cMinNodeWidth;
Height := cMinNodeHeight;
// HitTest muss True sein für Hover-Effekte (IsMouseOver)
HitTest := True;
ClipChildren := True;
@@ -429,6 +416,60 @@ begin
inherited;
end;
procedure TAstViewNode.DoMouseEnter;
begin
inherited;
// Wir müssen neu zeichnen, da sich IsMouseOver geändert hat,
// FMX triggert Paint nicht automatisch bei Hover.
Repaint;
end;
procedure TAstViewNode.DoMouseLeave;
begin
inherited;
Repaint;
end;
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
pt: TPointF;
begin
inherited;
// Panning-Weiterleitung an den Workspace
if Assigned(FVisualizer.Workspace) then
begin
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseDown(Button, Shift, pt.X, pt.Y);
end;
end;
procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
var
pt: TPointF;
begin
inherited;
if Assigned(FVisualizer.Workspace) then
begin
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseMove(Shift, pt.X, pt.Y);
end;
end;
procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
pt: TPointF;
begin
inherited;
if Assigned(FVisualizer.Workspace) then
begin
pt := LocalToAbsolute(TPointF.Create(X, Y));
pt := FVisualizer.Workspace.AbsoluteToLocal(pt);
FVisualizer.Workspace.ExternalMouseUp(Button, Shift, pt.X, pt.Y);
end;
end;
function TAstViewNode.AddContainer(Parent: TControl; Orientation: TLayoutOrientation; Alignment: TLayoutAlignment): TAutoFitControl;
begin
Result := TAutoFitControl.Create(Self);
@@ -535,57 +576,88 @@ var
effBorderColor: TAlphaColor;
effBorderWidth: Single;
effDash: TStrokeDash;
isHovering: Boolean;
isBlock: Boolean;
begin
inherited;
Canvas.Fill.Kind := TBrushKind.None;
// Check if this is a block node (blocks should not highlight on hover)
isBlock := Assigned(Node) and (Node.Kind = TAstNodeKind.akBlockExpression);
// Determine styles based on state (Error > Standard)
if FErrorMessage <> '' then
// Determine hover state: active only if mouse is over AND it is not a block
isHovering := IsMouseOver and (not isBlock);
// 1. Set base values
if FFrameless then
begin
effBorderColor := TAlphaColors.Red;
effBorderWidth := 2.0;
effDash := TStrokeDash.Solid;
effBorderColor := FBorderColor;
effBorderWidth := FBorderWidth;
effDash := TStrokeDash.Dot;
end
else
begin
effBorderColor := FBorderColor;
effBorderWidth := FBorderWidth;
if FFrameless then
effDash := TStrokeDash.Dot
else
effDash := TStrokeDash.Solid;
effDash := TStrokeDash.Solid;
end;
if FFrameless and (FErrorMessage = '') then
// 2. Hover state (overrides base, makes frameless nodes visible)
if isHovering then
begin
// Standard frameless drawing (only if no error)
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
Canvas.Stroke.Kind := TBrushKind.None;
// Bright white for strong contrast against dark background
effBorderColor := TAlphaColors.White;
// Make border slightly thicker for a "pop" effect
effBorderWidth := Max(2.0, FBorderWidth + 1.0);
// Always solid line when hovering, even if originally frameless
effDash := TStrokeDash.Solid;
end;
// 3. Error state (dominates everything)
if FErrorMessage <> '' then
begin
effBorderColor := TAlphaColors.Red;
effBorderWidth := 2.0;
effDash := TStrokeDash.Solid;
end;
// --- Drawing ---
// Fill background
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
if FFrameless and (FErrorMessage = '') and (not isHovering) then
begin
// Special case: Inactive, frameless node (e.g., simple constant)
// Draw only background, no border
Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
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);
// Draw border only if explicit width is set (e.g. debugging)
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
// Draw background fill first
Canvas.Fill.Kind := TBrushKind.Solid;
Canvas.Fill.Color := FBackgroundColor;
// Standard case: Node with border (or hovered frameless node)
rect := TRectF.Create(0, 0, Width, Height);
// Adjust to avoid clipping the border
if (effBorderWidth > 0) then
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
// Draw border (Custom or Error)
// Draw border
if (effBorderWidth > 0) and (effBorderColor <> TAlphaColors.Null) then
begin
rect := TRectF.Create(0, 0, Width, Height);
rect.Inflate(-effBorderWidth / 2, -effBorderWidth / 2);
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := effBorderColor;
Canvas.Stroke.Thickness := effBorderWidth;
@@ -631,53 +703,6 @@ begin
end;
end;
procedure TAstViewNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if Button = TMouseButton.mbLeft then
begin
var lControl := ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y)));
if Assigned(lControl) and (lControl.GetObject = Self) then
begin
FIsDragging := True;
FDownPos := TPointF.Create(X, Y);
Capture;
BringToFront;
end
else
FIsDragging := False;
end;
end;
procedure TAstViewNode.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
if FIsDragging then
begin
var deltaX := X - FDownPos.X;
var deltaY := Y - FDownPos.Y;
Position.X := Position.X + deltaX;
Position.Y := Position.Y + deltaY;
if ParentControl <> nil then
ParentControl.Repaint;
end;
end;
procedure TAstViewNode.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if (Button = TMouseButton.mbLeft) and (FIsDragging) then
begin
ReleaseCapture;
FIsDragging := False;
if ParentControl <> nil then
ParentControl.Repaint;
end;
end;
procedure TAstViewNode.SetBackgroundColor(const Value: TAlphaColor);
begin
FBackgroundColor := Value;
Src/AST/Myc.Fmx.AstEditor.Workspace.pas
+33 -14
View File
@@ -47,6 +47,11 @@ type
function GetChildrenMatrix(var Matrix: TMatrix; var Simple: Boolean): Boolean; override;
function Zoom(Factor: Single): Boolean;
// Neue Public Methoden, damit Nodes das Panning steuern können
procedure ExternalMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure ExternalMouseMove(Shift: TShiftState; X, Y: Single);
procedure ExternalMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
published
property Align;
property Anchors;
@@ -88,8 +93,8 @@ implementation
uses
System.Math,
FMX.Platform,
Myc.Fmx.AstEditor.Core, // Enthält TAstViewNode Interfaces
Myc.Fmx.AstEditor.Visualizer; // Enthält TAstVisualizer
Myc.Fmx.AstEditor.Core,
Myc.Fmx.AstEditor.Visualizer;
{ TPinConnection }
@@ -112,7 +117,6 @@ var
visu: IAstVisualizer;
node: TAstViewNode;
begin
// Erstelle den Visualizer mit diesem Workspace als Kontext
visu := TAstVisualizer.Create(Self, Self, 0);
node := visu.CallAccept(RootNode);
if Assigned(node) then
@@ -132,23 +136,43 @@ begin
Result := True;
end;
// --- Interne Event Handler ---
procedure TAstWorkspace.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
ExternalMouseDown(Button, Shift, X, Y);
end;
procedure TAstWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
begin
inherited;
ExternalMouseMove(Shift, X, Y);
end;
procedure TAstWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
ExternalMouseUp(Button, Shift, X, Y);
end;
// --- Externe Steuerung für Nodes ---
procedure TAstWorkspace.ExternalMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
if (Button = TMouseButton.mbLeft) then
begin
Capture;
FIsPanning := True;
FLastPanPos := TPointF.Create(X, Y);
Cursor := crHandPoint;
end;
end;
procedure TAstWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
procedure TAstWorkspace.ExternalMouseMove(Shift: TShiftState; X, Y: Single);
var
delta: TPointF;
begin
inherited;
if FIsPanning then
begin
delta := TPointF.Create(X - FLastPanPos.X, Y - FLastPanPos.Y);
@@ -161,11 +185,11 @@ begin
end;
end;
procedure TAstWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure TAstWorkspace.ExternalMouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;
if (Button = TMouseButton.mbLeft) and (FIsPanning) then
begin
ReleaseCapture;
FIsPanning := False;
Cursor := crDefault;
end;
@@ -200,26 +224,21 @@ begin
for connection in FConnections do
begin
// Output Pin Calculation
pinCenter := TPointF.Create(connection.OutputPin.Width / 2, connection.OutputPin.Height / 2);
absoluteStart := connection.OutputPin.LocalToAbsolute(pinCenter);
// Input Pin Calculation
pinCenter := TPointF.Create(connection.InputPin.Width / 2, connection.InputPin.Height / 2);
absoluteEnd := connection.InputPin.LocalToAbsolute(pinCenter);
// Convert to Workspace Local Coordinates
startPoint := AbsoluteToLocal(absoluteStart);
endPoint := AbsoluteToLocal(absoluteEnd);
// Determine Color based on TagString (naive check)
str := connection.InputPin.TagString;
if Pos('data', str) = 0 then
Canvas.Stroke.Color := cExecPinColor
else
Canvas.Stroke.Color := cDataPinColor;
// Draw Curve
path := TPathData.Create;
try
controlOffset := Max(25, 0.5 * endPoint.Distance(startPoint));