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 and title.
    TAuraNode = class(TStyledControl)
    private
        // 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;
        // Properties for the title
        FTitle: string;
        FTitleFont: TFont;
        FTitleFontColor: TAlphaColor;
        // If true, the node is drawn without a border and with a transparent background.
        FFrameless: Boolean;

        procedure SetBorderColor(const Value: TAlphaColor);
        procedure SetBorderWidth(const Value: Single);
        procedure SetBorderRadius(const Value: Single);
        procedure SetTitle(const Value: string);
        procedure SetTitleFont(const Value: TFont);
        procedure SetTitleFontColor(const Value: TAlphaColor);
        procedure TitleFontChanged(Sender: TObject);
        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;

        // Title properties
        property Title: string read FTitle write SetTitle;
        property TitleFont: TFont read FTitleFont write SetTitleFont;
        property TitleFontColor: TAlphaColor read FTitleFontColor write SetTitleFontColor;

        // 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; // Sharp corners by default

    // Default title settings
    FTitle := 'Node';
    FTitleFont := TFont.Create;
    FTitleFont.Family := 'Segoe UI';
    FTitleFont.Size := 11;
    FTitleFont.Style := [TFontStyle.fsBold];
    FTitleFont.OnChanged := TitleFontChanged;
    FTitleFontColor := TAlphaColors.Black;

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

    Width := 80;
    Height := 45;

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

destructor TAuraNode.Destroy;
begin
    FTitleFont.Free;
    inherited;
end;

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

    if FFrameless then
    begin
        Canvas.Fill.Kind := TBrushKind.Solid;
        Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
        Canvas.Stroke.Kind := TBrushKind.None;

        // In frameless mode, draw a transparent background and ignore the border.
        Canvas.FillRect(TRectF.Create(0, 0, Width, Height), 0, 0, [], 1.0);
        effectiveBorderWidth := 0;
    end
    else
    begin
        // 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;

            if FFrameless then
            begin
                Canvas.Fill.Kind := TBrushKind.Solid;
                Canvas.Fill.Color := $20C0C0C0; // Transparent Silver
                Canvas.FillRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
            end
            else
                Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
        end;
        effectiveBorderWidth := FBorderWidth;
    end;

    // Draw the title
    if not FTitle.IsEmpty then
    begin
        // Define the rectangle for the title at the top of the control
        titleRect := TRectF.Create(0, effectiveBorderWidth, Width, effectiveBorderWidth + FTitleFont.Size * 1.8);

        Canvas.Font.Assign(FTitleFont);
        Canvas.Fill.Color := FTitleFontColor;

        // Draw the text centered horizontally and vertically within the title rectangle
        Canvas.FillText(titleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
    end;
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.SetTitle(const Value: string);
begin
    if FTitle <> Value then
    begin
        FTitle := Value;
        Repaint;
    end;
end;

procedure TAuraNode.SetTitleFont(const Value: TFont);
begin
    FTitleFont.Assign(Value);
end;

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

procedure TAuraNode.TitleFontChanged(Sender: TObject);
begin
    Repaint;
end;

procedure TAuraNode.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
    inherited;
    if Button = TMouseButton.mbLeft then
    begin
        if ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl then
        begin
            FIsDragging := True;
            FDownPos := TPointF.Create(X, Y);
            Capture;
        end;
    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;
    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;
    end;
end;

end.