AST development

This commit is contained in:
Michael Schimmel
2025-08-30 16:52:09 +02:00
parent d033bd9405
commit 7c531c1207
2 changed files with 411 additions and 435 deletions
+9 -12
View File
@@ -14,10 +14,7 @@ uses
FMX.Objects;
type
/// <summary>
/// A panel that can contain other controls and can be moved by dragging its background.
/// It custom-paints its own border and title.
/// </summary>
// A movable panel with a custom-painted border and title.
TAuraNode = class(TStyledControl)
private
// Flag to indicate if the control is currently being dragged.
@@ -190,45 +187,45 @@ end;
procedure TAuraNode.Paint;
var
LRect, LTitleRect: TRectF;
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
LRect := TRectF.Create(0, 0, Width, Height);
rect := TRectF.Create(0, 0, Width, Height);
// Inflate inwards so the border is fully visible within the control's bounds
LRect.Inflate(-FBorderWidth / 2, -FBorderWidth / 2);
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(LRect, FBorderRadius, FBorderRadius, AllCorners, 1.0, TCornerType.Round);
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
LTitleRect := TRectF.Create(0, FBorderWidth, Width, FBorderWidth + FTitleFont.Size * 1.8);
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(LTitleRect, FTitle, False, 1.0, [], TTextAlign.Center, TTextAlign.Center);
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;
if (Button = TMouseButton.mbLeft) then
if Button = TMouseButton.mbLeft then
begin
if (ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl) then
if ObjectAtPoint(LocalToScreen(TPointF.Create(X, Y))) = Self as IControl then
begin
FIsDragging := True;
FDownPos := TPointF.Create(X, Y);
File diff suppressed because it is too large Load Diff