MycLib/ASTPlayground/Myc.Fmx.AstEditor.Node.pas

unit Myc.Fmx.AstEditor.Node;

interface

uses
    System.SysUtils,
    System.Classes,
    System.UITypes,
    System.Types,
    System.Math.Vectors,
    FMX.Types,
    FMX.Controls,
    FMX.Objects,
    FMX.Graphics;

type
    // A movable panel with a custom-painted border. Content (like title) is added externally.
    TAuraNode = class(TStyledControl)
    private
        FBackgroundColor: TAlphaColor;
        // Flag to indicate if the control is currently being dragged.
        FIsDragging: Boolean;
        // Stores the mouse coordinates at the beginning of the drag operation.
        FDownPos: TPointF;
        // Properties for the custom-drawn border.
        FBorderColor: TAlphaColor;
        FBorderWidth: Single;
        FBorderRadius: Single;
        // If true, the node is drawn without a border and with a transparent background.
        FFrameless: 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);
    protected
        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;
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
    published
        // Custom border properties
        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;

        // Behavior properties
        property Frameless: Boolean read FFrameless write SetFrameless;

        // Standard control properties
        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

{ TAuraNode }

constructor TAuraNode.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FIsDragging := False;

    // Default border settings
    FBorderColor := TAlphaColors.Gray;
    FBorderWidth := 1;
    FBorderRadius := 9; // Rounded corners by default
    FBackgroundColor := $080a0a0a;

    // Default state for frameless mode
    FFrameless := False;

    Width := 80;
    Height := 45;

    // The panel must be able to receive mouse events.
    HitTest := True; // Make sure HitTest is True to receive mouse events
    // Clip children to the panel's bounds.
    ClipChildren := True;
end;

destructor TAuraNode.Destroy;
begin
    inherited;
end;

procedure TAuraNode.Paint;
var
    rect: TRectF;
    effectiveBorderWidth: Single;
begin
    inherited; // Allow styled painting to occur first (if any)

    // Clear background before drawing custom border/fill
    Canvas.Fill.Kind := TBrushKind.None; // Make sure default fill is cleared if needed
    //Canvas.ClearRect(TRectF.Create(0,0, Width, Height)); // Optional: Explicit clear

    if FFrameless then
    begin
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := FBackgroundColor;
        Canvas.Stroke.Kind := TBrushKind.None;
        Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
        Canvas.Stroke.Kind := TBrushKind.Solid;
        Canvas.Stroke.Color := FBorderColor;
        Canvas.Stroke.Thickness := 1;
        Canvas.Stroke.Dash := TStrokeDash.Dot;
        Canvas.DrawRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
        effectiveBorderWidth := 0;
    end
    else
    begin
        // Draw background fill first
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := FBackgroundColor;
        rect := TRectF.Create(0, 0, Width, Height);
        // Inflate inwards slightly if border exists to avoid overlap issues
        if (FBorderWidth > 0) then
            rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
        Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);

        // Custom painting for the border
        if (FBorderWidth > 0) and (FBorderColor <> TAlphaColors.Null) then
        begin
            rect := TRectF.Create(0, 0, Width, Height);
            // Inflate inwards so the border is fully visible within the control's bounds
            rect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);

            Canvas.Stroke.Kind := TBrushKind.Solid;
            Canvas.Stroke.Color := FBorderColor;
            Canvas.Stroke.Thickness := FBorderWidth;
            Canvas.Stroke.Dash := TStrokeDash.Solid;
            Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);

            effectiveBorderWidth := FBorderWidth;
        end
        else
            effectiveBorderWidth := 0;
    end;
    // Title drawing removed, handled by external labels now.
end;

procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
begin
    if FBorderColor <> Value then
    begin
        FBorderColor := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetBorderRadius(const Value: Single);
begin
    if FBorderRadius <> Value then
    begin
        FBorderRadius := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetBorderWidth(const Value: Single);
begin
    if FBorderWidth <> Value then
    begin
        FBorderWidth := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetFrameless(const Value: Boolean);
begin
    if FFrameless <> Value then
    begin
        FFrameless := Value;
        Repaint;
    end;
end;

procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    if Button = TMouseButton.mbLeft then
    begin
        // Only start dragging if the click is on the node itself, not its children
        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; // Bring node to front when dragging starts
        end
        else
            FIsDragging := False; // Ensure dragging stops if click is on a child
    end;
end;

procedure TAuraNode.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; // Repaint the workspace to update connections
    end;
end;

procedure TAuraNode.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 // Repaint one last time after drag ends
            ParentControl.Repaint;
    end;
end;

procedure TAuraNode.SetBackgroundColor(const Value: TAlphaColor);
begin
    FBackgroundColor := Value;
    Repaint;
end;

end.