AST development

This commit is contained in:
Michael Schimmel
2025-09-01 12:55:22 +02:00
parent d5f2763aa2
commit 3b3d94291d
4 changed files with 202 additions and 134 deletions
+78 -39
View File
@@ -29,6 +29,8 @@ type
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);
@@ -37,6 +39,7 @@ type
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;
@@ -56,6 +59,9 @@ type
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;
@@ -104,7 +110,7 @@ begin
// Default border settings
FBorderColor := TAlphaColors.Gray;
FBorderWidth := 1;
FBorderRadius := 0; // Sharp corners by default
FBorderRadius := 9; // Sharp corners by default
// Default title settings
FTitle := 'Node';
@@ -115,6 +121,9 @@ begin
FTitleFont.OnChanged := TitleFontChanged;
FTitleFontColor := TAlphaColors.Black;
// Default state for frameless mode
FFrameless := False;
Width := 80;
Height := 45;
@@ -130,6 +139,62 @@ begin
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
@@ -139,6 +204,15 @@ begin
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
@@ -148,11 +222,11 @@ begin
end;
end;
procedure TAuraNode.SetBorderRadius(const Value: Single);
procedure TAuraNode.SetFrameless(const Value: Boolean);
begin
if FBorderRadius <> Value then
if FFrameless <> Value then
begin
FBorderRadius := Value;
FFrameless := Value;
Repaint;
end;
end;
@@ -185,41 +259,6 @@ begin
Repaint;
end;
procedure TAuraNode.Paint;
var
rect, titleRect: TRectF;
begin
inherited; // Allow styled painting to occur first (if any)
// 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;
// Use DrawRoundRect to support both sharp and rounded corners
Canvas.DrawRect(rect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
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, FBorderWidth, Width, FBorderWidth + 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.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
inherited;