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

New visualizer

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-26 18:06:45 +01:00
parent e379e6694c
commit e95a920dc7
9 changed files with 1489 additions and 1589 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ASTPlayground/Myc.Fmx.AstEditor.Node.pas
+50 -84
View File
@@ -14,9 +14,10 @@ uses
FMX.Graphics;
type
// A movable panel with a custom-painted border and title.
// 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.
@@ -25,20 +26,13 @@ type
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 SetBackgroundColor(const Value: TAlphaColor);
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;
@@ -53,11 +47,7 @@ type
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;
property BackgroundColor: TAlphaColor read FBackgroundColor write SetBackgroundColor;
// Behavior properties
property Frameless: Boolean read FFrameless write SetFrameless;
@@ -110,16 +100,8 @@ begin
// 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;
FBorderRadius := 9; // Rounded corners by default
FBackgroundColor := $080a0a0a;
// Default state for frameless mode
FFrameless := False;
@@ -128,36 +110,51 @@ begin
Height := 45;
// The panel must be able to receive mouse events.
// HitTest := True;
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
FTitleFont.Free;
inherited;
end;
procedure TAuraNode.Paint;
var
rect, titleRect: TRectF;
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 := $20C0C0C0; // Transparent Silver
Canvas.Fill.Color := FBackgroundColor;
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);
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
@@ -168,31 +165,15 @@ begin
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);
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);
effectiveBorderWidth := FBorderWidth;
end
else
effectiveBorderWidth := 0;
end;
// Title drawing removed, handled by external labels now.
end;
procedure TAuraNode.SetBorderColor(const Value: TAlphaColor);
@@ -231,45 +212,22 @@ begin
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
// 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;
end;
BringToFront; // Bring node to front when dragging starts
end
else
FIsDragging := False; // Ensure dragging stops if click is on a child
end;
end;
@@ -286,7 +244,7 @@ begin
Position.Y := Position.Y + deltaY;
if ParentControl <> nil then
ParentControl.Repaint;
ParentControl.Repaint; // Repaint the workspace to update connections
end;
end;
@@ -297,7 +255,15 @@ begin
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.