Ast editor rename
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,738 @@
|
||||
unit Myc.Fmx.AstEditor;
|
||||
|
||||
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;
|
||||
|
||||
const
|
||||
cNodePadding = 10;
|
||||
cTitleTopPadding = 2;
|
||||
cTitleBottomPadding = 4;
|
||||
cMinNodeWidth = 10;
|
||||
cMinNodeHeight = 10;
|
||||
|
||||
type
|
||||
TAstViewNode = class; // Forward declaration
|
||||
|
||||
IAstViewNodeHandler = interface
|
||||
function GetAstNode: IAstNode;
|
||||
procedure BuildUI(OwnerNode: TAstViewNode);
|
||||
function ReconstructAst(OwnerNode: TAstViewNode): IAstNode;
|
||||
property Node: IAstNode read GetAstNode;
|
||||
end;
|
||||
|
||||
IAstVisualizer = interface
|
||||
{$region 'private'}
|
||||
function GetExprDepth: Integer;
|
||||
function GetParentControl: TControl;
|
||||
function GetWorkspace: TAstWorkspace;
|
||||
{$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: TAstWorkspace read GetWorkspace;
|
||||
end;
|
||||
|
||||
TLayoutOrientation = (loVertical, loHorizontal);
|
||||
TLayoutAlignment = (laCenter, laFlush);
|
||||
|
||||
TAutoFitControl = class(TStyledControl)
|
||||
private
|
||||
FUpdatingOwnSize: Boolean;
|
||||
FNeedRecalcSize: Boolean;
|
||||
FOrientation: TLayoutOrientation;
|
||||
FAlignment: TLayoutAlignment;
|
||||
procedure RecalcOwnSize;
|
||||
procedure SetOrientation(const Value: TLayoutOrientation);
|
||||
procedure SetAlignment(const Value: TLayoutAlignment);
|
||||
protected
|
||||
procedure ParentContentChanged; override;
|
||||
procedure PaddingChanged; override;
|
||||
procedure ChangeChildren; override;
|
||||
procedure Loaded; override;
|
||||
procedure DoEndUpdate; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
published
|
||||
property Padding;
|
||||
property Orientation: TLayoutOrientation read FOrientation write SetOrientation default TLayoutOrientation.loHorizontal;
|
||||
property Alignment: TLayoutAlignment read FAlignment write SetAlignment default TLayoutAlignment.laCenter;
|
||||
end;
|
||||
|
||||
TAstViewNode = class(TAutoFitControl)
|
||||
private
|
||||
FBackgroundColor: TAlphaColor;
|
||||
FBorderColor: TAlphaColor;
|
||||
FBorderWidth: Single;
|
||||
FBorderRadius: Single;
|
||||
FFrameless: Boolean;
|
||||
FVisualizer: IAstVisualizer;
|
||||
FHandler: IAstViewNodeHandler;
|
||||
|
||||
FErrorMessage: string;
|
||||
FTypeInfoText: string;
|
||||
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
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 ErrorMessage: string read FErrorMessage write SetErrorMessage;
|
||||
property TypeInfoText: string read FTypeInfoText write SetTypeInfoText;
|
||||
|
||||
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;
|
||||
|
||||
{ TAutoFitControl }
|
||||
|
||||
constructor TAutoFitControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
HitTest := True;
|
||||
FOrientation := TLayoutOrientation.loHorizontal;
|
||||
FAlignment := TLayoutAlignment.laCenter;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.SetAlignment(const Value: TLayoutAlignment);
|
||||
begin
|
||||
if FAlignment <> Value then
|
||||
begin
|
||||
FAlignment := Value;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.SetOrientation(const Value: TLayoutOrientation);
|
||||
begin
|
||||
if FOrientation <> Value then
|
||||
begin
|
||||
FOrientation := Value;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.RecalcOwnSize;
|
||||
var
|
||||
i: Integer;
|
||||
child: TControl;
|
||||
childrenToLayout: TList<TControl>;
|
||||
currentX, currentY: Single;
|
||||
requiredWidth, requiredHeight: Single;
|
||||
childWidthWithMargins, childHeightWithMargins: Single;
|
||||
hasVisibleChild: Boolean;
|
||||
begin
|
||||
if FUpdatingOwnSize then
|
||||
exit;
|
||||
if IsUpdating then
|
||||
begin
|
||||
FNeedRecalcSize := True;
|
||||
exit;
|
||||
end;
|
||||
|
||||
FUpdatingOwnSize := True;
|
||||
childrenToLayout := nil;
|
||||
try
|
||||
requiredWidth := Padding.Left + Padding.Right;
|
||||
requiredHeight := Padding.Top + Padding.Bottom;
|
||||
currentX := Padding.Left;
|
||||
currentY := Padding.Top;
|
||||
hasVisibleChild := False;
|
||||
|
||||
childrenToLayout := TList<TControl>.Create;
|
||||
for i := 0 to ChildrenCount - 1 do
|
||||
begin
|
||||
if Children[i] is TControl then
|
||||
begin
|
||||
child := TControl(Children[i]);
|
||||
if child.Visible and (child.Align = TAlignLayout.None) then
|
||||
begin
|
||||
childrenToLayout.Add(child);
|
||||
hasVisibleChild := True;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if hasVisibleChild then
|
||||
begin
|
||||
if FOrientation = TLayoutOrientation.loVertical then
|
||||
begin
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
child.Position.Y := currentY + child.Margins.Top;
|
||||
currentY := child.Position.Y + child.Height + child.Margins.Bottom;
|
||||
|
||||
childWidthWithMargins := Padding.Left + child.Margins.Left + child.Width + child.Margins.Right + Padding.Right;
|
||||
requiredWidth := System.Math.Max(requiredWidth, childWidthWithMargins);
|
||||
end;
|
||||
requiredHeight := currentY + Padding.Bottom;
|
||||
|
||||
if FAlignment = TLayoutAlignment.laFlush then
|
||||
begin
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
child.Position.X := Padding.Left + child.Margins.Left;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
var contentWidth := requiredWidth - Padding.Left - Padding.Right;
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
var childTotalWidth := child.Width + child.Margins.Left + child.Margins.Right;
|
||||
var childX := Padding.Left + ((contentWidth - childTotalWidth) / 2) + child.Margins.Left;
|
||||
child.Position.X := childX;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
child.Position.X := currentX + child.Margins.Left;
|
||||
currentX := child.Position.X + child.Width + child.Margins.Right;
|
||||
|
||||
childHeightWithMargins := Padding.Top + child.Margins.Top + child.Height + child.Margins.Bottom + Padding.Bottom;
|
||||
requiredHeight := System.Math.Max(requiredHeight, childHeightWithMargins);
|
||||
end;
|
||||
requiredWidth := currentX + Padding.Right;
|
||||
|
||||
if FAlignment = TLayoutAlignment.laFlush then
|
||||
begin
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
child.Position.Y := Padding.Top + child.Margins.Top;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
var contentHeight := requiredHeight - Padding.Top - Padding.Bottom;
|
||||
for child in childrenToLayout do
|
||||
begin
|
||||
var childTotalHeight := child.Height + child.Margins.Top + child.Margins.Bottom;
|
||||
var childY := Padding.Top + ((contentHeight - childTotalHeight) / 2) + child.Margins.Top;
|
||||
child.Position.Y := childY;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
requiredWidth := Padding.Left + Padding.Right;
|
||||
requiredHeight := Padding.Top + Padding.Bottom;
|
||||
end;
|
||||
|
||||
requiredWidth := System.Math.Max(0, requiredWidth);
|
||||
requiredHeight := System.Math.Max(0, requiredHeight);
|
||||
|
||||
if not SameValue(requiredWidth, Width, TEpsilon.Position) or not SameValue(requiredHeight, Height, TEpsilon.Position) then
|
||||
begin
|
||||
FSize.SetSizeWithoutNotification(TSizeF.Create(requiredWidth, requiredHeight));
|
||||
HandleSizeChanged;
|
||||
end;
|
||||
|
||||
finally
|
||||
childrenToLayout.Free;
|
||||
FUpdatingOwnSize := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.ChangeChildren;
|
||||
begin
|
||||
inherited ChangeChildren;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.PaddingChanged;
|
||||
begin
|
||||
inherited PaddingChanged;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.ParentContentChanged;
|
||||
begin
|
||||
inherited ParentContentChanged;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
|
||||
procedure TAutoFitControl.DoEndUpdate;
|
||||
begin
|
||||
inherited;
|
||||
if FNeedRecalcSize then
|
||||
begin
|
||||
FNeedRecalcSize := False;
|
||||
RecalcOwnSize;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ 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;
|
||||
|
||||
Width := cMinNodeWidth;
|
||||
Height := cMinNodeHeight;
|
||||
|
||||
// HitTest muss True sein für Hover-Effekte (IsMouseOver)
|
||||
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;
|
||||
// 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);
|
||||
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;
|
||||
// Type Info usually doesn't change painting, just hint
|
||||
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
|
||||
// Lists and Blocks should generally not be highlighted as a whole on hover
|
||||
// because they are containers for other selectable items.
|
||||
akBlockExpression, akParameterList, akArgumentList, akExpressionList, akRecordFieldList: shouldIgnoreHover := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Determine hover state: active only if mouse is over AND it is not a container type
|
||||
isHovering := IsMouseOver and (not shouldIgnoreHover);
|
||||
|
||||
// 1. Set base values
|
||||
if FFrameless then
|
||||
begin
|
||||
effBorderColor := FBorderColor;
|
||||
effBorderWidth := FBorderWidth;
|
||||
effDash := TStrokeDash.Dot;
|
||||
end
|
||||
else
|
||||
begin
|
||||
effBorderColor := FBorderColor;
|
||||
effBorderWidth := FBorderWidth;
|
||||
effDash := TStrokeDash.Solid;
|
||||
end;
|
||||
|
||||
// 2. Hover state (overrides base, makes frameless nodes visible)
|
||||
if isHovering then
|
||||
begin
|
||||
// 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);
|
||||
|
||||
// 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
|
||||
// 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
|
||||
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;
|
||||
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.
|
||||
Reference in New Issue
Block a user