From 250f950a680830d27c560d74703e4bfd4481a967 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 29 Nov 2025 16:43:52 +0100 Subject: [PATCH] UI refactoring --- Src/AST/Myc.Fmx.AstEditor.Core.pas | 219 +++++++++++++----------- Src/AST/Myc.Fmx.AstEditor.Workspace.pas | 47 +++-- 2 files changed, 155 insertions(+), 111 deletions(-) diff --git a/Src/AST/Myc.Fmx.AstEditor.Core.pas b/Src/AST/Myc.Fmx.AstEditor.Core.pas index 9f0bed6..73ccac7 100644 --- a/Src/AST/Myc.Fmx.AstEditor.Core.pas +++ b/Src/AST/Myc.Fmx.AstEditor.Core.pas @@ -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 = 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; diff --git a/Src/AST/Myc.Fmx.AstEditor.Workspace.pas b/Src/AST/Myc.Fmx.AstEditor.Workspace.pas index d201c84..85b54fb 100644 --- a/Src/AST/Myc.Fmx.AstEditor.Workspace.pas +++ b/Src/AST/Myc.Fmx.AstEditor.Workspace.pas @@ -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));